diff options
author | Javier Miranda <miranda@adacore.com> | 2019-08-21 08:29:33 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-08-21 08:29:33 +0000 |
commit | 93a08e1e4a6218aaccac5538cf0b263ddae78ff8 (patch) | |
tree | e59f947b0949df9d161425854501dd2d0cbe2e50 /gcc | |
parent | cfc03d536f3b4b20e0084a65e90d5a9491721100 (diff) | |
download | gcc-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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 19 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/implicit_param.adb | 19 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/implicit_param_pkg.ads | 8 |
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; |