===================================================================
@@ -132,6 +132,251 @@
return Result;
end Aspect_Specifications_Present;
+ -------------------------------
+ -- Get_Aspect_Specifications --
+ -------------------------------
+
+ function Get_Aspect_Specifications
+ (Semicolon : Boolean := True) return List_Id
+ is
+ Aspects : List_Id;
+ Aspect : Node_Id;
+ A_Id : Aspect_Id;
+ OK : Boolean;
+
+ begin
+ Aspects := Empty_List;
+
+ -- Check if aspect specification present
+
+ if not Aspect_Specifications_Present then
+ if Semicolon then
+ TF_Semicolon;
+ end if;
+
+ return Aspects;
+ end if;
+
+ Scan; -- past WITH
+ Aspects := Empty_List;
+
+ loop
+ OK := True;
+
+ if Token /= Tok_Identifier then
+ Error_Msg_SC ("aspect identifier expected");
+
+ if Semicolon then
+ Resync_Past_Semicolon;
+ end if;
+
+ 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
+
+ if A_Id = No_Aspect then
+ Error_Msg_SC ("aspect identifier expected");
+
+ -- Check bad spelling
+
+ for J in Aspect_Id loop
+ if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
+ Error_Msg_Name_1 := Aspect_Names (J);
+ Error_Msg_SC -- CODEFIX
+ ("\possible misspelling of%");
+ exit;
+ end if;
+ end loop;
+
+ Scan; -- past incorrect identifier
+
+ if Token = Tok_Apostrophe then
+ Scan; -- past '
+ Scan; -- past presumably CLASS
+ end if;
+
+ if Token = Tok_Arrow then
+ Scan; -- Past arrow
+ Set_Expression (Aspect, P_Expression);
+ OK := False;
+
+ elsif Token = Tok_Comma then
+ OK := False;
+
+ else
+ if Semicolon then
+ Resync_Past_Semicolon;
+ end if;
+
+ return Aspects;
+ end if;
+
+ -- OK aspect scanned
+
+ else
+ Scan; -- past identifier
+
+ -- 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");
+ Scan; -- past apostrophe
+ Scan; -- past presumed CLASS
+ OK := False;
+
+ else
+ Scan; -- past apostrophe
+
+ if Token /= Tok_Identifier
+ or else Token_Name /= Name_Class
+ then
+ Error_Msg_SC ("Class attribute expected here");
+ OK := False;
+
+ if Token = Tok_Identifier then
+ Scan; -- past identifier not CLASS
+ end if;
+
+ else
+ Scan; -- past CLASS
+ Set_Class_Present (Aspect);
+ end if;
+ end if;
+ end if;
+
+ -- Test case of missing aspect definition
+
+ if Token = Tok_Comma
+ or else Token = Tok_Semicolon
+ then
+ if Aspect_Argument (A_Id) /= Optional then
+ Error_Msg_Node_1 := Identifier (Aspect);
+ Error_Msg_AP ("aspect& requires an aspect definition");
+ OK := False;
+ end if;
+
+ elsif not Semicolon and then Token /= Tok_Arrow then
+ if Aspect_Argument (A_Id) /= Optional 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
+
+ else
+ if Token = Tok_Arrow then
+ Scan; -- past arrow
+ else
+ T_Arrow;
+ OK := False;
+ end if;
+
+ if Aspect_Argument (A_Id) = Name then
+ Set_Expression (Aspect, P_Name);
+ else
+ Set_Expression (Aspect, P_Expression);
+ end if;
+ end if;
+
+ -- If OK clause scanned, add it to the list
+
+ if OK then
+ Append (Aspect, Aspects);
+ end if;
+
+ 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.
+
+ elsif Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ declare
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past identifier
+
+ if Token = Tok_Arrow then
+ Restore_Scan_State (Scan_State);
+ Error_Msg_AP -- CODEFIX
+ ("|missing "",""");
+ goto Continue;
+
+ 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.
+
+ elsif Token = Tok_Semicolon then
+ declare
+ Scan_State : Saved_Scan_State;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan; -- past semicolon
+
+ if Token = Tok_Identifier
+ and then Get_Aspect_Id (Token_Name) /= No_Aspect
+ then
+ Scan; -- past identifier
+
+ if 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;
+
+ else
+ Restore_Scan_State (Scan_State);
+ end if;
+ end;
+ end if;
+
+ -- Must be terminator character
+
+ if Semicolon then
+ T_Semicolon;
+ end if;
+
+ exit;
+
+ <<Continue>>
+ null;
+ end if;
+ end loop;
+
+ return Aspects;
+
+ end Get_Aspect_Specifications;
+
--------------------------------------------
-- 13.1 Representation Clause (also I.7) --
--------------------------------------------
@@ -397,245 +642,20 @@
Semicolon : Boolean := True)
is
Aspects : List_Id;
- Aspect : Node_Id;
- A_Id : Aspect_Id;
- OK : Boolean;
Ptr : Source_Ptr;
begin
- -- Check if aspect specification present
- if not Aspect_Specifications_Present then
- if Semicolon then
- TF_Semicolon;
- end if;
-
- return;
- end if;
-
-- Aspect Specification is present
Ptr := Token_Ptr;
- Scan; -- past WITH
-- Here we have an aspect specification to scan, note that we don't
-- set the flag till later, because it may turn out that we have no
-- valid aspects in the list.
- Aspects := Empty_List;
- loop
- OK := True;
+ Aspects := Get_Aspect_Specifications (Semicolon);
- if Token /= Tok_Identifier then
- Error_Msg_SC ("aspect identifier expected");
-
- if Semicolon then
- Resync_Past_Semicolon;
- end if;
-
- return;
- 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
-
- if A_Id = No_Aspect then
- Error_Msg_SC ("aspect identifier expected");
-
- -- Check bad spelling
-
- for J in Aspect_Id loop
- if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
- Error_Msg_Name_1 := Aspect_Names (J);
- Error_Msg_SC -- CODEFIX
- ("\possible misspelling of%");
- exit;
- end if;
- end loop;
-
- Scan; -- past incorrect identifier
-
- if Token = Tok_Apostrophe then
- Scan; -- past '
- Scan; -- past presumably CLASS
- end if;
-
- if Token = Tok_Arrow then
- Scan; -- Past arrow
- Set_Expression (Aspect, P_Expression);
- OK := False;
-
- elsif Token = Tok_Comma then
- OK := False;
-
- else
- if Semicolon then
- Resync_Past_Semicolon;
- end if;
-
- return;
- end if;
-
- -- OK aspect scanned
-
- else
- Scan; -- past identifier
-
- -- 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");
- Scan; -- past apostrophe
- Scan; -- past presumed CLASS
- OK := False;
-
- else
- Scan; -- past apostrophe
-
- if Token /= Tok_Identifier
- or else Token_Name /= Name_Class
- then
- Error_Msg_SC ("Class attribute expected here");
- OK := False;
-
- if Token = Tok_Identifier then
- Scan; -- past identifier not CLASS
- end if;
-
- else
- Scan; -- past CLASS
- Set_Class_Present (Aspect);
- end if;
- end if;
- end if;
-
- -- Test case of missing aspect definition
-
- if Token = Tok_Comma
- or else Token = Tok_Semicolon
- then
- if Aspect_Argument (A_Id) /= Optional then
- Error_Msg_Node_1 := Identifier (Aspect);
- Error_Msg_AP ("aspect& requires an aspect definition");
- OK := False;
- end if;
-
- elsif not Semicolon and then Token /= Tok_Arrow then
- if Aspect_Argument (A_Id) /= Optional 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
-
- else
- if Token = Tok_Arrow then
- Scan; -- past arrow
- else
- T_Arrow;
- OK := False;
- end if;
-
- if Aspect_Argument (A_Id) = Name then
- Set_Expression (Aspect, P_Name);
- else
- Set_Expression (Aspect, P_Expression);
- end if;
- end if;
-
- -- If OK clause scanned, add it to the list
-
- if OK then
- Append (Aspect, Aspects);
- end if;
-
- 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.
-
- elsif Token = Tok_Identifier
- and then Get_Aspect_Id (Token_Name) /= No_Aspect
- then
- declare
- Scan_State : Saved_Scan_State;
-
- begin
- Save_Scan_State (Scan_State);
- Scan; -- past identifier
-
- if Token = Tok_Arrow then
- Restore_Scan_State (Scan_State);
- Error_Msg_AP -- CODEFIX
- ("|missing "",""");
- goto Continue;
-
- 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.
-
- elsif Token = Tok_Semicolon then
- declare
- Scan_State : Saved_Scan_State;
-
- begin
- Save_Scan_State (Scan_State);
- Scan; -- past semicolon
-
- if Token = Tok_Identifier
- and then Get_Aspect_Id (Token_Name) /= No_Aspect
- then
- Scan; -- past identifier
-
- if 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;
-
- else
- Restore_Scan_State (Scan_State);
- end if;
- end;
- end if;
-
- -- Must be terminator character
-
- if Semicolon then
- T_Semicolon;
- end if;
-
- exit;
-
- <<Continue>>
- null;
- end if;
- end loop;
-
-- Here if aspects present
if Is_Non_Empty_List (Aspects) then
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -876,6 +876,12 @@
-- for aspects so it does not matter whether the aspect specifications
-- are terminated by semicolon or some other character.
+ function Get_Aspect_Specifications
+ (Semicolon : Boolean := True) return List_Id;
+ -- Parse a list of aspects but do not attach them to a declaration node.
+ -- Subsidiary to the following procedure. Used when parsing a subprogram
+ -- specification that may be a declaration or a body.
+
procedure P_Aspect_Specifications
(Decl : Node_Id;
Semicolon : Boolean := True);
===================================================================
@@ -154,6 +154,7 @@
function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id is
Specification_Node : Node_Id;
Name_Node : Node_Id;
+ Aspects : List_Id;
Fpart_List : List_Id;
Fpart_Sloc : Source_Ptr;
Result_Not_Null : Boolean := False;
@@ -186,6 +187,8 @@
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Lreq := False;
+ Aspects := Empty_List;
+
-- Ada 2005: Scan leading NOT OVERRIDING indicator
if Token = Tok_Not then
@@ -810,6 +813,16 @@
New_Node (N_Subprogram_Body, Sloc (Specification_Node));
Set_Specification (Body_Node, Specification_Node);
+ -- If aspects are present, the specification is parsed as
+ -- a subprogram declaration, and we jump here after seeing
+ -- the keyword IS. Attach asspects previously collected to
+ -- the body.
+
+ if Is_Non_Empty_List (Aspects) then
+ Set_Parent (Aspects, Body_Node);
+ Set_Aspect_Specifications (Body_Node, Aspects);
+ end if;
+
-- In SPARK, a HIDE directive can be placed at the beginning
-- of a subprogram implementation, thus hiding the
-- subprogram body from SPARK tool-set. No violation of the
@@ -841,8 +854,25 @@
Decl_Node :=
New_Node (N_Subprogram_Declaration, Sloc (Specification_Node));
Set_Specification (Decl_Node, Specification_Node);
- P_Aspect_Specifications (Decl_Node);
+ Aspects := Get_Aspect_Specifications (Semicolon => False);
+ -- Aspects may be present on a subprogram body. The source parsed
+ -- so far is that of its specification, go parse the body and attach
+ -- the collected aspects, if any, to the body.
+
+ if Token = Tok_Is then
+ Scan;
+ goto Subprogram_Body;
+
+ else
+ if Is_Non_Empty_List (Aspects) then
+ Set_Parent (Aspects, Decl_Node);
+ Set_Aspect_Specifications (Decl_Node, Aspects);
+ end if;
+
+ TF_Semicolon;
+ end if;
+
-- If this is a context in which a subprogram body is permitted,
-- set active SIS entry in case (see section titled "Handling
-- Semicolon Used in Place of IS" in body of Parser package)
===================================================================
@@ -2504,6 +2504,19 @@
end if;
end if;
+ -- Ada 2012 aspects may appear in a subprogram body, but only if there
+ -- is no previous spec.
+
+ if Has_Aspects (N) then
+ if Present (Corresponding_Spec (N)) then
+ Error_Msg_N
+ ("aspect specifications must appear in subprogram declaration",
+ N);
+ else
+ Analyze_Aspect_Specifications (N, Body_Id);
+ end if;
+ end if;
+
-- Previously we scanned the body to look for nested subprograms, and
-- rejected an inline directive if nested subprograms were present,
-- because the back-end would generate conflicting symbols for the
Aspect specification can appear in subprogram bodies. To handle them in the parser the aspects that follow a subprogram specification must be collected, and attached to the proper declaration or body only after the nature of the enclosing construct has been determined. The following must compile quietly in Ada_2012 mode: procedure P with Inline is begin null; end; Aspects are only allowed on a subprogram body if there is no previous spec for it. Compiling p2.adb must yield: p2.adb:4:05: aspect specifications must appear in subprogram declaration with Text_IO; use Text_IO; procedure P2 is function F return Integer; function F return Integer with Inline is begin return 15; end; begin null; end P2; Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-23 Ed Schonberg <schonberg@adacore.com> * par.adb: new subprogram Get_Aspect_Specifications. * par-ch6.adb (P_Subprogram): handle subprogram bodies with aspect specifications. * par-ch13.adb (Get_Aspect_Specifications): extracted from P_Aspect_Specifications. Collect aspect specifications in some legal context, but do not attach them to any declaration. Used when parsing subprogram declarations or bodies that include aspect specifications. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): If aspects are present, analyze them, or reject them if the subprogram as a previous spec.