This patch modifies the parser to detect missing parentheses on SPARK aspects
Global, Depends, Refined_Global and Refined_Depends.
------------
-- Source --
------------
-- malformed_contracts.ads
package Malformed_Contracts
with Abstract_State => (State_1, State_2)
is
procedure OK_1
with Global => State_1;
procedure OK_2
with Global => (State_1, State_2);
procedure Error_0
with Global => State_1, State_2;
procedure Error_1
with Global => Input => State_1;
procedure Error_2
with Global => (Input => State_1;
procedure Error_3
with Global => Input => State_1, In_Out => State_2;
procedure Error_4
with Global => (Input => State_1, In_Out => State_2;
procedure Error_5
with Global => (In_Out => State_1),
Depends => State_1 => State_1;
procedure Error_6
with Global => (In_Out => State_1),
Depends => (State_1 => State_1;
procedure Error_7
with Global => (Input => State_1, In_Out => State_2),
Depends => State_2 => State_1, null => State_2;
procedure Error_8
with Global => (Input => State_1, In_Out => State_2),
Depends => (State_2 => State_1, null => State_2;
end Malformed_Contracts;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c malformed_contracts.ads
malformed_contracts.ads:11:21: missing "("
malformed_contracts.ads:14:21: missing "("
malformed_contracts.ads:17:38: ";" should be ","
malformed_contracts.ads:20:21: missing "("
malformed_contracts.ads:23:57: ";" should be ","
malformed_contracts.ads:27:23: missing "("
malformed_contracts.ads:31:41: ";" should be ","
malformed_contracts.ads:35:23: missing "("
malformed_contracts.ads:39:60: missing ")"
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-02-19 Hristian Kirtchev <kirtc...@adacore.com>
* par.adb Alphabetize the routines in Par.Sync.
(Resync_Past_Malformed_Aspect): New routine.
* par-ch13.adb (Get_Aspect_Specifications): Alphabetize local
variables. Code and comment reformatting. Detect missing
parentheses on aspects [Refined_]Global and [Refined_]Depends
with a non-null definition.
* par-sync.adb: Alphabetize all routines in this separate unit.
(Resync_Past_Malformed_Aspect): New routine.
Index: par-sync.adb
===================================================================
--- par-sync.adb (revision 207879)
+++ par-sync.adb (working copy)
@@ -148,47 +148,75 @@
end if;
end Resync_Init;
- ---------------------------
- -- Resync_Past_Semicolon --
- ---------------------------
+ ----------------------------------
+ -- Resync_Past_Malformed_Aspect --
+ ----------------------------------
- procedure Resync_Past_Semicolon is
+ procedure Resync_Past_Malformed_Aspect is
begin
Resync_Init;
loop
- -- Done if we are at a semicolon
+ -- A comma may separate two aspect specifications, but it may also
+ -- delimit multiple arguments of a single aspect.
- if Token = Tok_Semicolon then
- Scan; -- past semicolon
+ if Token = Tok_Comma then
+ declare
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past comma
+
+ -- The identifier following the comma is a valid aspect, the
+ -- current malformed aspect has been successfully skipped.
+
+ if Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ Restore_Scan_State (Scan_State);
+ exit;
+
+ -- The comma is delimiting multiple arguments of an aspect
+
+ else
+ Restore_Scan_State (Scan_State);
+ end if;
+ end;
+
+ -- An IS signals the last aspect specification when the related
+ -- context is a body.
+
+ elsif Token = Tok_Is then
exit;
- -- Done if we are at a token which normally appears only after
- -- a semicolon. One special glitch is that the keyword private is
- -- in this category only if it does NOT appear after WITH.
+ -- A semicolon signals the last aspect specification
- elsif Token in Token_Class_After_SM
- and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
- then
+ elsif Token = Tok_Semicolon then
exit;
- -- Otherwise keep going
+ -- In the case of a mistyped semicolon, any token which follows a
+ -- semicolon signals the last aspect specification.
- else
- Scan;
+ elsif Token in Token_Class_After_SM then
+ exit;
end if;
+
+ -- Keep on resyncing
+
+ Scan;
end loop;
-- Fall out of loop with resynchronization complete
Resync_Resume;
- end Resync_Past_Semicolon;
+ end Resync_Past_Malformed_Aspect;
- -------------------------
- -- Resync_To_Semicolon --
- -------------------------
+ ---------------------------
+ -- Resync_Past_Semicolon --
+ ---------------------------
- procedure Resync_To_Semicolon is
+ procedure Resync_Past_Semicolon is
begin
Resync_Init;
@@ -196,6 +224,7 @@
-- Done if we are at a semicolon
if Token = Tok_Semicolon then
+ Scan; -- past semicolon
exit;
-- Done if we are at a token which normally appears only after
@@ -217,7 +246,7 @@
-- Fall out of loop with resynchronization complete
Resync_Resume;
- end Resync_To_Semicolon;
+ end Resync_Past_Semicolon;
----------------------------------------------
-- Resync_Past_Semicolon_Or_To_Loop_Or_Then --
@@ -275,35 +304,6 @@
end if;
end Resync_Resume;
- --------------------
- -- Resync_To_When --
- --------------------
-
- procedure Resync_To_When is
- begin
- Resync_Init;
-
- loop
- -- Done if at semicolon, WHEN or IS
-
- if Token = Tok_Semicolon
- or else Token = Tok_When
- or else Token = Tok_Is
- then
- exit;
-
- -- Otherwise keep going
-
- else
- Scan;
- end if;
- end loop;
-
- -- Fall out of loop with resynchronization complete
-
- Resync_Resume;
- end Resync_To_When;
-
---------------------------
-- Resync_Semicolon_List --
---------------------------
@@ -340,4 +340,68 @@
Resync_Resume;
end Resync_Semicolon_List;
+ -------------------------
+ -- Resync_To_Semicolon --
+ -------------------------
+
+ procedure Resync_To_Semicolon is
+ begin
+ Resync_Init;
+
+ loop
+ -- Done if we are at a semicolon
+
+ if Token = Tok_Semicolon then
+ exit;
+
+ -- Done if we are at a token which normally appears only after
+ -- a semicolon. One special glitch is that the keyword private is
+ -- in this category only if it does NOT appear after WITH.
+
+ elsif Token in Token_Class_After_SM
+ and then (Token /= Tok_Private or else Prev_Token /= Tok_With)
+ then
+ exit;
+
+ -- Otherwise keep going
+
+ else
+ Scan;
+ end if;
+ end loop;
+
+ -- Fall out of loop with resynchronization complete
+
+ Resync_Resume;
+ end Resync_To_Semicolon;
+
+ --------------------
+ -- Resync_To_When --
+ --------------------
+
+ procedure Resync_To_When is
+ begin
+ Resync_Init;
+
+ loop
+ -- Done if at semicolon, WHEN or IS
+
+ if Token = Tok_Semicolon
+ or else Token = Tok_When
+ or else Token = Tok_Is
+ then
+ exit;
+
+ -- Otherwise keep going
+
+ else
+ Scan;
+ end if;
+ end loop;
+
+ -- Fall out of loop with resynchronization complete
+
+ Resync_Resume;
+ end Resync_To_When;
+
end Sync;
Index: par-ch13.adb
===================================================================
--- par-ch13.adb (revision 207879)
+++ par-ch13.adb (working copy)
@@ -149,9 +149,9 @@
function Get_Aspect_Specifications
(Semicolon : Boolean := True) return List_Id
is
+ A_Id : Aspect_Id;
+ Aspect : Node_Id;
Aspects : List_Id;
- Aspect : Node_Id;
- A_Id : Aspect_Id;
OK : Boolean;
begin
@@ -173,9 +173,13 @@
loop
OK := True;
+ -- The aspect mark is not an identifier
+
if Token /= Tok_Identifier then
Error_Msg_SC ("aspect identifier expected");
+ -- Skip the whole aspect specification list
+
if Semicolon then
Resync_Past_Semicolon;
end if;
@@ -183,17 +187,16 @@
return Aspects;
end if;
- -- We have an identifier (which should be an aspect identifier)
-
A_Id := Get_Aspect_Id (Token_Name);
Aspect :=
Make_Aspect_Specification (Token_Ptr,
Identifier => Token_Node);
- -- No valid aspect identifier present
+ -- The aspect mark is not recognized
if A_Id = No_Aspect then
Error_Msg_SC ("aspect identifier expected");
+ OK := False;
-- Check bad spelling
@@ -209,18 +212,24 @@
Scan; -- past incorrect identifier
if Token = Tok_Apostrophe then
- Scan; -- past '
+ Scan; -- past apostrophe
Scan; -- past presumably CLASS
end if;
+ -- Attempt to parse the aspect definition by assuming it is an
+ -- expression.
+
if Token = Tok_Arrow then
- Scan; -- Past arrow
+ Scan; -- past arrow
Set_Expression (Aspect, P_Expression);
- OK := False;
+ -- The aspect may behave as a boolean aspect
+
elsif Token = Tok_Comma then
- OK := False;
+ null;
+ -- Otherwise the aspect contains a junk definition
+
else
if Semicolon then
Resync_Past_Semicolon;
@@ -229,7 +238,7 @@
return Aspects;
end if;
- -- OK aspect scanned
+ -- Aspect mark is OK
else
Scan; -- past identifier
@@ -237,60 +246,58 @@
-- Check for 'Class present
if Token = Tok_Apostrophe then
- if not Class_Aspect_OK (A_Id) then
- Error_Msg_Node_1 := Identifier (Aspect);
- Error_Msg_SC ("aspect& does not permit attribute here");
+ if Class_Aspect_OK (A_Id) then
Scan; -- past apostrophe
- Scan; -- past presumed CLASS
- OK := False;
- else
- Scan; -- past apostrophe
-
- if Token /= Tok_Identifier
- or else Token_Name /= Name_Class
+ if Token = Tok_Identifier
+ and then Token_Name = Name_Class
then
+ Scan; -- past CLASS
+ Set_Class_Present (Aspect);
+ else
Error_Msg_SC ("Class attribute expected here");
OK := False;
if Token = Tok_Identifier then
Scan; -- past identifier not CLASS
end if;
+ end if;
- else
- Scan; -- past CLASS
- Set_Class_Present (Aspect);
- end if;
+ -- The aspect does not allow 'Class
+
+ else
+ Error_Msg_Node_1 := Identifier (Aspect);
+ Error_Msg_SC ("aspect& does not permit attribute here");
+ OK := False;
+
+ Scan; -- past apostrophe
+ Scan; -- past presumably CLASS
end if;
end if;
- -- Test case of missing aspect definition
+ -- Check for a missing aspect definition. Aspects with optional
+ -- definitions are not considered.
- if Token = Tok_Comma
- or else Token = Tok_Semicolon
- then
+ if Token = Tok_Comma or else Token = Tok_Semicolon then
if Aspect_Argument (A_Id) /= Optional_Expression
- and then
- Aspect_Argument (A_Id) /= Optional_Name
+ and then Aspect_Argument (A_Id) /= Optional_Name
then
Error_Msg_Node_1 := Identifier (Aspect);
Error_Msg_AP ("aspect& requires an aspect definition");
OK := False;
end if;
+ -- Check for a missing arrow when the aspect has a definition
+
elsif not Semicolon and then Token /= Tok_Arrow then
if Aspect_Argument (A_Id) /= Optional_Expression
- and then
- Aspect_Argument (A_Id) /= Optional_Name
+ and then Aspect_Argument (A_Id) /= Optional_Name
then
- -- The name or expression may be there, but the arrow is
- -- missing. Skip to the end of the declaration.
-
T_Arrow;
Resync_To_Semicolon;
end if;
- -- Here we have an aspect definition
+ -- Otherwise we have an aspect definition
else
if Token = Tok_Arrow then
@@ -300,9 +307,107 @@
OK := False;
end if;
+ -- Detect a common error where the non-null definition of
+ -- aspect Depends, Global, Refined_Depends or Refined_Global
+ -- must be enclosed in parentheses.
+
+ if Token /= Tok_Left_Paren and then Token /= Tok_Null then
+
+ -- [Refined_]Depends
+
+ if A_Id = Aspect_Depends
+ or else
+ A_Id = Aspect_Refined_Depends
+ then
+ Error_Msg_SC -- CODEFIX
+ ("missing ""(""");
+ Resync_Past_Malformed_Aspect;
+
+ -- Return when the current aspect is the last in the list
+ -- of specifications and the list applies to a body.
+
+ if Token = Tok_Is then
+ return Aspects;
+ end if;
+
+ -- [Refined_]Global
+
+ elsif A_Id = Aspect_Global
+ or else
+ A_Id = Aspect_Refined_Global
+ then
+ declare
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past item or mode_selector
+
+ -- Emit an error when the aspect has a mode_selector
+ -- as the moded_global_list must be parenthesized:
+ -- with Global => Output => Item
+
+ if Token = Tok_Arrow then
+ Restore_Scan_State (Scan_State);
+ Error_Msg_SC -- CODEFIX
+ ("missing ""(""");
+ Resync_Past_Malformed_Aspect;
+
+ -- Return when the current aspect is the last in
+ -- the list of specifications and the list applies
+ -- to a body.
+
+ if Token = Tok_Is then
+ return Aspects;
+ end if;
+
+ elsif Token = Tok_Comma then
+ Scan; -- past comma
+
+ -- An item followed by a comma does not need to
+ -- be parenthesized if the next token is a valid
+ -- aspect name:
+ -- with Global => Item,
+ -- Aspect => ...
+
+ if Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ Restore_Scan_State (Scan_State);
+
+ -- Otherwise this is a list of items in which case
+ -- the list must be parenthesized.
+
+ else
+ Restore_Scan_State (Scan_State);
+ Error_Msg_SC -- CODEFIX
+ ("missing ""(""");
+ Resync_Past_Malformed_Aspect;
+
+ -- Return when the current aspect is the last
+ -- in the list of specifications and the list
+ -- applies to a body.
+
+ if Token = Tok_Is then
+ return Aspects;
+ end if;
+ end if;
+
+ -- The definition of [Refined_]Global does not need to
+ -- be parenthesized.
+
+ else
+ Restore_Scan_State (Scan_State);
+ end if;
+ end;
+ end if;
+ end if;
+
+ -- Parse the aspect definition depening on the expected
+ -- argument kind.
+
if Aspect_Argument (A_Id) = Name
- or else
- Aspect_Argument (A_Id) = Optional_Name
+ or else Aspect_Argument (A_Id) = Optional_Name
then
Set_Expression (Aspect, P_Name);
@@ -315,18 +420,21 @@
end if;
end if;
- -- If OK clause scanned, add it to the list
+ -- Add the aspect to the resulting list only when it was properly
+ -- parsed.
if OK then
Append (Aspect, Aspects);
end if;
+ -- The aspect specification list contains more than one aspect
+
if Token = Tok_Comma then
Scan; -- past comma
goto Continue;
- -- Recognize the case where a comma is missing between two
- -- aspects, issue an error and proceed with next aspect.
+ -- Check for a missing comma between two aspects. Emit an error
+ -- and proceed to the next aspect.
elsif Token = Tok_Identifier
and then Get_Aspect_Id (Token_Name) /= No_Aspect
@@ -338,20 +446,25 @@
Save_Scan_State (Scan_State);
Scan; -- past identifier
- if Token = Tok_Arrow then
+ -- Attempt to detect ' or => following a potential aspect
+ -- mark.
+
+ if Token = Tok_Apostrophe or else Token = Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_AP -- CODEFIX
("|missing "",""");
goto Continue;
+ -- The construct following the current aspect is not an
+ -- aspect.
+
else
Restore_Scan_State (Scan_State);
end if;
end;
- -- Recognize the case where a semicolon was mistyped for a comma
- -- between two aspects, issue an error and proceed with next
- -- aspect.
+ -- Check for a mistyped semicolon in place of a comma between two
+ -- aspects. Emit an error and proceed to the next aspect.
elsif Token = Tok_Semicolon then
declare
@@ -366,20 +479,22 @@
then
Scan; -- past identifier
- if Token = Tok_Arrow then
+ -- Attempt to detect ' or => following a potential aspect
+ -- mark.
+
+ if Token = Tok_Apostrophe or else Token = Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("|"";"" should be "",""");
Scan; -- past semicolon
goto Continue;
-
- else
- Restore_Scan_State (Scan_State);
end if;
+ end if;
- else
- Restore_Scan_State (Scan_State);
- end if;
+ -- The construct following the current aspect is not an
+ -- aspect.
+
+ Restore_Scan_State (Scan_State);
end;
end if;
@@ -397,7 +512,6 @@
end loop;
return Aspects;
-
end Get_Aspect_Specifications;
--------------------------------------------
Index: par.adb
===================================================================
--- par.adb (revision 207879)
+++ par.adb (working copy)
@@ -1079,6 +1079,10 @@
-- advanced to the next vertical bar, arrow, or semicolon, whichever
-- comes first. We also quit if we encounter an end of file.
+ procedure Resync_Cunit;
+ -- Synchronize to next token which could be the start of a compilation
+ -- unit, or to the end of file token.
+
procedure Resync_Expression;
-- Used if an error is detected during the parsing of an expression.
-- It skips past tokens until either a token which cannot be part of
@@ -1087,6 +1091,11 @@
-- current parenthesis level (a parenthesis level counter is maintained
-- to carry out this test).
+ procedure Resync_Past_Malformed_Aspect;
+ -- Used when parsing aspect specifications to skip a malformed aspect.
+ -- The scan pointer is positioned next to a comma, a semicolon or "is"
+ -- when the aspect applies to a body.
+
procedure Resync_Past_Semicolon;
-- Used if an error occurs while scanning a sequence of declarations.
-- The scan pointer is positioned past the next semicolon and the scan
@@ -1094,30 +1103,26 @@
-- starts a declaration (but we make sure to skip at least one token
-- in this case, to avoid getting stuck in a loop).
- procedure Resync_To_Semicolon;
- -- Similar to Resync_Past_Semicolon, except that the scan pointer is
- -- left pointing to the semicolon rather than past it.
-
procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then;
-- Used if an error occurs while scanning a sequence of statements. The
-- scan pointer is positioned past the next semicolon, or to the next
-- occurrence of either then or loop, and the scan resumes.
- procedure Resync_To_When;
- -- Used when an error occurs scanning an entry index specification. The
- -- scan pointer is positioned to the next WHEN (or to IS or semicolon if
- -- either of these appear before WHEN, indicating another error has
- -- occurred).
-
procedure Resync_Semicolon_List;
-- Used if an error occurs while scanning a parenthesized list of items
-- separated by semicolons. The scan pointer is advanced to the next
-- semicolon or right parenthesis at the outer parenthesis level, or
-- to the next is or RETURN keyword occurrence, whichever comes first.
- procedure Resync_Cunit;
- -- Synchronize to next token which could be the start of a compilation
- -- unit, or to the end of file token.
+ procedure Resync_To_Semicolon;
+ -- Similar to Resync_Past_Semicolon, except that the scan pointer is
+ -- left pointing to the semicolon rather than past it.
+
+ procedure Resync_To_When;
+ -- Used when an error occurs scanning an entry index specification. The
+ -- scan pointer is positioned to the next WHEN (or to IS or semicolon if
+ -- either of these appear before WHEN, indicating another error has
+ -- occurred).
end Sync;
--------------
