Ada: Fix ineffective "use all" clause for type declared in nested package

This is an issue reported 10 years ago for a new feature introduced in the
language 20 years ago (Ada 2005): primitive subprograms of a type named in
an use-all-type clause are not seen as (potentially) use-visible if the type
is declared in a nested package, except in the specific case of enumeration
literals; the fix just extends the processing done for enumeration literals.

gcc/ada/
	PR ada/64869
	* sem_ch7.adb (Install_Private_Declarations): Also propagate the
	Current_Use_Clause from partial to full view.
	(Uninstall_Declarations): Extend implementation of RM 8.4(8.1/3)
	subclause to all primitive subprograms.

gcc/testsuite/
	* gnat.dg/use_type1.adb: New test.
	* gnat.dg/use_type2.adb: Likewise.

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 42abc894a2967cfa25b5d32c18e1343d7708e547..1d838e24bf4817c29fd67bc8ad7a3cb33da97222 100644 (file)
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2521,11 +2521,13 @@ package body Sem_Ch7 is
            and then Scope (Full_View (Id)) = Scope (Id)
            and then Ekind (Full_View (Id)) /= E_Incomplete_Type
          then
+            Full := Full_View (Id);
+
             --  If there is a use-type clause on the private type, set the full
             --  view accordingly.
 
-            Set_In_Use (Full_View (Id), In_Use (Id));
-            Full := Full_View (Id);
+            Set_In_Use (Full, In_Use (Id));
+            Set_Current_Use_Clause (Full, Current_Use_Clause (Id));
 
             if Is_Private_Base_Type (Full)
               and then Has_Private_Declaration (Full)
@@ -2893,7 +2895,12 @@ package body Sem_Ch7 is
       --  When compiling a child unit this needs to be done recursively.
 
       function Type_In_Use (T : Entity_Id) return Boolean;
-      --  Check whether type or base type appear in an active use_type clause
+      --  Check whether type T is declared in P and appears in an active
+      --  use_type clause.
+
+      function Type_Of_Primitive_In_Use_All (Id : Entity_Id) return Boolean;
+      --  Check whether the profile of primitive subprogram Id mentions a type
+      --  declared in P that appears in an active use-all-type clause.
 
       ------------------------------
       -- Preserve_Full_Attributes --
@@ -3058,11 +3065,86 @@ package body Sem_Ch7 is
       -----------------
 
       function Type_In_Use (T : Entity_Id) return Boolean is
+         BT : constant Entity_Id := Base_Type (T);
       begin
-         return Scope (Base_Type (T)) = P
-           and then (In_Use (T) or else In_Use (Base_Type (T)));
+         return Scope (BT) = P and then (In_Use (T) or else In_Use (BT));
       end Type_In_Use;
 
+      ----------------------------------
+      -- Type_Of_Primitive_In_Use_All --
+      ----------------------------------
+
+      function Type_Of_Primitive_In_Use_All (Id : Entity_Id) return Boolean is
+         function Type_In_Use_All (T : Entity_Id) return Boolean;
+         --  Check whether type T is declared in P and appears in an active
+         --  use-all-type clause.
+
+         ---------------------
+         -- Type_In_Use_All --
+         ---------------------
+
+         function Type_In_Use_All (T : Entity_Id) return Boolean is
+         begin
+            return Type_In_Use (T)
+              and then Nkind (Current_Use_Clause (T)) = N_Use_Type_Clause
+              and then All_Present (Current_Use_Clause (T));
+         end Type_In_Use_All;
+
+         --  Local variables
+
+         F : Node_Id;
+
+      --  Start of processing for Type_Of_Primitive_In_Use_All
+
+      begin
+         --  The use-all-type clauses were introduced in Ada 2005
+
+         if Ada_Version <= Ada_95 then
+            return False;
+         end if;
+
+         --  For enumeration literals, check type
+
+         if Ekind (Id) = E_Enumeration_Literal then
+            return Type_In_Use_All (Etype (Id));
+         end if;
+
+         --  For functions, check return type
+
+         if Ekind (Id) = E_Function then
+            declare
+               Typ : constant Entity_Id :=
+                       (if Ekind (Etype (Id)) = E_Anonymous_Access_Type
+                        then Designated_Type (Etype (Id))
+                        else Etype (Id));
+            begin
+               if Type_In_Use_All (Typ) then
+                  return True;
+               end if;
+            end;
+         end if;
+
+         --  For all subprograms, check formals
+
+         F := First_Formal (Id);
+         while Present (F) loop
+            declare
+               Typ : constant Entity_Id :=
+                       (if Ekind (Etype (F)) = E_Anonymous_Access_Type
+                        then Designated_Type (Etype (F))
+                        else Etype (F));
+            begin
+               if Type_In_Use_All (Typ) then
+                  return True;
+               end if;
+            end;
+
+            Next_Formal (F);
+         end loop;
+
+         return False;
+      end Type_Of_Primitive_In_Use_All;
+
    --  Start of processing for Uninstall_Declarations
 
    begin
@@ -3120,13 +3202,13 @@ package body Sem_Ch7 is
             elsif No (Etype (Id)) and then Serious_Errors_Detected /= 0 then
                null;
 
-            --  We need to avoid incorrectly marking enumeration literals as
-            --  non-visible when a visible use-all-type clause is in effect.
+            --  RM 8.4(8.1/3): Each primitive subprogram of T, including each
+            --  enumeration literal (if any), is potentially use-visible if T
+            --  is named in an active use-all-type clause.
 
-            elsif Type_In_Use (Etype (Id))
-              and then Nkind (Current_Use_Clause (Etype (Id))) =
-                         N_Use_Type_Clause
-              and then All_Present (Current_Use_Clause (Etype (Id)))
+            elsif (Ekind (Id) = E_Enumeration_Literal
+                    or else (Is_Subprogram (Id) and then Is_Primitive (Id)))
+              and then Type_Of_Primitive_In_Use_All (Id)
             then
                null;
 

diff --git a/gcc/testsuite/gnat.dg/use_type1.adb b/gcc/testsuite/gnat.dg/use_type1.adb
new file mode 100644 (file)
index 0000000..a324610
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/use_type1.adb
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+
+procedure Use_Type1 is
+
+  package Nested is
+    type T is (X, Y, Z);
+    procedure Proc (Obj : T) is null;
+  end Nested;
+
+  use all type Nested.T;
+
+  Obj : Nested.T := X;
+
+begin
+  Proc (Obj);
+end;

diff --git a/gcc/testsuite/gnat.dg/use_type2.adb b/gcc/testsuite/gnat.dg/use_type2.adb
new file mode 100644 (file)
index 0000000..8299636
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/use_type2.adb
@@ -0,0 +1,15 @@
+-- { dg-do compile }
+
+with Ada.Containers.Vectors;
+
+procedure Use_Type2 is
+
+  package Vectors is new Ada.Containers.Vectors (Positive, Character);
+
+  use all type Vectors.Vector;
+
+  X : Vectors.Vector := To_Vector (0);
+
+begin
+  Append (X, 'A');
+end;