===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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
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 <schonberg@adacore.com> * 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.