From c3ba8ed0bcf3ba41eb94de209b8ad742215ca70d Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 17 Oct 2014 09:14:42 +0000 Subject: [PATCH] sem_ch13.adb (Add_Invariants, [...]): Do not perform the replacement on the expression for an inherited class-wide... 2014-10-17 Ed Schonberg * sem_ch13.adb (Add_Invariants, Replace_Type_References): Do not perform the replacement on the expression for an inherited class-wide invariant if in ASIS_Mode and the type reference is already the prefix of a 'Class attribute reference: the expression has already been preanalyzed and the replacement performed when first encountered on the declaration of the parent type. From-SVN: r216382 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch13.adb | 32 ++++++++++++++++++++++---------- 2 files changed, 31 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f8c114560ed..3dfcd9e8b5c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2014-10-17 Ed Schonberg + + * sem_ch13.adb (Add_Invariants, Replace_Type_References): Do + not perform the replacement on the expression for an inherited + class-wide invariant if in ASIS_Mode and the type reference is + already the prefix of a 'Class attribute reference: the expression + has already been preanalyzed and the replacement performed when + first encountered on the declaration of the parent type. + 2014-10-17 Robert Dewar * sem_ch5.adb, sem_ch7.adb, prj-nmsc.adb, sem_ch13.adb, exp_ch3.adb: diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ba5a1ee9c22..9ab019a0648 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7505,18 +7505,30 @@ package body Sem_Ch13 is end if; -- Invariant'Class, replace with T'Class (obj) + -- In ASIS mode, an inherited item is analyzed already, and the + -- replacement has been done, so do not repeat transformation + -- to prevent ill-formed tree. if Class_Present (Ritem) then - Rewrite (N, - Make_Type_Conversion (Sloc (N), - Subtype_Mark => - Make_Attribute_Reference (Sloc (N), - Prefix => New_Occurrence_Of (T, Sloc (N)), - Attribute_Name => Name_Class), - Expression => Make_Identifier (Sloc (N), Object_Name))); - - Set_Entity (Expression (N), Object_Entity); - Set_Etype (Expression (N), Typ); + if ASIS_Mode + and then Nkind (Parent (N)) = N_Attribute_Reference + and then Attribute_Name (Parent (N)) = Name_Class + then + null; + + else + Rewrite (N, + Make_Type_Conversion (Sloc (N), + Subtype_Mark => + Make_Attribute_Reference (Sloc (N), + Prefix => New_Occurrence_Of (T, Sloc (N)), + Attribute_Name => Name_Class), + Expression => + Make_Identifier (Sloc (N), Object_Name))); + + Set_Entity (Expression (N), Object_Entity); + Set_Etype (Expression (N), Typ); + end if; -- Invariant, replace with obj -- 2.30.2