[Ada] Missing attribute update in new_copy_tree

The compiler crashes processing an internally generated cloned tree that
has a subprogram call with a named actual parameter.

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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@274776 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 36d41e9ca0674f56c7b9d6ff2dde88a3fac4aae2..08989eb8f4e917904da16c0004ac04d02265f4df 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-21  Javier Miranda  <miranda@adacore.com>
+
+       * sem_util.adb (Update_Named_Associations): Update
+       First_Named_Actual when the subprogram call has a single named
+       actual.
+
 2019-08-21  Joel Brobecker  <brobecker@adacore.com>
 
        * doc/Makefile (mk_empty_dirs): New (PHONY) rule.

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f837b6fd91214e4f6ca5721797ae99bcd1636455..58b7b0864ee9cb1109db578aecf9fa93cafb2d5d 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/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.
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3187e94186d4711f7156332a8a4554bfe1f87286..50929c173aba67cf51ce2ecdc4fbba4a3dc2b8c1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-21  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/implicit_param.adb, gnat.dg/implicit_param_pkg.ads:
+       New testcase.
+
 2019-08-20  Martin Sebor  <msebor@redhat.com>
 
        PR testsuite/91458

diff --git a/gcc/testsuite/gnat.dg/implicit_param.adb b/gcc/testsuite/gnat.dg/implicit_param.adb
new file mode 100644 (file)
index 0000000..89de0c3
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/implicit_param_pkg.ads b/gcc/testsuite/gnat.dg/implicit_param_pkg.ads
new file mode 100644 (file)
index 0000000..ce6c7e6
--- /dev/null
+++ b/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;