From: Javier Miranda <miranda@adacore.com>
Date: Wed, 21 Aug 2019 08:29:33 +0000 (+0000)
Subject: [Ada] Missing attribute update in new_copy_tree
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=93a08e1e4a6218aaccac5538cf0b263ddae78ff8;p=gcc.git

[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.

From-SVN: r274776
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 36d41e9ca06..08989eb8f4e 100644
--- 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 f837b6fd912..58b7b0864ee 100644
--- 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 3187e94186d..50929c173ab 100644
--- 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
index 00000000000..89de0c3104c
--- /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
index 00000000000..ce6c7e6d555
--- /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;