From 93a08e1e4a6218aaccac5538cf0b263ddae78ff8 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 21 Aug 2019 08:29:33 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_util.adb | 19 ++++++++++++------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/implicit_param.adb | 19 +++++++++++++++++++ gcc/testsuite/gnat.dg/implicit_param_pkg.ads | 8 ++++++++ 5 files changed, 50 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/implicit_param.adb create mode 100644 gcc/testsuite/gnat.dg/implicit_param_pkg.ads 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 + + * sem_util.adb (Update_Named_Associations): Update + First_Named_Actual when the subprogram call has a single named + actual. + 2019-08-21 Joel Brobecker * 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 + + * gnat.dg/implicit_param.adb, gnat.dg/implicit_param_pkg.ads: + New testcase. + 2019-08-20 Martin Sebor 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; -- 2.30.2