From: Piotr Trojanek <[email protected]>
Syntax for the Abstract_State contract is the same as for extended aggregates,
but conceptually they are completely different. This patch specializes error
messages emitted on syntax errors for these constructs.
gcc/ada/ChangeLog:
* par-ch13.adb (Get_Aspect_Specifications): Save and restore flag while
parsing aspect Abstract_State.
* par-ch2.adb (P_Pragma): Same while parsing pragma Abstract_State.
* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Specialize error message
for contract Abstract_State and extended aggregate.
* par.adb (Inside_Abstract_State): Add new context flag.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/par-ch13.adb | 7 +++++--
gcc/ada/par-ch2.adb | 15 +++++++++------
gcc/ada/par-ch4.adb | 9 +++++++--
gcc/ada/par.adb | 5 +++++
4 files changed, 26 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index f52136c916a..dbb894f79cd 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -503,6 +503,8 @@ package body Ch13 is
or else A_Id = Aspect_Refined_Depends
then
Inside_Depends := True;
+ elsif A_Id = Aspect_Abstract_State then
+ Inside_Abstract_State := True;
end if;
-- Note that we have seen an Import aspect specification.
@@ -529,9 +531,10 @@ package body Ch13 is
Set_Expression (Aspect, P_Expression);
end if;
- -- Unconditionally reset flag for Inside_Depends
+ -- Unconditionally reset flag for being inside aspects
- Inside_Depends := False;
+ Inside_Depends := False;
+ Inside_Abstract_State := False;
end if;
-- Add the aspect to the resulting list only when it was properly
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 20640d5547b..11c9a8384df 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -385,6 +385,8 @@ package body Ch2 is
or else Chars (Ident_Node) = Name_Refined_Depends
then
Inside_Depends := True;
+ elsif Chars (Ident_Node) = Name_Abstract_State then
+ Inside_Abstract_State := True;
end if;
-- Scan arguments. We assume that arguments are present if there is
@@ -441,11 +443,11 @@ package body Ch2 is
Semicolon_Loc := Token_Ptr;
- -- Cancel indication of being within a pragma or in particular a Depends
- -- pragma.
+ -- Cancel indication of being within a pragma
- Inside_Depends := False;
- Inside_Pragma := False;
+ Inside_Depends := False;
+ Inside_Abstract_State := False;
+ Inside_Pragma := False;
-- Now we have two tasks left, we need to scan out the semicolon
-- following the pragma, and we have to call Par.Prag to process
@@ -472,8 +474,9 @@ package body Ch2 is
exception
when Error_Resync =>
Resync_Past_Semicolon;
- Inside_Depends := False;
- Inside_Pragma := False;
+ Inside_Depends := False;
+ Inside_Abstract_State := False;
+ Inside_Pragma := False;
return Error;
end P_Pragma;
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 8267a0c06d3..e6cf93ab387 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1607,8 +1607,13 @@ package body Ch4 is
-- Improper use of WITH
elsif Token = Tok_With then
- Error_Msg_SC ("WITH must be preceded by single expression in " &
- "extension aggregate");
+ if Inside_Abstract_State then
+ Error_Msg_SC ("state name with options must be enclosed in " &
+ "parentheses");
+ else
+ Error_Msg_SC ("WITH must be preceded by single expression in " &
+ "extension aggregate");
+ end if;
raise Error_Resync;
-- Range attribute can only appear as part of a discrete choice list
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 5d61fac3c11..0003a332222 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -80,6 +80,11 @@ function Par (Configuration_Pragmas : Boolean) return
List_Id is
-- True within a delta aggregate (but only after the "delta" token has
-- been scanned). Used to distinguish syntax errors from syntactically
-- correct "deep" delta aggregates (enabled via -gnatX0).
+
+ Inside_Abstract_State : Boolean := False;
+ -- True within an Abstract_State contract. Used to distinguish syntax error
+ -- about extended aggregates and about a malformed contract.
+
Save_Style_Checks : Style_Check_Options;
Save_Style_Check : Boolean;
-- Variables for storing the original state of whether style checks should
--
2.43.0
