diff options
author | Piotr Trojanek <trojanek@adacore.com> | 2023-03-06 12:50:04 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-25 09:44:16 +0200 |
commit | 0d569d97504d75e0499ce29ad64226629f67645a (patch) | |
tree | cb9b3ff61a57cea756437590d76f151bb8d81099 /gcc/ada | |
parent | d1e196d39e592d053d2528b11874a6c228932431 (diff) | |
download | gcc-0d569d97504d75e0499ce29ad64226629f67645a.zip gcc-0d569d97504d75e0499ce29ad64226629f67645a.tar.gz gcc-0d569d97504d75e0499ce29ad64226629f67645a.tar.bz2 |
ada: Tune handling of attributes Old in contract Exceptional_Cases
Contract Exceptional_Cases allows formal parameters to appear *in*
prefixes of attributes Old, but the code only allowed them to appear
*as* prefixes of those attributes.
For example, we now accetp expressions like "X.all'Old" that were
previously rejected.
gcc/ada/
* sem_res.adb (Resolve_Entity_Name): Tune handling of formal parameters
in contract Exceptional_Cases.
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/sem_res.adb | 32 |
1 files changed, 30 insertions, 2 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1722868..9161218 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7832,6 +7832,9 @@ package body Sem_Res is -- Determine whether Expr is part of an N_Attribute_Reference -- expression. + function In_Attribute_Old (Expr : Node_Id) return Boolean; + -- Determine whether Expr is in attribute Old + function Within_Exceptional_Cases_Consequence (Expr : Node_Id) return Boolean; @@ -7878,6 +7881,31 @@ package body Sem_Res is end if; end Is_Assignment_Or_Object_Expression; + ---------------------- + -- In_Attribute_Old -- + ---------------------- + + function In_Attribute_Old (Expr : Node_Id) return Boolean is + N : Node_Id := Expr; + begin + while Present (N) loop + if Nkind (N) = N_Attribute_Reference + and then Attribute_Name (N) = Name_Old + then + return True; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (N) then + return False; + end if; + + N := Parent (N); + end loop; + + return False; + end In_Attribute_Old; + ----------------------------- -- Is_Attribute_Expression -- ----------------------------- @@ -8080,12 +8108,12 @@ package body Sem_Res is -- Parameters of modes OUT or IN OUT of the subprogram shall not -- occur in the consequences of an exceptional contract unless - -- they either are of a by-reference type or occur in the prefix + -- they are either passed by reference or occur in the prefix -- of a reference to the 'Old attribute. if Ekind (E) in E_Out_Parameter | E_In_Out_Parameter and then Within_Exceptional_Cases_Consequence (N) - and then not Is_Attribute_Old (Parent (N)) + and then not In_Attribute_Old (N) and then not Is_By_Reference_Type (Etype (E)) and then not Is_Aliased (E) then |