lib.ads, [...] (Is_Compiler_Unit): Removed.

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* lib.ads, lib.adb, lib-writ.adb, lib-load.adb (Is_Compiler_Unit):
	Removed.
	* opt.ads (Compiler_Unit): New flag.
	* par-ch5.adb (Test_Statement_Required): Call Check_Compiler_Unit
	for null statement sequence (not allowed in compiler unit).
	* par-prag.adb (Prag): Handle Compiler_Unit[_Warning] during
	parsing.
	* restrict.ads, restrict.adb (Check_Compiler_Unit): New version and new
	calling sequence.
	* sem_ch11.adb, sem_ch3.adb, sem_ch4.adb: New calling sequence for
	Check_Compiler_Unit.
	* sem_ch6.adb (Analyze_Extended_Return_Statement): Call
	Check_Compiler_Unit (this construct is not allowed in compiler
	units).
	* sem_prag.adb (Analyze_Pragma, case Compiler_Unit[_Warning]):
	Set Opt.Compiler_Unit.

From-SVN: r211617

gcc/ada/ChangeLog

+2014-06-13  Robert Dewar  <dewar@adacore.com>
+
+	* lib.ads, lib.adb, lib-writ.adb, lib-load.adb (Is_Compiler_Unit):
+	Removed.
+	* opt.ads (Compiler_Unit): New flag.
+	* par-ch5.adb (Test_Statement_Required): Call Check_Compiler_Unit
+	for null statement sequence (not allowed in compiler unit).
+	* par-prag.adb (Prag): Handle Compiler_Unit[_Warning] during
+	parsing.
+	* restrict.ads, restrict.adb (Check_Compiler_Unit): New version and new
+	calling sequence.
+	* sem_ch11.adb, sem_ch3.adb, sem_ch4.adb: New calling sequence for
+	Check_Compiler_Unit.
+	* sem_ch6.adb (Analyze_Extended_Return_Statement): Call
+	Check_Compiler_Unit (this construct is not allowed in compiler
+	units).
+	* sem_prag.adb (Analyze_Pragma, case Compiler_Unit[_Warning]):
+	Set Opt.Compiler_Unit.
+
 2014-06-13  Geert Bosch  <bosch@adacore.com>
 
 	* gnat_rm.texi, s-tasinf-solaris.ads, sem_prag.adb, gnat_ugn.texi,

gcc/ada/lib-load.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -216,7 +216,7 @@ package body Lib.Load is
         Generate_Code     => False,
         Has_Allocator     => False,
         Has_RACW          => False,
-        Is_Compiler_Unit  => False,
+        Filler            => False,
         Ident_String      => Empty,
         Loading           => False,
         Main_Priority     => Default_Main_Priority,
@@ -323,7 +323,7 @@ package body Lib.Load is
            Generate_Code     => False,
            Has_Allocator     => False,
            Has_RACW          => False,
-           Is_Compiler_Unit  => False,
+           Filler            => False,
            Ident_String      => Empty,
            Loading           => True,
            Main_Priority     => Default_Main_Priority,
@@ -687,7 +687,7 @@ package body Lib.Load is
               Generate_Code     => False,
               Has_Allocator     => False,
               Has_RACW          => False,
-              Is_Compiler_Unit  => False,
+              Filler            => False,
               Ident_String      => Empty,
               Loading           => True,
               Main_Priority     => Default_Main_Priority,

gcc/ada/lib-writ.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -84,7 +84,7 @@ package body Lib.Writ is
          Generate_Code     => False,
          Has_Allocator     => False,
          Has_RACW          => False,
-         Is_Compiler_Unit  => False,
+         Filler            => False,
          Ident_String      => Empty,
          Loading           => False,
          Main_Priority     => -1,
@@ -142,7 +142,7 @@ package body Lib.Writ is
         Generate_Code     => False,
         Has_Allocator     => False,
         Has_RACW          => False,
-        Is_Compiler_Unit  => False,
+        Filler            => False,
         Ident_String      => Empty,
         Loading           => False,
         Main_Priority     => -1,

gcc/ada/lib.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -126,11 +126,6 @@ package body Lib is
       return Units.Table (U).Has_RACW;
    end Has_RACW;
 
-   function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean is
-   begin
-      return Units.Table (U).Is_Compiler_Unit;
-   end Is_Compiler_Unit;
-
    function Ident_String (U : Unit_Number_Type) return Node_Id is
    begin
       return Units.Table (U).Ident_String;
@@ -221,14 +216,6 @@ package body Lib is
       Units.Table (U).Has_RACW := B;
    end Set_Has_RACW;
 
-   procedure Set_Is_Compiler_Unit
-     (U : Unit_Number_Type;
-      B : Boolean := True)
-   is
-   begin
-      Units.Table (U).Is_Compiler_Unit := B;
-   end Set_Is_Compiler_Unit;
-
    procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id) is
    begin
       Units.Table (U).Ident_String := N;

gcc/ada/lib.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -326,10 +326,6 @@ package Lib is
    --      (RACW) object. This is used for controlling generation of the RA
    --      attribute in the ali file.
 
-   --    Is_Compiler_Unit
-   --      A Boolean flag, initially set False by default, set to True if a
-   --      pragma Compiler_Unit_Warning appears in the unit.
-
    --    Ident_String
    --      N_String_Literal node from a valid pragma Ident that applies to
    --      this unit. If no Ident pragma applies to the unit, then Empty.
@@ -415,7 +411,6 @@ package Lib is
    function Ident_String      (U : Unit_Number_Type) return Node_Id;
    function Has_Allocator     (U : Unit_Number_Type) return Boolean;
    function Has_RACW          (U : Unit_Number_Type) return Boolean;
-   function Is_Compiler_Unit  (U : Unit_Number_Type) return Boolean;
    function Loading           (U : Unit_Number_Type) return Boolean;
    function Main_CPU          (U : Unit_Number_Type) return Int;
    function Main_Priority     (U : Unit_Number_Type) return Int;
@@ -434,7 +429,6 @@ package Lib is
    procedure Set_Generate_Code     (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Has_RACW          (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Has_Allocator     (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Is_Compiler_Unit  (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Ident_String      (U : Unit_Number_Type; N : Node_Id);
    procedure Set_Loading           (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Main_CPU          (U : Unit_Number_Type; P : Int);
@@ -734,7 +728,6 @@ private
    pragma Inline (Generate_Code);
    pragma Inline (Has_Allocator);
    pragma Inline (Has_RACW);
-   pragma Inline (Is_Compiler_Unit);
    pragma Inline (Increment_Serial_Number);
    pragma Inline (Loading);
    pragma Inline (Main_CPU);
@@ -774,8 +767,8 @@ private
       Fatal_Error       : Boolean;
       Generate_Code     : Boolean;
       Has_RACW          : Boolean;
-      Is_Compiler_Unit  : Boolean;
       Dynamic_Elab      : Boolean;
+      Filler            : Boolean;
       Loading           : Boolean;
       Has_Allocator     : Boolean;
       OA_Setting        : Character;
@@ -805,7 +798,7 @@ private
       Generate_Code     at 57 range 0 ..  7;
       Has_RACW          at 58 range 0 ..  7;
       Dynamic_Elab      at 59 range 0 ..  7;
-      Is_Compiler_Unit  at 60 range 0 ..  7;
+      Filler            at 60 range 0 ..  7;
       OA_Setting        at 61 range 0 ..  7;
       Loading           at 62 range 0 ..  7;
       Has_Allocator     at 63 range 0 ..  7;

gcc/ada/opt.ads

@@ -375,6 +375,15 @@ package Opt is
    --    set to True to delete only the files produced by the compiler but not
    --    the library files or the executable files.
 
+   Compiler_Unit : Boolean := False;
+   --  GNAT1
+   --  Set True by an occurrence of pragma Compiler_Unit_Warning (or of the
+   --  obsolete pragma Compiler_Unit) in the main unit. Once set True, stays
+   --  True, since any units that are with'ed directly or indirectly by
+   --  a Compiler_Unit_Warning main unit are subject to the same restrictions.
+   --  Such units really should have their own pragmas, but we do not bother to
+   --  check for that, so this transitivity provides extra checking.
+
    Config_File : Boolean := True;
    --  GNAT
    --  Set to False to inhibit reading and processing of gnat.adc file

gcc/ada/par-ch5.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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,10 @@ package body Ch5 is
                    and then Statement_Seen)
                 or else All_Pragmas)
             then
+               --  This Ada 2012 construct not allowed in a compiler unit
+
+               Check_Compiler_Unit ("null statement list", Token_Ptr);
+
                declare
                   Null_Stm : constant Node_Id :=
                                Make_Null_Statement (Token_Ptr);

gcc/ada/par-prag.adb

@@ -354,6 +354,22 @@ begin
             Ada_Version_Pragma := Pragma_Node;
          end if;
 
+      ---------------------------
+      -- Compiler_Unit_Warning --
+      ---------------------------
+
+      --  This pragma must be processed at parse time, since the resulting
+      --  status may be tested during the parsing of the program.
+
+      when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning =>
+         Check_Arg_Count (0);
+
+         --  Only recognized in main unit
+
+         if Current_Source_Unit = Main_Unit then
+            Compiler_Unit := True;
+         end if;
+
       -----------
       -- Debug --
       -----------
@@ -1153,8 +1169,6 @@ begin
            Pragma_CIL_Constructor                |
            Pragma_Compile_Time_Error             |
            Pragma_Compile_Time_Warning           |
-           Pragma_Compiler_Unit                  |
-           Pragma_Compiler_Unit_Warning          |
            Pragma_Contract_Cases                 |
            Pragma_Convention_Identifier          |
            Pragma_CPP_Class                      |

gcc/ada/restrict.adb

@@ -168,10 +168,17 @@ package body Restrict is
    -- Check_Compiler_Unit --
    -------------------------
 
-   procedure Check_Compiler_Unit (N : Node_Id) is
+   procedure Check_Compiler_Unit (Feature : String; N : Node_Id) is
    begin
-      if Is_Compiler_Unit (Get_Source_Unit (N)) then
-         Error_Msg_N ("use of construct not allowed in compiler!!??", N);
+      if Compiler_Unit then
+         Error_Msg_N (Feature & " not allowed in compiler unit!!??", N);
+      end if;
+   end Check_Compiler_Unit;
+
+   procedure Check_Compiler_Unit (Feature : String; Loc : Source_Ptr) is
+   begin
+      if Compiler_Unit then
+         Error_Msg (Feature & " not allowed in compiler unit!!??", Loc);
       end if;
    end Check_Compiler_Unit;
 

gcc/ada/restrict.ads

@@ -192,10 +192,15 @@ package Restrict is
    --  For abort to be allowed, either No_Abort_Statements must be False,
    --  or Max_Asynchronous_Select_Nesting must be non-zero.
 
-   procedure Check_Compiler_Unit (N : Node_Id);
-   --  If unit N is in a unit that has a pragma Compiler_Unit, then a message
-   --  is posted on node N noting use of a construct that is not permitted in
-   --  the compiler.
+   procedure Check_Compiler_Unit (Feature : String; N : Node_Id);
+   --  If unit N is in a unit that has a pragma Compiler_Unit_Warning, then
+   --  a message is posted on node N noting use of the given feature is not
+   --  permitted in the compiler (bootstrap considerations).
+
+   procedure Check_Compiler_Unit (Feature : String; Loc : Source_Ptr);
+   --  If unit N is in a unit that has a pragma Compiler_Unit_Warning, then a
+   --  message is posted at location Loc noting use of the given feature is not
+   --  permitted in the compiler (bootstrap considerations).
 
    procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id);
    --  Checks if loading of unit U is prohibited by the setting of some

gcc/ada/sem_ch11.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -436,7 +436,7 @@ package body Sem_Ch11 is
 
    begin
       if Comes_From_Source (N) then
-         Check_Compiler_Unit (N);
+         Check_Compiler_Unit ("raise expression", N);
       end if;
 
       Check_SPARK_Restriction ("raise expression is not allowed", N);

gcc/ada/sem_ch3.adb

@@ -836,7 +836,7 @@ package body Sem_Ch3 is
          --  the runtime library but must also be compilable in Ada 95 mode
          --  (when bootstrapping the compiler).
 
-         Check_Compiler_Unit (N);
+         Check_Compiler_Unit ("anonymous access to subprogram", N);
 
          Access_Subprogram_Declaration
            (T_Name => Anon_Type,

gcc/ada/sem_ch4.adb

@@ -1392,7 +1392,7 @@ package body Sem_Ch4 is
 
    begin
       if Comes_From_Source (N) then
-         Check_Compiler_Unit (N);
+         Check_Compiler_Unit ("case expression", N);
       end if;
 
       Analyze_And_Resolve (Expr, Any_Discrete);
@@ -2077,7 +2077,7 @@ package body Sem_Ch4 is
       Else_Expr := Next (Then_Expr);
 
       if Comes_From_Source (N) then
-         Check_Compiler_Unit (N);
+         Check_Compiler_Unit ("if expression", N);
       end if;
 
       Analyze_Expression (Condition);
@@ -2669,7 +2669,7 @@ package body Sem_Ch4 is
 
       begin
          if Comes_From_Source (N) then
-            Check_Compiler_Unit (N);
+            Check_Compiler_Unit ("set membership", N);
          end if;
 
          Analyze (L);
@@ -7038,7 +7038,7 @@ package body Sem_Ch4 is
       --  a dereference operation.
 
       if Comes_From_Source (N) then
-         Check_Compiler_Unit (N);
+         Check_Compiler_Unit ("generalized indexing", N);
       end if;
 
       declare

gcc/ada/sem_ch6.adb

@@ -525,6 +525,7 @@ package body Sem_Ch6 is
 
    procedure Analyze_Extended_Return_Statement (N : Node_Id) is
    begin
+      Check_Compiler_Unit ("extended return statement", N);
       Analyze_Return_Statement (N);
    end Analyze_Extended_Return_Statement;
 

gcc/ada/sem_prag.adb

@@ -12409,7 +12409,12 @@ package body Sem_Prag is
          when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning =>
             GNAT_Pragma;
             Check_Arg_Count (0);
-            Set_Is_Compiler_Unit (Get_Source_Unit (N));
+
+            --  Only recognized in main unit
+
+            if Current_Sem_Unit = Main_Unit then
+               Compiler_Unit := True;
+            end if;
 
          -----------------------------
          -- Complete_Representation --
@@ -21346,7 +21351,7 @@ package body Sem_Prag is
 
                   --  Not allowed in compiler units (bootstrap issues)
 
-                  Check_Compiler_Unit (N);
+                     Check_Compiler_Unit ("Reason for pragma Warnings", N);
 
                --  No REASON string, set null string as reason