[Ada] Missing attribute update in new_copy_tree

Message ID 20190821083141.GA71812@adacore.com
State New
Headers show
Series
  • [Ada] Missing attribute update in new_copy_tree
Related show

Commit Message

Pierre-Marie de Rodat Aug. 21, 2019, 8:31 a.m.
The compiler crashes processing an internally generated cloned tree that
has a subprogram call with a named actual parameter.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-08-21  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_util.adb (Update_Named_Associations): Update
	First_Named_Actual when the subprogram call has a single named
	actual.

gcc/testsuite/

	* gnat.dg/implicit_param.adb, gnat.dg/implicit_param_pkg.ads:
	New testcase.

Patch

--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -20623,6 +20623,10 @@  package body Sem_Util is
          Old_Next : Node_Id;
 
       begin
+         if No (First_Named_Actual (Old_Call)) then
+            return;
+         end if;
+
          --  Recreate the First/Next_Named_Actual chain of a call by traversing
          --  the chains of both the old and new calls in parallel.
 
@@ -20630,15 +20634,16 @@  package body Sem_Util is
          Old_Act := First (Parameter_Associations (Old_Call));
          while Present (Old_Act) loop
             if Nkind (Old_Act) = N_Parameter_Association
-              and then Present (Next_Named_Actual (Old_Act))
+              and then Explicit_Actual_Parameter (Old_Act)
+                         = First_Named_Actual (Old_Call)
             then
-               if First_Named_Actual (Old_Call) =
-                    Explicit_Actual_Parameter (Old_Act)
-               then
-                  Set_First_Named_Actual (New_Call,
-                    Explicit_Actual_Parameter (New_Act));
-               end if;
+               Set_First_Named_Actual (New_Call,
+                 Explicit_Actual_Parameter (New_Act));
+            end if;
 
+            if Nkind (Old_Act) = N_Parameter_Association
+              and then Present (Next_Named_Actual (Old_Act))
+            then
                --  Scan the actual parameter list to find the next suitable
                --  named actual. Note that the list may be out of order.
 

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/implicit_param.adb
@@ -0,0 +1,19 @@ 
+--  { dg-do compile }
+
+with Implicit_Param_Pkg;
+
+procedure Implicit_Param is
+    subtype Tiny is Integer range 1 .. 5;
+    V : Tiny := 4;
+
+    function Func62 return Implicit_Param_Pkg.Lim_Rec is
+    begin
+       return
+         (case V is
+           when 1 .. 3 => Implicit_Param_Pkg.Func_Lim_Rec,
+           when 4 .. 5 => raise Program_Error);
+    end Func62;
+
+begin
+    null;
+end Implicit_Param;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/implicit_param_pkg.ads
@@ -0,0 +1,8 @@ 
+package Implicit_Param_Pkg is
+    type Lim_Rec is limited record
+        A : Integer;
+        B : Boolean;
+    end record;
+
+    function Func_Lim_Rec return Lim_Rec;
+end Implicit_Param_Pkg;