https://gcc.gnu.org/g:0c1598bb32d33e7bc6b02332c756e33824770e50
commit r17-1642-g0c1598bb32d33e7bc6b02332c756e33824770e50 Author: Piotr Trojanek <[email protected]> Date: Tue May 26 11:20:20 2026 +0200 ada: Fix missing context for class-wide contract expressions 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. Diff: --- 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 77a61fff801b..e038774849d8 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 eda8f58a64be..397285d3df18 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 fb78b800590d..60c05a62be96 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;
