Patchwork [Ada] Aspect specifications can appear on subprogram body stubs

login
register
mail settings
Submitter Arnaud Charlet
Date April 11, 2013, 12:46 p.m.
Message ID <20130411124628.GA2644@adacore.com>
Download mbox | patch
Permalink /patch/235728/
State New
Headers show

Comments

Arnaud Charlet - April 11, 2013, 12:46 p.m.
In Ada 2012, aspect specifications can appear on subprogram body stubs, as long
as there is no previous corresponding subprogram declaration. This patch
handles properly aspects on such stubs, and rejects aspects when a previous
subprogram declaration exists.

executing the following:

   gnatmake -q -Paspects
   main

Must print:

   Done

---
project Aspects is
   package Compiler is
      for Default_Switches ("ada") use ("-gnat12", "-gnata");
   end Compiler;

   for Main use ("main.adb");

end Aspects;
---
with Pkg;
with Ada.Text_IO;    use Ada.Text_IO;
with Ada.Assertions; use Ada.Assertions;

procedure Main is
begin

   begin
      Pkg.Sep1 (0);
      Put_Line ("ERROR 1, an exception should be raised");
   exception
      when Assertion_Error =>
         null;
   end;

   begin
      Pkg.Sep2 (1);
      Put_Line
        ("ERROR 2, an exception should be raised (or compilation error)");
   exception
      when Assertion_Error =>
         null;
   end;

   begin
      Pkg.Call_Sep3 (0);
      Put_Line ("ERROR 3, an exception should be raised");
   exception
      when Assertion_Error =>
         null;
   end;

   Put_Line ("Done");
end Main;
---
package Pkg is

   procedure Sep1 (I : Integer)
   with Pre => I > 0;

   procedure Sep2 (I : Integer)
   with Pre => I > 10;

   procedure Call_Sep3 (I : Integer);
end Pkg;
---
package body Pkg is

  procedure Sep1 (I : Integer)
   is separate;

   procedure Sep2 (I : Integer)
   is separate;

   procedure Sep3 (I : Integer)
   with Pre => I > 10
   is separate;

   procedure Call_Sep3 (I : Integer) is
   begin
      Sep3 (I);
   end;
end Pkg;
---
separate (Pkg)
procedure Sep1 (I : Integer) is
begin
   null;
end Sep1;
---
separate (Pkg)
procedure Sep2 (I : Integer) is
begin
   null;
end Sep2;
---
separate (Pkg)
procedure Sep3 (I : Integer) is
begin
   null;
end Sep3;

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* par-ch6.adb (P_Subprogram): Attach aspects to subprogram stub.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Allow aspects on
	subprogram stubs.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze generated
	pre/post pragmas at once before analyzing the proper body.
	* sem_prag.adb (Chain_PPC): Handle pragma that comes from an
	aspect on a subprogram stub.
	* aspects.adb: Aspect specifications can appear on a
	subprogram_Body_Stub.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 197778)
+++ sem_prag.adb	(working copy)
@@ -2187,13 +2187,18 @@ 
                  ("aspect % requires ''Class for null procedure");
 
             --  Pre/postconditions are legal on a subprogram body if it is not
-            --  a completion of a declaration.
+            --  a completion of a declaration. They are also legal on a stub
+            --  with no previous declarations (this is checked when processing
+            --  the corresponding aspects).
 
             elsif Nkind (PO) = N_Subprogram_Body
               and then Acts_As_Spec (PO)
             then
                null;
 
+            elsif Nkind (PO) = N_Subprogram_Body_Stub then
+               null;
+
             elsif not Nkind_In (PO, N_Subprogram_Declaration,
                                     N_Expression_Function,
                                     N_Generic_Subprogram_Declaration,
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 197743)
+++ par-ch6.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -684,6 +684,15 @@ 
             Stub_Node :=
               New_Node (N_Subprogram_Body_Stub, Sloc (Specification_Node));
             Set_Specification (Stub_Node, Specification_Node);
+
+            --  The specification has been parsed as part of a subprogram
+            --  declaration, and aspects have already been collected.
+
+            if Is_Non_Empty_List (Aspects) then
+               Set_Parent (Aspects, Stub_Node);
+               Set_Aspect_Specifications (Stub_Node, Aspects);
+            end if;
+
             Scan; -- past SEPARATE
             Pop_Scope_Stack;
             TF_Semicolon;
Index: aspects.adb
===================================================================
--- aspects.adb	(revision 197774)
+++ aspects.adb	(working copy)
@@ -220,6 +220,7 @@ 
       N_Subprogram_Body                        => True,
       N_Subprogram_Declaration                 => True,
       N_Subprogram_Renaming_Declaration        => True,
+      N_Subprogram_Body_Stub                   => True,
       N_Subtype_Declaration                    => True,
       N_Task_Body                              => True,
       N_Task_Type_Declaration                  => True,
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 197779)
+++ sem_ch6.adb	(working copy)
@@ -2681,10 +2681,11 @@ 
       end if;
 
       --  Ada 2012 aspects may appear in a subprogram body, but only if there
-      --  is no previous spec.
+      --  is no previous spec. Ditto for a subprogram stub that does not have
+      --  a corresponding spec, but for which there may also be a spec_id.
 
       if Has_Aspects (N) then
-         if Present (Corresponding_Spec (N)) then
+         if Present (Spec_Id) then
             Error_Msg_N
               ("aspect specifications must appear in subprogram declaration",
                 N);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 197774)
+++ sem_ch13.adb	(working copy)
@@ -1693,6 +1693,14 @@ 
 
                   else
                      Insert_After (N, Aitem);
+
+                     --  Pre/Postconditions on stubs are analyzed at once,
+                     --  because the proper body is analyzed next, and the
+                     --  contract must be captured before the body.
+
+                     if Nkind (N) = N_Subprogram_Body_Stub then
+                        Analyze (Aitem);
+                     end if;
                   end if;
 
                   goto Continue;