2011-08-02 Yannick Moy <moy@adacore.com>

	* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_prag.adb, sem.ads,
	sem_util.adb, sem_util.ads, sem_res.adb, sem_ch2.adb, sem_ch4.adb,
	sem_ch6.adb, sem_ch11.adb: Add semantic flag In_Pre_Post_Expression to
	indicate that we are in a precondition or postcondition. This is used in
	Mark_Non_ALFA_Subprogram (renaming of Mark_Non_ALFA_Subprogram_Body) to
	decide whether to flag the spec or body of the current subprogram as
	not in ALFA.

2011-08-02  Fabien Chouteau  <chouteau@adacore.com>

	* impunit.adb: Add Ada.Execution_Time.Interrupts in the Ada2012 package
	list.
	* a-extiin.ads: New file.

2011-08-02  Bob Duff  <duff@adacore.com>

	* a-direct.adb (Rename): Implement AI05-0231-1. In particular, Rename
	now raises Name_Error instead of Use_Error in certain cases. The other
	parts of this AI were already implemented properly.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177187 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cabcec110d347d8dbdfab8e9cc555a9a894285a4..b74d7a5faf7280e07c10abf9b762705b25a9d41c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2011-08-02  Yannick Moy  <moy@adacore.com>
+
+       * sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_prag.adb, sem.ads,
+       sem_util.adb, sem_util.ads, sem_res.adb, sem_ch2.adb, sem_ch4.adb,
+       sem_ch6.adb, sem_ch11.adb: Add semantic flag In_Pre_Post_Expression to
+       indicate that we are in a precondition or postcondition. This is used in
+       Mark_Non_ALFA_Subprogram (renaming of Mark_Non_ALFA_Subprogram_Body) to
+       decide whether to flag the spec or body of the current subprogram as
+       not in ALFA.
+
+2011-08-02  Fabien Chouteau  <chouteau@adacore.com>
+
+       * impunit.adb: Add Ada.Execution_Time.Interrupts in the Ada2012 package
+       list.
+       * a-extiin.ads: New file.
+
+2011-08-02  Bob Duff  <duff@adacore.com>
+
+       * a-direct.adb (Rename): Implement AI05-0231-1. In particular, Rename
+       now raises Name_Error instead of Use_Error in certain cases. The other
+       parts of this AI were already implemented properly.
+
 2011-08-02  Vincent Celier  <celier@adacore.com>
 
        * link.c: Only import "auto-host.h" when building the gnattools.

diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index e4a2697e06344bc265b40c30995cac7a5383a529..81b8dd5e86098a1f11ba311a95cf37f4d3ba540f 100644 (file)
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -40,6 +40,7 @@ with Ada.Unchecked_Deallocation;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 
 with System.CRTL;    use System.CRTL;
+with System.OS_Constants;
 with System.OS_Lib;  use System.OS_Lib;
 with System.Regexp;  use System.Regexp;
 with System.File_IO; use System.File_IO;
@@ -1060,8 +1061,20 @@ package body Ada.Directories is
          Rename_File (Old_Name, New_Name, Success);
 
          if not Success then
-            raise Use_Error with
-              "file """ & Old_Name & """ could not be renamed";
+            --  AI05-0231-1: Name_Error should be raised in case a directory
+            --  component of New_Name does not exist (as in New_Name =>
+            --  "/no-such-dir/new-filename"). ENOENT indicates that. ENOENT
+            --  also indicate that the Old_Name does not exist, but we already
+            --  checked for that above. All other errors are Use_Error.
+
+            if Errno = System.OS_Constants.ENOENT then
+               raise Name_Error with
+                 "file """ & Containing_Directory (New_Name) & """ not found";
+
+            else
+               raise Use_Error with
+                 "file """ & Old_Name & """ could not be renamed";
+            end if;
          end if;
       end if;
    end Rename;

diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index e911b0ac22dff03ebf03e3a818c51fb5f0bdf488..65e18428cd8860b4e36e2ffe8d1fff6b19ac2e5a 100644 (file)
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2000-2010, Free Software Foundation, Inc.        --
+--           Copyright (C) 2000-2011, 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- --
@@ -513,6 +513,7 @@ package body Impunit is
      "a-cborma",    -- Ada.Containers.Bounded_Ordered_Maps
      "a-cbhase",    -- Ada.Containers.Bounded_Hashed_Sets
      "a-cbhama",    -- Ada.Containers.Bounded_Hashed_Maps
+     "a-extiin",    -- Ada.Execution_Time.Interrupts
 
    -----------------------------------------
    -- GNAT Defined Additions to Ada 20012 --

diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index d84ed26f096a51d1616350afb135b19d99d20ac5..79c5a71d2c3294e651bf358ae1c80aac7fa72114 100644 (file)
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -240,6 +240,14 @@ package Sem is
    --  then Full_Analysis above must be False. You should really regard this as
    --  a read only flag.
 
+   In_Pre_Post_Expression : Boolean := False;
+   --  Switch to indicate that we are in a precondition or postcondition. The
+   --  analysis is not expected to process a precondition or a postcondition as
+   --  a sub-analysis for another precondition or postcondition, so this switch
+   --  needs not be saved for recursive calls. When this switch is True then
+   --  In_Spec_Expression above must be True also. You should really regard
+   --  this as a read only flag.
+
    In_Deleted_Code : Boolean := False;
    --  If the condition in an if-statement is statically known, the branch
    --  that is not taken is analyzed with expansion disabled, and the tree

diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index 4f24112725030d4ebcb5a4281136e856c8b4b24f..48ffe4a5468a8c0eacf035090f69d7d20de0bc1a 100644 (file)
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -443,7 +443,7 @@ package body Sem_Ch11 is
       P              : Node_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("raise statement is not allowed", N);
       Check_Unreachable_Code (N);
 
@@ -611,7 +611,7 @@ package body Sem_Ch11 is
    --  Start of processing for Analyze_Raise_xxx_Error
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("raise statement is not allowed", N);
 
       if No (Etype (N)) then

diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb
index 38003e2226241ed8703be6f9dee6ea99d2e6840a..f2c915b06aaf833cc136c8bdf641a5ece0647a4a 100644 (file)
--- a/gcc/ada/sem_ch2.adb
+++ b/gcc/ada/sem_ch2.adb
@@ -81,7 +81,7 @@ package body Sem_Ch2 is
            and then Is_Object (Entity (N))
            and then not Is_In_ALFA (Entity (N))
          then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
          end if;
       end if;
    end Analyze_Identifier;

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2f5bb0244c8f2bc2c725d7a7a59846971166e714..79a0828603d7afbea587c28c7dfe863a8cfe58d6 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3036,7 +3036,7 @@ package body Sem_Ch3 is
       if Is_In_ALFA (T) and then not Aliased_Present (N) then
          Set_Is_In_ALFA (Id);
       else
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
       end if;
 
       --  These checks should be performed before the initialization expression

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 47a43dd4401705744714ce051fed6e628c150e4e..ba631fbffc37e7eb438f23277d22edcce4e4419e 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -350,7 +350,7 @@ package body Sem_Ch4 is
 
    procedure Analyze_Aggregate (N : Node_Id) is
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       if No (Etype (N)) then
          Set_Etype (N, Any_Composite);
@@ -371,7 +371,7 @@ package body Sem_Ch4 is
       C        : Node_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("allocator is not allowed", N);
 
       --  Deal with allocator restrictions
@@ -991,7 +991,7 @@ package body Sem_Ch4 is
          if not Is_Subprogram (Nam_Ent)
            or else not Is_In_ALFA (Nam_Ent)
          then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
          end if;
 
          Analyze_One_Call (N, Nam_Ent, True, Success);
@@ -1370,7 +1370,7 @@ package body Sem_Ch4 is
       L  : Node_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       Candidate_Type := Empty;
 
@@ -1520,7 +1520,7 @@ package body Sem_Ch4 is
          return;
       end if;
 
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("conditional expression is not allowed", N);
 
       Else_Expr := Next (Then_Expr);
@@ -1721,7 +1721,7 @@ package body Sem_Ch4 is
    --  Start of processing for Analyze_Explicit_Dereference
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("explicit dereference is not allowed", N);
 
       Analyze (P);
@@ -2483,7 +2483,7 @@ package body Sem_Ch4 is
    --  Start of processing for Analyze_Membership_Op
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       Analyze_Expression (L);
 
@@ -2606,7 +2606,7 @@ package body Sem_Ch4 is
 
    procedure Analyze_Null (N : Node_Id) is
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("null is not allowed", N);
 
       Set_Etype (N, Any_Access);
@@ -3235,7 +3235,7 @@ package body Sem_Ch4 is
       T    : Entity_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       Analyze_Expression (Expr);
 
@@ -3295,7 +3295,7 @@ package body Sem_Ch4 is
       Iterator : Node_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("quantified expression is not allowed", N);
 
       Set_Etype  (Ent,  Standard_Void_Type);
@@ -3461,7 +3461,7 @@ package body Sem_Ch4 is
       Acc_Type : Entity_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       Analyze (P);
 
@@ -4326,7 +4326,7 @@ package body Sem_Ch4 is
    --  Start of processing for Analyze_Slice
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("slice is not allowed", N);
 
       Analyze (P);
@@ -4371,7 +4371,7 @@ package body Sem_Ch4 is
       T    : Entity_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       --  If Conversion_OK is set, then the Etype is already set, and the
       --  only processing required is to analyze the expression. This is
@@ -4503,7 +4503,7 @@ package body Sem_Ch4 is
 
    procedure Analyze_Unchecked_Type_Conversion (N : Node_Id) is
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Find_Type (Subtype_Mark (N));
       Analyze_Expression (Expression (N));
       Set_Etype (N, Entity (Subtype_Mark (N)));

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 5370f701a8a104a190537093a6bbc0140325ccc3..6283207cc517f081ce5413bac89e54ab4685f610 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1113,7 +1113,7 @@ package body Sem_Ch5 is
       if Others_Present
         and then List_Length (Alternatives (N)) = 1
       then
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
          Check_SPARK_Restriction
            ("OTHERS as unique case alternative is not allowed", N);
       end if;
@@ -1195,7 +1195,7 @@ package body Sem_Ch5 is
 
          else
             if Has_Loop_In_Inner_Open_Scopes (U_Name) then
-               Mark_Non_ALFA_Subprogram_Body;
+               Mark_Non_ALFA_Subprogram;
                Check_SPARK_Restriction
                  ("exit label must name the closest enclosing loop", N);
             end if;
@@ -1242,14 +1242,14 @@ package body Sem_Ch5 is
 
       if Present (Cond) then
          if Nkind (Parent (N)) /= N_Loop_Statement then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             Check_SPARK_Restriction
               ("exit with when clause must be directly in loop", N);
          end if;
 
       else
          if Nkind (Parent (N)) /= N_If_Statement then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             if Nkind (Parent (N)) = N_Elsif_Part then
                Check_SPARK_Restriction
                  ("exit must be in IF without ELSIF", N);
@@ -1258,7 +1258,7 @@ package body Sem_Ch5 is
             end if;
 
          elsif Nkind (Parent (Parent (N))) /= N_Loop_Statement then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             Check_SPARK_Restriction
               ("exit must be in IF directly in loop", N);
 
@@ -1266,14 +1266,14 @@ package body Sem_Ch5 is
             --  leads to an error mentioning the ELSE.
 
          elsif Present (Else_Statements (Parent (N))) then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             Check_SPARK_Restriction ("exit must be in IF without ELSE", N);
 
             --  An exit in an ELSIF does not reach here, as it would have been
             --  detected in the case (Nkind (Parent (N)) /= N_If_Statement).
 
          elsif Present (Elsif_Parts (Parent (N))) then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             Check_SPARK_Restriction ("exit must be in IF without ELSIF", N);
          end if;
       end if;
@@ -1302,7 +1302,7 @@ package body Sem_Ch5 is
       Label_Ent   : Entity_Id;
 
    begin
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("goto statement is not allowed", N);
 
       --  Actual semantic checks

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d02ac62324cfbf40aa2a42cddd1fe9b2ace7ba83..99ba2a23af276243935418ccd4ffc80efa6c9daa 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -638,13 +638,13 @@ package body Sem_Ch6 is
              (Nkind (Parent (Parent (N))) /= N_Subprogram_Body
                or else Present (Next (N)))
          then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
             Check_SPARK_Restriction
               ("RETURN should be the last statement in function", N);
          end if;
 
       else
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
          Check_SPARK_Restriction ("extended RETURN is not allowed", N);
 
          --  Analyze parts specific to extended_return_statement:

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 2a2c6c55223cef94c90da022570fedae6a73e21e..f535f7e331d92ee419c9e38113e124bcd8f705b5 100644 (file)
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -101,7 +101,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("abort statement is not allowed", N);
 
       T_Name := First (Names (N));
@@ -140,7 +140,7 @@ package body Sem_Ch9 is
    procedure Analyze_Accept_Alternative (N : Node_Id) is
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       if Present (Pragmas_Before (N)) then
          Analyze_List (Pragmas_Before (N));
@@ -174,7 +174,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("accept statement is not allowed", N);
 
       --  Entry name is initialized to Any_Id. It should get reset to the
@@ -406,7 +406,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("select statement is not allowed", N);
       Check_Restriction (Max_Asynchronous_Select_Nesting, N);
       Check_Restriction (No_Select_Statements, N);
@@ -453,7 +453,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("select statement is not allowed", N);
       Check_Restriction (No_Select_Statements, N);
 
@@ -500,7 +500,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_Restriction (No_Delay, N);
 
       if Present (Pragmas_Before (N)) then
@@ -552,7 +552,7 @@ package body Sem_Ch9 is
       E : constant Node_Id := Expression (N);
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("delay statement is not allowed", N);
       Check_Restriction (No_Relative_Delay, N);
       Check_Restriction (No_Delay, N);
@@ -571,7 +571,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("delay statement is not allowed", N);
       Check_Restriction (No_Delay, N);
       Check_Potentially_Blocking_Operation (N);
@@ -600,7 +600,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       --  Entry_Name is initialized to Any_Id. It should get reset to the
       --  matching entry entity. An error is signalled if it is not reset
@@ -833,7 +833,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       if Present (Index) then
          Analyze (Index);
@@ -861,7 +861,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("entry call is not allowed", N);
 
       if Present (Pragmas_Before (N)) then
@@ -897,7 +897,7 @@ package body Sem_Ch9 is
    begin
       Generate_Definition (Def_Id);
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       --  Case of no discrete subtype definition
 
@@ -967,7 +967,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Analyze (Def);
 
       --  There is no elaboration of the entry index specification. Therefore,
@@ -1009,7 +1009,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Set_Ekind (Body_Id, E_Protected_Body);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
 
@@ -1128,7 +1128,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("protected definition is not allowed", N);
       Analyze_Declarations (Visible_Declarations (N));
 
@@ -1182,7 +1182,7 @@ package body Sem_Ch9 is
       end if;
 
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_Restriction (No_Protected_Types, N);
 
       T := Find_Type_Name (N);
@@ -1324,7 +1324,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("requeue statement is not allowed", N);
       Check_Restriction (No_Requeue_Statements, N);
       Check_Unreachable_Code (N);
@@ -1599,7 +1599,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("select statement is not allowed", N);
       Check_Restriction (No_Select_Statements, N);
 
@@ -1720,7 +1720,7 @@ package body Sem_Ch9 is
    begin
       Generate_Definition (Id);
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       --  The node is rewritten as a protected type declaration, in exact
       --  analogy with what is done with single tasks.
@@ -1782,7 +1782,7 @@ package body Sem_Ch9 is
    begin
       Generate_Definition (Id);
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       --  The node is rewritten as a task type declaration, followed by an
       --  object declaration of that anonymous task type.
@@ -1860,7 +1860,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Set_Ekind (Body_Id, E_Task_Body);
       Set_Scope (Body_Id, Current_Scope);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
@@ -1981,7 +1981,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("task definition is not allowed", N);
 
       if Present (Visible_Declarations (N)) then
@@ -2016,7 +2016,7 @@ package body Sem_Ch9 is
    begin
       Check_Restriction (No_Tasking, N);
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       T := Find_Type_Name (N);
       Generate_Definition (T);
 
@@ -2122,7 +2122,7 @@ package body Sem_Ch9 is
    procedure Analyze_Terminate_Alternative (N : Node_Id) is
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       if Present (Pragmas_Before (N)) then
          Analyze_List (Pragmas_Before (N));
@@ -2144,7 +2144,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
       Check_SPARK_Restriction ("select statement is not allowed", N);
       Check_Restriction (No_Select_Statements, N);
 
@@ -2181,7 +2181,7 @@ package body Sem_Ch9 is
 
    begin
       Tasking_Used := True;
-      Mark_Non_ALFA_Subprogram_Body;
+      Mark_Non_ALFA_Subprogram;
 
       if Present (Pragmas_Before (N)) then
          Analyze_List (Pragmas_Before (N));

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 01d6aee586916ea259d013e9ded62728e5ec75c4..20b63b8ccfa8bb64c4d1f475265c06f3e315f79b 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -253,8 +253,11 @@ package body Sem_Prag is
       --  Preanalyze the boolean expression, we treat this as a spec expression
       --  (i.e. similar to a default expression).
 
+      pragma Assert (In_Pre_Post_Expression = False);
+      In_Pre_Post_Expression := True;
       Preanalyze_Spec_Expression
         (Get_Pragma_Arg (Arg1), Standard_Boolean);
+      In_Pre_Post_Expression := False;
 
       --  Remove the subprogram from the scope stack now that the pre-analysis
       --  of the precondition/postcondition is done.

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index faf20d637f498257b3a66213c42d860e41b47ada..840537d83775f32bdafadb6cd5f9957d1a67f24d 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5964,12 +5964,12 @@ package body Sem_Res is
       --  types or array types except String.
 
       if Is_Boolean_Type (T) then
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
          Check_SPARK_Restriction
            ("comparison is not defined on Boolean type", N);
 
       elsif Is_Array_Type (T) then
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
 
          if Base_Type (T) /= Standard_String then
             Check_SPARK_Restriction
@@ -6828,7 +6828,7 @@ package body Sem_Res is
          --  operands have equal static bounds.
 
          if Is_Array_Type (T) then
-            Mark_Non_ALFA_Subprogram_Body;
+            Mark_Non_ALFA_Subprogram;
 
             --  Protect call to Matching_Static_Array_Bounds to avoid costly
             --  operation if not needed.
@@ -7378,7 +7378,7 @@ package body Sem_Res is
       if Is_Array_Type (B_Typ)
         and then Nkind (N) in N_Binary_Op
       then
-         Mark_Non_ALFA_Subprogram_Body;
+         Mark_Non_ALFA_Subprogram;
 
          declare
             Left_Typ  : constant Node_Id := Etype (Left_Opnd (N));

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 397784676ded77b33d0f2ac492c66c90e907f368..a9a9100b5043cd76e4bbb014e98e6264c3249975 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -141,7 +141,7 @@ package body Sem_Util is
    --  T is a derived tagged type. Check whether the type extension is null.
    --  If the parent type is fully initialized, T can be treated as such.
 
-   procedure Mark_Non_ALFA_Subprogram_Body_Unconditional;
+   procedure Mark_Non_ALFA_Subprogram_Unconditional;
    --  Perform the action for Mark_Non_ALFA_Subprogram_Body, which allows the
    --  latter to be small and inlined.
 
@@ -2315,34 +2315,42 @@ package body Sem_Util is
       end if;
    end Current_Subprogram;
 
-   -----------------------------------
-   -- Mark_Non_ALFA_Subprogram_Body --
-   -----------------------------------
+   ------------------------------
+   -- Mark_Non_ALFA_Subprogram --
+   ------------------------------
 
-   procedure Mark_Non_ALFA_Subprogram_Body is
+   procedure Mark_Non_ALFA_Subprogram is
    begin
       --  Isolate marking of the current subprogram body so that the body of
-      --  Mark_Non_ALFA_Subprogram_Body is small and inlined.
+      --  Mark_Non_ALFA_Subprogram is small and inlined.
 
       if ALFA_Mode then
-         Mark_Non_ALFA_Subprogram_Body_Unconditional;
+         Mark_Non_ALFA_Subprogram_Unconditional;
       end if;
-   end Mark_Non_ALFA_Subprogram_Body;
+   end Mark_Non_ALFA_Subprogram;
 
-   -------------------------------------------------
-   -- Mark_Non_ALFA_Subprogram_Body_Unconditional --
-   -------------------------------------------------
+   --------------------------------------------
+   -- Mark_Non_ALFA_Subprogram_Unconditional --
+   --------------------------------------------
 
-   procedure Mark_Non_ALFA_Subprogram_Body_Unconditional is
+   procedure Mark_Non_ALFA_Subprogram_Unconditional is
       Cur_Subp : constant Entity_Id := Current_Subprogram;
    begin
       if Present (Cur_Subp)
         and then (Is_Subprogram (Cur_Subp)
                    or else Is_Generic_Subprogram (Cur_Subp))
       then
-         Set_Body_Is_In_ALFA (Cur_Subp, False);
+         --  If the non-ALFA construct is in a precondition or postcondition,
+         --  then mark the subprogram as not in ALFA. Otherwise, mark the
+         --  subprogram body as not in ALFA.
+
+         if In_Pre_Post_Expression then
+            Set_Is_In_ALFA (Cur_Subp, False);
+         else
+            Set_Body_Is_In_ALFA (Cur_Subp, False);
+         end if;
       end if;
-   end Mark_Non_ALFA_Subprogram_Body_Unconditional;
+   end Mark_Non_ALFA_Subprogram_Unconditional;
 
    ---------------------
    -- Defining_Entity --

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c533b1d054fb270cc43b72e4002ec93025c8ee63..938b03100cd162e11779918c64e1f09118e915a1 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -277,9 +277,12 @@ package Sem_Util is
    --  Current_Scope is returned. The returned value is Empty if this is called
    --  from a library package which is not within any subprogram.
 
-   procedure Mark_Non_ALFA_Subprogram_Body;
-   --  If Current_Subprogram is not Empty, set its flag Body_Is_In_ALFA to
-   --  False, otherwise do nothing.
+   procedure Mark_Non_ALFA_Subprogram;
+   --  If Current_Subprogram is not Empty, mark either its specification or its
+   --  body as not being in ALFA. If called during the analysis of a
+   --  precondition or postcondition, as indicated by the flag
+   --  In_Pre_Post_Expression, mark the specification as not being in ALFA.
+   --  Otherwise, mark the body as not being in ALFA.
 
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the