The compiler crashes processing an internally generated cloned tree that
has a subprogram call with a named actual parameter.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-21 Javier Miranda <mira...@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.
--- gcc/ada/sem_util.adb
+++ 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.
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;