From: Piotr Trojanek <[email protected]>
The copies of class-wide pre- and postconditions are now attached to the
original pragma, so that legality checks, like the one for 'Old, can find the
original context of where those expressions appeared.
gcc/ada/ChangeLog:
* sem_attr.adb (Uneval_Old_Msg): Attribute Old never occurs outside of
a pragma.
* sem_ch13.adb (Analyze_One_Aspect): Attach expression copy of a
class-wide aspect to the corresponding pragma.
* sem_prag.adb (Analyze_Pre_Post_Condition): Likewise for a class-wide
pragma.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 1 +
gcc/ada/sem_ch13.adb | 22 ++++++++++++++++------
gcc/ada/sem_prag.adb | 16 ++++++++++++----
3 files changed, 29 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 77a61fff801..e038774849d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3143,6 +3143,7 @@ package body Sem_Attr is
-- from Opt.Uneval_Old. Perhaps this is due to a previous error?
else
+ Check_Error_Detected;
Uneval_Old_Setting := Opt.Uneval_Old;
end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index eda8f58a64b..397285d3df1 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5431,6 +5431,8 @@ package body Sem_Ch13 is
when Pre_Post_Aspects => Pre_Post : declare
Pname : Name_Id;
+ Class_Wide_Expr : Node_Id := Empty;
+
begin
if A_Id in Aspect_Pre | Aspect_Precondition then
Pname := Name_Precondition;
@@ -5467,11 +5469,11 @@ package body Sem_Ch13 is
and then not Is_Ignored_Ghost_Entity_In_Codegen (E)
then
if A_Id = Aspect_Pre then
+ Class_Wide_Expr := New_Copy_Tree (Expr);
if Is_Ignored_In_Codegen (Aspect) then
- Set_Ignored_Class_Preconditions (E,
- New_Copy_Tree (Expr));
+ Set_Ignored_Class_Preconditions (E, Class_Wide_Expr);
else
- Set_Class_Preconditions (E, New_Copy_Tree (Expr));
+ Set_Class_Preconditions (E, Class_Wide_Expr);
end if;
-- Postconditions may split into separate aspects, and we
@@ -5481,11 +5483,11 @@ package body Sem_Ch13 is
elsif No (Class_Postconditions (E))
and then No (Ignored_Class_Postconditions (E))
then
+ Class_Wide_Expr := New_Copy_Tree (Expr);
if Is_Ignored_In_Codegen (Aspect) then
- Set_Ignored_Class_Postconditions (E,
- New_Copy_Tree (Expr));
+ Set_Ignored_Class_Postconditions (E, Class_Wide_Expr);
else
- Set_Class_Postconditions (E, New_Copy_Tree (Expr));
+ Set_Class_Postconditions (E, Class_Wide_Expr);
end if;
end if;
end if;
@@ -5503,6 +5505,14 @@ package body Sem_Ch13 is
Pragma_Name => Pname);
end;
+ -- If class-wide expression was copied, then attach it to the AST,
+ -- so that its original context can be retrieved by climbing the
+ -- chain of parents.
+
+ if Present (Class_Wide_Expr) then
+ Set_Parent (Class_Wide_Expr, Aitem);
+ end if;
+
-- For Pre/Post cases, insert immediately after the entity
-- declaration, since that is the required pragma placement.
-- Note that for these aspects, we do not have to worry
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index fb78b800590..60c05a62be9 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5933,23 +5933,31 @@ package body Sem_Prag is
declare
Expr : constant Node_Id := Expression (Get_Argument (N));
+ Class_Wide_Expr : constant Node_Id := New_Copy_Tree (Expr);
+
begin
if Pname = Name_Pre_Class then
if Is_Ignored_In_Codegen (N) then
Set_Ignored_Class_Preconditions (Subp_Id,
- New_Copy_Tree (Expr));
+ Class_Wide_Expr);
else
- Set_Class_Preconditions (Subp_Id, New_Copy_Tree (Expr));
+ Set_Class_Preconditions (Subp_Id, Class_Wide_Expr);
end if;
else
if Is_Ignored_In_Codegen (N) then
Set_Ignored_Class_Postconditions (Subp_Id,
- New_Copy_Tree (Expr));
+ Class_Wide_Expr);
else
- Set_Class_Postconditions (Subp_Id, New_Copy_Tree (Expr));
+ Set_Class_Postconditions (Subp_Id, Class_Wide_Expr);
end if;
end if;
+
+ -- Attach the copied class-wide expression to the AST, so that
+ -- its original context can be retrieved by climbing the chain
+ -- of parents.
+
+ Set_Parent (Class_Wide_Expr, N);
end;
end if;
end Analyze_Pre_Post_Condition;
--
2.53.0
