Patchwork [Ada] Aspect specifications in subprogram bodies

login
register
mail settings
Submitter Arnaud Charlet
Date July 23, 2012, 8:12 a.m.
Message ID <20120723081241.GA4984@adacore.com>
Download mbox | patch
Permalink /patch/172568/
State New
Headers show

Comments

Arnaud Charlet - July 23, 2012, 8:12 a.m.
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.

Patch

Index: par-ch13.adb
===================================================================
--- par-ch13.adb	(revision 189768)
+++ par-ch13.adb	(working copy)
@@ -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
Index: par.adb
===================================================================
--- par.adb	(revision 189768)
+++ par.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          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);
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 189768)
+++ par-ch6.adb	(working copy)
@@ -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)
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 189768)
+++ sem_ch6.adb	(working copy)
@@ -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