[Ada] Spurious error on inst. of partially defaulted formal package

[thirdparty/gcc.git] / gcc / ada / sem_ch12.adb

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 0395af942a9de1f4aaf9586ff1ac0b03b8612364..9ddfc970b25b2429dd6a9c6b1bc5b965b547fa8c 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6195,6 +6195,12 @@ package body Sem_Ch12 is
       --  Common error routine for mismatch between the parameters of the
       --  actual instance and those of the formal package.
 
+      function Is_Defaulted (Param : Entity_Id) return Boolean;
+      --  If the formql package has partly box-initialized formals, skip
+      --  conformace check for these formals. Previously the code assumed
+      --  that boc initialization for a formal package applied to all
+      --  its formal parameters.
+
       function Same_Instantiated_Constant (E1, E2 : Entity_Id) return Boolean;
       --  The formal may come from a nested formal package, and the actual may
       --  have been constant-folded. To determine whether the two denote the
@@ -6245,6 +6251,32 @@ package body Sem_Ch12 is
          end if;
       end Check_Mismatch;
 
+      ------------------
+      -- Is_Defaulted --
+      ------------------
+
+      function Is_Defaulted (Param : Entity_Id) return Boolean is
+         Assoc : Node_Id;
+      begin
+         Assoc := First (Generic_Associations
+                     (Parent (Associated_Formal_Package (Actual_Pack))));
+
+         while Present (Assoc) loop
+            if Nkind (Assoc) = N_Others_Choice then
+               return True;
+
+            elsif Nkind (Assoc) = N_Generic_Association
+              and then Chars (Selector_Name (Assoc)) = Chars (Param)
+            then
+               return Box_Present (Assoc);
+            end if;
+
+            Next (Assoc);
+         end loop;
+
+         return False;
+      end Is_Defaulted;
+
       --------------------------------
       -- Same_Instantiated_Constant --
       --------------------------------
@@ -6414,6 +6446,9 @@ package body Sem_Ch12 is
          then
             goto Next_E;
 
+         elsif Is_Defaulted (E1) then
+            goto Next_E;
+
          elsif Is_Type (E1) then
 
             --  Subtypes must statically match. E1, E2 are the local entities