From patchwork Wed Apr 27 12:48:19 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 615622 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3qw0CJ1B0nz9t4h for ; Wed, 27 Apr 2016 22:49:15 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=p2Wjyxa7; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=AztSQ8DN2fAnb5aWQf0aMksKZrgWw4miV7reUvG2HxtBAN6QCB LfMYRm+F/oC6sxQSbnQNQZDnljFQBmLEReQjIzRQRATVQScFbHEhGJgLv1rhu2fI LjwWodSQhw/P0Iyw5vUABzRxrNj2gXXMv39bcmvihbvjbhzBR5pRNZToE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=aG+etlM5dbvmvPb6gtiC/i6MLzk=; b=p2Wjyxa71JCLqcLz2WSz sKwDXwfWnVKHC0VKT9DuFieBnoC2TknUOXWdog1eqdGZdVxnthpsGenqlgT+XsD5 7INfknim9GtdRlsuX+8sKKjiptS9F3iIPa74J/DLWF84La/yHxa3hrzINWislLFU aEyADciZECx7CDVvME/oqKQ= Received: (qmail 20903 invoked by alias); 27 Apr 2016 12:48:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 20689 invoked by uid 89); 27 Apr 2016 12:48:31 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.8 required=5.0 tests=AWL, BAYES_50, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 spammy=ali, 235481, Node_Id, node_id X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Wed, 27 Apr 2016 12:48:21 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4A42F116B8D; Wed, 27 Apr 2016 08:48:19 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 400IGufd-Gz7; Wed, 27 Apr 2016 08:48:19 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 3A5D0116AD2; Wed, 27 Apr 2016 08:48:19 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 398B4370; Wed, 27 Apr 2016 08:48:19 -0400 (EDT) Date: Wed, 27 Apr 2016 08:48:19 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Incomplete xref information in ALI file Message-ID: <20160427124819.GA125845@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch fixes the handling of an object declaration whose type definition is a class-wide subtype and whose expression is a function call that returns a classwide type. Previous to this patch the type of the object in the ALI file appeared as the corresponding base type. Executing the following; gcc -c vars.ads grep Some_Var vars.ali must yield: 4c4*Some_Var{1|3C12} --- with A; package Vars is Some_Var : A.Base_Type := A.Foo; subtype T is Integer; V2 : T; end Vars; --- package A is type Root_Type is tagged null record; subtype Base_Type is Root_Type'Class; function Foo return Base_Type; end A; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-27 Ed Schonberg * lib-xref.adb (Get_Type_Reference): Handle properly the case of an object declaration whose type definition is a class-wide subtype and whose expression is a function call that returns a classwide type. Index: lib-xref.adb =================================================================== --- lib-xref.adb (revision 235481) +++ lib-xref.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1467,17 +1467,23 @@ -- initialized with a tag-indeterminate call gets a subtype -- of the classwide type during expansion. See if the original -- type in the declaration is named, and return it instead - -- of going to the root type. + -- of going to the root type. The expression may be a class- + -- wide function call whose result is on the secondary stack, + -- which forces the declaration to be rewritten as a renaming, + -- so examine the source declaration. - if Ekind (Tref) = E_Class_Wide_Subtype - and then Nkind (Parent (Ent)) = N_Object_Declaration - and then - Nkind (Original_Node (Object_Definition (Parent (Ent)))) - = N_Identifier - then - Tref := - Entity - (Original_Node ((Object_Definition (Parent (Ent))))); + if Ekind (Tref) = E_Class_Wide_Subtype then + declare + Decl : constant Node_Id := Original_Node (Parent (Ent)); + begin + if Nkind (Decl) = N_Object_Declaration + and then Is_Entity_Name + (Original_Node ((Object_Definition (Decl)))) + then + Tref := + Entity ((Original_Node ((Object_Definition (Decl))))); + end if; + end; end if; -- For anything else, exit