aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2019-08-21 08:29:33 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-08-21 08:29:33 +0000
commit93a08e1e4a6218aaccac5538cf0b263ddae78ff8 (patch)
treee59f947b0949df9d161425854501dd2d0cbe2e50
parentcfc03d536f3b4b20e0084a65e90d5a9491721100 (diff)
downloadgcc-93a08e1e4a6218aaccac5538cf0b263ddae78ff8.zip
gcc-93a08e1e4a6218aaccac5538cf0b263ddae78ff8.tar.gz
gcc-93a08e1e4a6218aaccac5538cf0b263ddae78ff8.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/sem_util.adb19
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gnat.dg/implicit_param.adb19
-rw-r--r--gcc/testsuite/gnat.dg/implicit_param_pkg.ads8
5 files changed, 50 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 36d41e9..08989eb 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 f837b6f..58b7b08 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 3187e94..50929c1 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 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
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;