===================================================================
@@ -556,11 +556,23 @@
end if;
end loop;
- -- If aspects scanned, store them
+ -- Here if aspects present
if Is_Non_Empty_List (Aspects) then
- if Decl = Error then
+
+ -- If Decl is Empty, we just ignore the aspects (the caller in this
+ -- case has always issued an appropriate error message).
+
+ if Decl = Empty then
+ null;
+
+ -- If Decl is Error, we ignore the aspects, and issue a message
+
+ elsif Decl = Error then
Error_Msg ("aspect specifications not allowed here", Ptr);
+
+ -- Here aspects are allowed, and we store them
+
else
Set_Parent (Aspects, Decl);
Set_Aspect_Specifications (Decl, Aspects);
===================================================================
@@ -166,7 +166,10 @@
-- Check_End --
---------------
- function Check_End (Decl : Node_Id := Empty) return Boolean is
+ function Check_End
+ (Decl : Node_Id := Empty;
+ Is_Loc : Source_Ptr := No_Location) return Boolean
+ is
Name_On_Separate_Line : Boolean;
-- Set True if the name on an END line is on a separate source line
-- from the END. This is highly suspicious, but is allowed. The point
@@ -401,11 +404,31 @@
if End_Type /= E_Record then
- -- Scan aspect specifications if permitted here
+ -- Scan aspect specifications
if Aspect_Specifications_Present then
+
+ -- Aspect specifications not allowed
+
if No (Decl) then
- P_Aspect_Specifications (Error);
+
+ -- Package declaration case
+
+ if Is_Loc /= No_Location then
+ Error_Msg_SC
+ ("misplaced aspects for package declaration");
+ Error_Msg
+ ("info: aspect specifications belong here", Is_Loc);
+ P_Aspect_Specifications (Empty);
+
+ -- Other cases where aspect specifications are not allowed
+
+ else
+ P_Aspect_Specifications (Error);
+ end if;
+
+ -- Aspect specifications allowed
+
else
P_Aspect_Specifications (Decl);
end if;
@@ -664,15 +687,16 @@
-- Error recovery: cannot raise Error_Resync;
procedure End_Statements
- (Parent : Node_Id := Empty;
- Decl : Node_Id := Empty)
+ (Parent : Node_Id := Empty;
+ Decl : Node_Id := Empty;
+ Is_Sloc : Source_Ptr := No_Location)
is
begin
-- This loop runs more than once in the case where Check_End rejects
-- the END sequence, as indicated by Check_End returning False.
loop
- if Check_End (Decl) then
+ if Check_End (Decl, Is_Sloc) then
if Present (Parent) then
Set_End_Label (Parent, End_Labl);
end if;
===================================================================
@@ -870,7 +870,6 @@
-- Semicolon is True, a terminating semicolon is also scanned. If this
-- argument is False, the scan pointer is left pointing past the aspects
-- and the caller must check for a proper terminator.
- -- left pointing past the aspects, presumably pointing to a terminator.
--
-- P_Aspect_Specification is called with the current token pointing to
-- either a WITH keyword starting an aspect specification, or an
@@ -880,10 +879,14 @@
-- the given declaration node. A list of aspects is built and stored for
-- this declaration node using a call to Set_Aspect_Specifications. If
-- no WITH keyword is present, then this call has no effect other than
- -- scanning out the terminator if it is a semicolon. If Decl is Error on
- -- entry, any scanned aspect specifications are ignored and a message is
- -- output saying aspect specifications not permitted here.
+ -- scanning out the terminator if it is a semicolon.
+ -- If Decl is Error on entry, any scanned aspect specifications are
+ -- ignored and a message is output saying aspect specifications not
+ -- permitted here. If Decl is Empty, then scanned aspect specifications
+ -- are also ignored, but no error message is given (this is used when
+ -- the caller has already taken care of the error message).
+
function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id;
-- Function to parse a code statement. The caller has scanned out
-- the name to be used as the subtype mark (but has not checked that
@@ -908,7 +911,9 @@
-- Routines for handling end lines, including scope recovery
package Endh is
- function Check_End (Decl : Node_Id := Empty) return Boolean;
+ function Check_End
+ (Decl : Node_Id := Empty;
+ Is_Loc : Source_Ptr := No_Location) return Boolean;
-- Called when an end sequence is required. In the absence of an error
-- situation, Token contains Tok_End on entry, but in a missing end
-- case, this may not be the case. Pop_End_Context is used to determine
@@ -922,7 +927,15 @@
--
-- If Decl is non-empty, then aspect specifications are permitted
-- following the end, and Decl is the declaration node with which
- -- these aspect specifications are to be associated.
+ -- these aspect specifications are to be associated. If Decl is empty,
+ -- then aspect specifications are not permitted and will generate an
+ -- error message.
+ --
+ -- Is_Loc is set to other than the default only for the case of a
+ -- package declaration. It points to the IS keyword of the declaration,
+ -- and is used to specialize the error messages for misplaced aspect
+ -- specifications in this case. Note that Decl is always Empty if Is_Loc
+ -- is set.
procedure End_Skip;
-- Skip past an end sequence. On entry Token contains Tok_End, and we
@@ -933,8 +946,9 @@
-- error messages while carrying this out.
procedure End_Statements
- (Parent : Node_Id := Empty;
- Decl : Node_Id := Empty);
+ (Parent : Node_Id := Empty;
+ Decl : Node_Id := Empty;
+ Is_Sloc : Source_Ptr := No_Location);
-- Called when an end is required or expected to terminate a sequence
-- of statements. The caller has already made an appropriate entry in
-- the Scope.Table to describe the expected form of the end. This can
@@ -945,6 +959,14 @@
-- If Decl is non-null, then it is a declaration node, and aspect
-- specifications are permitted after the end statement. These aspect
-- specifications, if present, are stored in this declaration node.
+ -- If Decl is null, then aspect specifications are not permitted after
+ -- the end statement.
+ --
+ -- In the case where Decl is null, Is_Sloc determines the handling. If
+ -- it is set to No_Location, then aspect specifications are ignored and
+ -- an error message is given. Is_Sloc is used in the package declaration
+ -- case to point to the IS, and is used to specialize the error emssages
+ -- issued in this case.
end Endh;
--------------
===================================================================
@@ -98,6 +98,13 @@
Name_Node : Node_Id;
Package_Sloc : Source_Ptr;
+ Aspect_Sloc : Source_Ptr := No_Location;
+ -- Save location of WITH for scanned aspects. Left set to No_Location
+ -- if no aspects scanned before the IS keyword.
+
+ Is_Sloc : Source_Ptr;
+ -- Save location of IS token for package declaration
+
Dummy_Node : constant Node_Id :=
New_Node (N_Package_Specification, Token_Ptr);
-- Dummy node to attach aspect specifications to until we properly
@@ -178,7 +185,12 @@
-- Generic package instantiation or package declaration
else
- P_Aspect_Specifications (Dummy_Node, Semicolon => False);
+ if Aspect_Specifications_Present then
+ Aspect_Sloc := Token_Ptr;
+ P_Aspect_Specifications (Dummy_Node, Semicolon => False);
+ end if;
+
+ Is_Sloc := Token_Ptr;
TF_Is;
-- Case of generic instantiation
@@ -189,6 +201,12 @@
("generic instantiation cannot appear here!");
end if;
+ if Aspect_Sloc /= No_Location then
+ Error_Msg
+ ("misplaced aspects for package instantiation",
+ Aspect_Sloc);
+ end if;
+
Scan; -- past NEW
Package_Node :=
@@ -197,7 +215,15 @@
Set_Name (Package_Node, P_Qualified_Simple_Name);
Set_Generic_Associations
(Package_Node, P_Generic_Actual_Part_Opt);
- P_Aspect_Specifications (Error);
+
+ if Aspect_Sloc /= No_Location
+ and then not Aspect_Specifications_Present
+ then
+ Error_Msg_SC ("\info: aspect specifications belong here");
+ Move_Aspects (From => Dummy_Node, To => Package_Node);
+ end if;
+
+ P_Aspect_Specifications (Package_Node);
Pop_Scope_Stack;
-- Case of package declaration or package specification
@@ -251,12 +277,12 @@
Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
end if;
- End_Statements (Specification_Node);
+ End_Statements (Specification_Node, Empty, Is_Sloc);
+ Move_Aspects (From => Dummy_Node, To => Package_Node);
end if;
end if;
end if;
- Move_Aspects (From => Dummy_Node, To => Package_Node);
return Package_Node;
end P_Package;
This patch makes the parser match the latest proposed syntax for aspect placement for package declarations (aspects come before the IS) and package declarations (aspects come before the semicolon). Here is a test showing the output (compiled with -gnatld7) 1. pragma Ada_2012; 2. package AspectInst is 3. generic package P with -- OK 4. Pure 5. is 6. end; 7. 8. generic package P2 is -- ERROR | >>> info: aspect specifications belong here 9. end with | >>> misplaced aspects for package declaration 10. Pure; 11. 12. package PP is new P with -- OK 13. Pure; 14. 15. package PQ with -- ERROR | >>> misplaced aspects for package instantiation 16. Pure 17. is new P; | >>> info: aspect specifications belong here 18. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-02 Robert Dewar <dewar@adacore.com> * par-ch13.adb (P_Aspect_Specification): New meaning of Decl = Empty * par-ch7.adb (P_Package): Proper placement of aspects for package decl/instantiation. * par-endh.adb (Check_End): Ad Is_Sloc parameter (End_Statements): Add Is_Sloc parameterr * par.adb (P_Aspect_Specification): New meaning of Decl = Empty (Check_End): Ad Is_Sloc parameter (End_Statements): Add Is_Sloc parameterr