Ada: Fix use type clause invalidated by use clause in nested package

This is an old issue, whereby a use type clause is partially invalidated by
a use clause in a nested package, a variant of PR ada/64869 recently fixed.
The problem occurs only for unusual primitive operators because of a small
oversight in the implementation.  The fix simply aligns this implementation
with the one exercised by PR ada/64869, which is more robust.

gcc/ada/
	PR ada/52319
	* sem_ch7.adb (Uninstall_Declarations): Use direct test on Nkind
	to spot operators.
	* sem_ch8.adb (End_Use_Package): Also test the Etype of operators
	to spot those which are primitive operators of use-visible types.

gcc/testsuite/
	* gnat.dg/use_type3.adb: New test.

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 90219ac821682b2f6d95702477c79911d0109365..2002cc7621fde11273be21210dd9097f1c602e6d 100644 (file)
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -3168,8 +3168,7 @@ package body Sem_Ch7 is
          --  the instantiation of the formals appears in the visible part,
          --  but the formals are private and remain so.
 
-         if Ekind (Id) = E_Function
-           and then Is_Operator_Symbol_Name (Chars (Id))
+         if Nkind (Id) = N_Defining_Operator_Symbol
            and then not Is_Hidden (Id)
            and then not Error_Posted (Id)
          then

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 4814c0301edbce1ca70cd1dfd19fc324edbd4eba..86344b59c7ef75a319a2efe81970ab75591ce15e 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5335,23 +5335,19 @@ package body Sem_Ch8 is
       Id        : Entity_Id;
       Elmt      : Elmt_Id;
 
-      function Is_Primitive_Operator_In_Use
-        (Op : Entity_Id;
-         F  : Entity_Id) return Boolean;
-      --  Check whether Op is a primitive operator of a use-visible type
-
-      ----------------------------------
-      -- Is_Primitive_Operator_In_Use --
-      ----------------------------------
-
-      function Is_Primitive_Operator_In_Use
-        (Op : Entity_Id;
-         F  : Entity_Id) return Boolean
-      is
-         T : constant Entity_Id := Base_Type (Etype (F));
+      function Type_In_Use (T : Entity_Id; P : Entity_Id) return Boolean;
+      --  Check whether type T is declared in P and appears in an active
+      --  use_type clause.
+
+      -----------------
+      -- Type_In_Use --
+      -----------------
+
+      function Type_In_Use (T : Entity_Id; P : Entity_Id) return Boolean is
+         BT : constant Entity_Id := Base_Type (T);
       begin
-         return In_Use (T) and then Scope (T) = Scope (Op);
-      end Is_Primitive_Operator_In_Use;
+         return Scope (BT) = P and then (In_Use (T) or else In_Use (BT));
+      end Type_In_Use;
 
    --  Start of processing for End_Use_Package
 
@@ -5381,12 +5377,13 @@ package body Sem_Ch8 is
 
                if Nkind (Id) = N_Defining_Operator_Symbol
                  and then
-                   (Is_Primitive_Operator_In_Use (Id, First_Formal (Id))
+                   (Type_In_Use (Etype (Id), Pack)
+                     or else Type_In_Use (Etype (First_Formal (Id)), Pack)
                      or else
                        (Present (Next_Formal (First_Formal (Id)))
                          and then
-                           Is_Primitive_Operator_In_Use
-                             (Id, Next_Formal (First_Formal (Id)))))
+                           Type_In_Use
+                             (Etype (Next_Formal (First_Formal (Id))), Pack)))
                then
                   null;
                else

diff --git a/gcc/testsuite/gnat.dg/use_type3.adb b/gcc/testsuite/gnat.dg/use_type3.adb
new file mode 100644 (file)
index 0000000..b50b395
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/use_type3.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+
+procedure Use_Type3 is
+
+  package P1 is            
+    type T is new Integer;                      
+    function "and" (L, R : in Integer) return T;
+  end P1;
+
+  package body P1 is                               
+    function "and" (L, R : in Integer) return T is
+    begin       
+      return T (L * R);
+    end "and";
+  end P1;
+
+  use type P1.T;
+
+  package P2 is
+    use P1;
+  end P2;
+
+  G : P1.T := Integer'(1) and Integer'(2);
+
+begin
+  null;
+end;