From 5291985c00302036cc6d5932fdffb9acab3043cf Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 8 Jul 2019 08:13:04 +0000 Subject: [PATCH] [Ada] Crash on named actual in postcondition for generic subprogram This patch fixes a crash on compiling the postcondtion for a generic subprogram, when the postcondition is a call with both positional and named parameter associations. 2019-07-08 Ed Schonberg gcc/ada/ * sem_ch13.adb (Analyze_Aspect_Specifications): For a pre/postcondition of a generic subprogram declaration, do not use Relocate_Node on the aspect expression to construct the corresponding attribute specification, to prevent tree anomalies when the expression is a call with named actual parameters. gcc/testsuite/ * gnat.dg/predicate9.adb: New testcase. From-SVN: r273201 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch13.adb | 28 ++++++++++++++++++++++------ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/predicate9.adb | 21 +++++++++++++++++++++ 4 files changed, 55 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/predicate9.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9a86909fe68..d651ff09eaf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-08 Ed Schonberg + + * sem_ch13.adb (Analyze_Aspect_Specifications): For a + pre/postcondition of a generic subprogram declaration, do not + use Relocate_Node on the aspect expression to construct the + corresponding attribute specification, to prevent tree anomalies + when the expression is a call with named actual parameters. + 2019-07-08 Javier Miranda * sem_attr.adb (Analyze_Attribute [Attribute_Size]): For pragmas diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index b62e2971def..8467f753576 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3495,12 +3495,28 @@ package body Sem_Ch13 is -- because subsequent visibility analysis of the aspect -- depends on this sharing. This should be cleaned up??? - Make_Aitem_Pragma - (Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Eloc, - Chars => Name_Check, - Expression => Relocate_Node (Expr))), - Pragma_Name => Pname); + -- If the context is generic or involves ASIS, we want + -- to preserve the original tree, and simply share it + -- between aspect and generated attribute. This parallels + -- what is done in sem_prag.adb (see Get_Argument). + + declare + New_Expr : Node_Id; + + begin + if ASIS_Mode or else Inside_A_Generic then + New_Expr := Expr; + else + New_Expr := Relocate_Node (Expr); + end if; + + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Eloc, + Chars => Name_Check, + Expression => New_Expr)), + Pragma_Name => Pname); + end; -- Add message unless exception messages are suppressed diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 744f7824355..94ad86f9895 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-08 Ed Schonberg + + * gnat.dg/predicate9.adb: New testcase. + 2019-07-08 Justin Squirek * gnat.dg/sso16.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/predicate9.adb b/gcc/testsuite/gnat.dg/predicate9.adb new file mode 100644 index 00000000000..ebcfca7f838 --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate9.adb @@ -0,0 +1,21 @@ +-- { dg-do compile } +procedure Predicate9 is + function Num (x : Integer) return Integer is (X + 1); + function name (X : String) return Integer is (X'Size); + function Post (One : Integer; Two : Integer) return Boolean; + + generic + type T is private; + procedure Pro (Z : Integer) with Post => + Post (Num (5), Two => Name ("yeah")); + + function Post (One : Integer; Two : Integer) return Boolean + is (True); + + procedure Pro (Z : Integer) is + begin + null; + end Pro; +begin + null; +end Predicate9; -- 2.30.2