ada: Fix spurious error on call to function returning private in generic

The spurious error is given on a call to a parameterless function returning
a private type, present in the body of a generic construct both declared and
instantiated in the presence of the full view of the type, because this full
view is not properly restored for the instantiation.

This is supposed to be handled by the Has_Private_View mechanism, but it is
bypassed here because the call to the parameterless function is first parsed
as a simple identifier before being later analyzed as a function call.

Fixing this first issue uncovered another one, whereby the Has_Private_View
flag was not properly set on an operator returning a private type that ends
up being later resolved as a function call.

Finally a small loophole in Eval_Attribute exposed by the change also needs
to be plugged.

gcc/ada/

	* sem_attr.adb (Eval_Attribute): Add more exceptions to the early
	return for a prefix which is a nonfrozen generic actual type.
	* sem_ch12.adb (Copy_Generic_Node): Also check private views in the
	case of an entity name or operator analyzed as a function call.
	(Set_Global_Type): Make it a child of Save_Global_References.
	(Save_References_In_Operator): In the case where the operator has
	been turned into a function call, call Set_Global_Type on the entity
	if it is global.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 24f57ac43ff54708dd4fbffa4c0c959a1d32870c..dc06435e7b05cf335980bb33e62b4505be453c4a 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8437,9 +8437,13 @@ package body Sem_Attr is
         --  However, the attribute Unconstrained_Array must be evaluated,
         --  since it is documented to be a static attribute (and can for
         --  example appear in a Compile_Time_Warning pragma). The frozen
-        --  status of the type does not affect its evaluation.
+        --  status of the type does not affect its evaluation. Likewise
+        --  for attributes intended to be used with generic definitions.
 
-        and then Id /= Attribute_Unconstrained_Array
+        and then Id not in Attribute_Unconstrained_Array
+                        |  Attribute_Has_Access_Values
+                        |  Attribute_Has_Discriminants
+                        |  Attribute_Has_Tagged_Values
       then
          return;
       end if;

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 2562d1a0812babaac005c8065465bb5dd6274de4..0ef894e153b3f27b0d05853fe72884de92393ae7 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -8178,6 +8178,7 @@ package body Sem_Ch12 is
                     and then Is_Entity_Name (Name (Assoc))
                   then
                      Set_Entity (New_N, Entity (Name (Assoc)));
+                     Check_Private_View (N);
 
                   elsif Nkind (Assoc) in N_Entity
                     and then (Expander_Active
@@ -15716,6 +15717,13 @@ package body Sem_Ch12 is
       --  This is the recursive procedure that does the work, once the
       --  enclosing generic scope has been established.
 
+      procedure Set_Global_Type (N : Node_Id; N2 : Node_Id);
+      --  If the type of N2 is global to the generic unit, save the type in
+      --  the generic node. Just as we perform name capture for explicit
+      --  references within the generic, we must capture the global types
+      --  of local entities because they may participate in resolution in
+      --  the instance.
+
       ---------------
       -- Is_Global --
       ---------------
@@ -15909,67 +15917,12 @@ package body Sem_Ch12 is
       ------------------
 
       procedure Reset_Entity (N : Node_Id) is
-         procedure Set_Global_Type (N : Node_Id; N2 : Node_Id);
-         --  If the type of N2 is global to the generic unit, save the type in
-         --  the generic node. Just as we perform name capture for explicit
-         --  references within the generic, we must capture the global types
-         --  of local entities because they may participate in resolution in
-         --  the instance.
-
          function Top_Ancestor (E : Entity_Id) return Entity_Id;
          --  Find the ultimate ancestor of the current unit. If it is not a
          --  generic unit, then the name of the current unit in the prefix of
          --  an expanded name must be replaced with its generic homonym to
          --  ensure that it will be properly resolved in an instance.
 
-         ---------------------
-         -- Set_Global_Type --
-         ---------------------
-
-         procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is
-            Typ : constant Entity_Id := Etype (N2);
-
-         begin
-            Set_Etype (N, Typ);
-
-            --  If the entity of N is not the associated node, this is a
-            --  nested generic and it has an associated node as well, whose
-            --  type is already the full view (see below). Indicate that the
-            --  original node has a private view.
-
-            if Entity (N) /= N2 and then Has_Private_View (Entity (N)) then
-               Set_Has_Private_View (N);
-            end if;
-
-            --  If not a private type, nothing else to do
-
-            if not Is_Private_Type (Typ) then
-               null;
-
-            --  If it is a derivation of a private type in a context where no
-            --  full view is needed, nothing to do either.
-
-            elsif No (Full_View (Typ)) and then Typ /= Etype (Typ) then
-               null;
-
-            --  Otherwise mark the type for flipping and use the full view when
-            --  available.
-
-            else
-               Set_Has_Private_View (N);
-
-               if Present (Full_View (Typ)) then
-                  Set_Etype (N2, Full_View (Typ));
-               end if;
-            end if;
-
-            if Is_Floating_Point_Type (Typ)
-              and then Has_Dimension_System (Typ)
-            then
-               Copy_Dimensions (N2, N);
-            end if;
-         end Set_Global_Type;
-
          ------------------
          -- Top_Ancestor --
          ------------------
@@ -16678,7 +16631,7 @@ package body Sem_Ch12 is
                   E := Entity (Name (N2));
 
                   if Present (E) and then Is_Global (E) then
-                     Set_Etype (N, Etype (N2));
+                     Set_Global_Type (N, N2);
                   else
                      Set_Associated_Node (N, Empty);
                      Set_Etype           (N, Empty);
@@ -16845,6 +16798,54 @@ package body Sem_Ch12 is
          end if;
       end Save_References;
 
+      ---------------------
+      -- Set_Global_Type --
+      ---------------------
+
+      procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is
+         Typ : constant Entity_Id := Etype (N2);
+
+      begin
+         Set_Etype (N, Typ);
+
+         --  If the entity of N is not the associated node, this is a
+         --  nested generic and it has an associated node as well, whose
+         --  type is already the full view (see below). Indicate that the
+         --  original node has a private view.
+
+         if Entity (N) /= N2 and then Has_Private_View (Entity (N)) then
+            Set_Has_Private_View (N);
+         end if;
+
+         --  If not a private type, nothing else to do
+
+         if not Is_Private_Type (Typ) then
+            null;
+
+         --  If it is a derivation of a private type in a context where no
+         --  full view is needed, nothing to do either.
+
+         elsif No (Full_View (Typ)) and then Typ /= Etype (Typ) then
+            null;
+
+         --  Otherwise mark the type for flipping and use the full view when
+         --  available.
+
+         else
+            Set_Has_Private_View (N);
+
+            if Present (Full_View (Typ)) then
+               Set_Etype (N2, Full_View (Typ));
+            end if;
+         end if;
+
+         if Is_Floating_Point_Type (Typ)
+           and then Has_Dimension_System (Typ)
+         then
+            Copy_Dimensions (N2, N);
+         end if;
+      end Set_Global_Type;
+
    --  Start of processing for Save_Global_References
 
    begin