Commit c86cf714 by Robert Dewar Committed by Arnaud Charlet

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
parent 65ede005
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> 2014-06-13 Geert Bosch <bosch@adacore.com>
* gnat_rm.texi, s-tasinf-solaris.ads, sem_prag.adb, gnat_ugn.texi, * gnat_rm.texi, s-tasinf-solaris.ads, sem_prag.adb, gnat_ugn.texi,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -216,7 +216,7 @@ package body Lib.Load is ...@@ -216,7 +216,7 @@ package body Lib.Load is
Generate_Code => False, Generate_Code => False,
Has_Allocator => False, Has_Allocator => False,
Has_RACW => False, Has_RACW => False,
Is_Compiler_Unit => False, Filler => False,
Ident_String => Empty, Ident_String => Empty,
Loading => False, Loading => False,
Main_Priority => Default_Main_Priority, Main_Priority => Default_Main_Priority,
...@@ -323,7 +323,7 @@ package body Lib.Load is ...@@ -323,7 +323,7 @@ package body Lib.Load is
Generate_Code => False, Generate_Code => False,
Has_Allocator => False, Has_Allocator => False,
Has_RACW => False, Has_RACW => False,
Is_Compiler_Unit => False, Filler => False,
Ident_String => Empty, Ident_String => Empty,
Loading => True, Loading => True,
Main_Priority => Default_Main_Priority, Main_Priority => Default_Main_Priority,
...@@ -687,7 +687,7 @@ package body Lib.Load is ...@@ -687,7 +687,7 @@ package body Lib.Load is
Generate_Code => False, Generate_Code => False,
Has_Allocator => False, Has_Allocator => False,
Has_RACW => False, Has_RACW => False,
Is_Compiler_Unit => False, Filler => False,
Ident_String => Empty, Ident_String => Empty,
Loading => True, Loading => True,
Main_Priority => Default_Main_Priority, Main_Priority => Default_Main_Priority,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -84,7 +84,7 @@ package body Lib.Writ is ...@@ -84,7 +84,7 @@ package body Lib.Writ is
Generate_Code => False, Generate_Code => False,
Has_Allocator => False, Has_Allocator => False,
Has_RACW => False, Has_RACW => False,
Is_Compiler_Unit => False, Filler => False,
Ident_String => Empty, Ident_String => Empty,
Loading => False, Loading => False,
Main_Priority => -1, Main_Priority => -1,
...@@ -142,7 +142,7 @@ package body Lib.Writ is ...@@ -142,7 +142,7 @@ package body Lib.Writ is
Generate_Code => False, Generate_Code => False,
Has_Allocator => False, Has_Allocator => False,
Has_RACW => False, Has_RACW => False,
Is_Compiler_Unit => False, Filler => False,
Ident_String => Empty, Ident_String => Empty,
Loading => False, Loading => False,
Main_Priority => -1, Main_Priority => -1,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -126,11 +126,6 @@ package body Lib is ...@@ -126,11 +126,6 @@ package body Lib is
return Units.Table (U).Has_RACW; return Units.Table (U).Has_RACW;
end 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 function Ident_String (U : Unit_Number_Type) return Node_Id is
begin begin
return Units.Table (U).Ident_String; return Units.Table (U).Ident_String;
...@@ -221,14 +216,6 @@ package body Lib is ...@@ -221,14 +216,6 @@ package body Lib is
Units.Table (U).Has_RACW := B; Units.Table (U).Has_RACW := B;
end Set_Has_RACW; 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 procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id) is
begin begin
Units.Table (U).Ident_String := N; Units.Table (U).Ident_String := N;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -326,10 +326,6 @@ package Lib is ...@@ -326,10 +326,6 @@ package Lib is
-- (RACW) object. This is used for controlling generation of the RA -- (RACW) object. This is used for controlling generation of the RA
-- attribute in the ali file. -- 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 -- Ident_String
-- N_String_Literal node from a valid pragma Ident that applies to -- N_String_Literal node from a valid pragma Ident that applies to
-- this unit. If no Ident pragma applies to the unit, then Empty. -- this unit. If no Ident pragma applies to the unit, then Empty.
...@@ -415,7 +411,6 @@ package Lib is ...@@ -415,7 +411,6 @@ package Lib is
function Ident_String (U : Unit_Number_Type) return Node_Id; function Ident_String (U : Unit_Number_Type) return Node_Id;
function Has_Allocator (U : Unit_Number_Type) return Boolean; function Has_Allocator (U : Unit_Number_Type) return Boolean;
function Has_RACW (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 Loading (U : Unit_Number_Type) return Boolean;
function Main_CPU (U : Unit_Number_Type) return Int; function Main_CPU (U : Unit_Number_Type) return Int;
function Main_Priority (U : Unit_Number_Type) return Int; function Main_Priority (U : Unit_Number_Type) return Int;
...@@ -434,7 +429,6 @@ package Lib is ...@@ -434,7 +429,6 @@ package Lib is
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True); 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_RACW (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Has_Allocator (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_Ident_String (U : Unit_Number_Type; N : Node_Id);
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True); procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Main_CPU (U : Unit_Number_Type; P : Int); procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
...@@ -734,7 +728,6 @@ private ...@@ -734,7 +728,6 @@ private
pragma Inline (Generate_Code); pragma Inline (Generate_Code);
pragma Inline (Has_Allocator); pragma Inline (Has_Allocator);
pragma Inline (Has_RACW); pragma Inline (Has_RACW);
pragma Inline (Is_Compiler_Unit);
pragma Inline (Increment_Serial_Number); pragma Inline (Increment_Serial_Number);
pragma Inline (Loading); pragma Inline (Loading);
pragma Inline (Main_CPU); pragma Inline (Main_CPU);
...@@ -774,8 +767,8 @@ private ...@@ -774,8 +767,8 @@ private
Fatal_Error : Boolean; Fatal_Error : Boolean;
Generate_Code : Boolean; Generate_Code : Boolean;
Has_RACW : Boolean; Has_RACW : Boolean;
Is_Compiler_Unit : Boolean;
Dynamic_Elab : Boolean; Dynamic_Elab : Boolean;
Filler : Boolean;
Loading : Boolean; Loading : Boolean;
Has_Allocator : Boolean; Has_Allocator : Boolean;
OA_Setting : Character; OA_Setting : Character;
...@@ -805,7 +798,7 @@ private ...@@ -805,7 +798,7 @@ private
Generate_Code at 57 range 0 .. 7; Generate_Code at 57 range 0 .. 7;
Has_RACW at 58 range 0 .. 7; Has_RACW at 58 range 0 .. 7;
Dynamic_Elab at 59 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; OA_Setting at 61 range 0 .. 7;
Loading at 62 range 0 .. 7; Loading at 62 range 0 .. 7;
Has_Allocator at 63 range 0 .. 7; Has_Allocator at 63 range 0 .. 7;
......
...@@ -375,6 +375,15 @@ package Opt is ...@@ -375,6 +375,15 @@ package Opt is
-- set to True to delete only the files produced by the compiler but not -- set to True to delete only the files produced by the compiler but not
-- the library files or the executable files. -- 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; Config_File : Boolean := True;
-- GNAT -- GNAT
-- Set to False to inhibit reading and processing of gnat.adc file -- Set to False to inhibit reading and processing of gnat.adc file
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -240,6 +240,10 @@ package body Ch5 is ...@@ -240,6 +240,10 @@ package body Ch5 is
and then Statement_Seen) and then Statement_Seen)
or else All_Pragmas) or else All_Pragmas)
then then
-- This Ada 2012 construct not allowed in a compiler unit
Check_Compiler_Unit ("null statement list", Token_Ptr);
declare declare
Null_Stm : constant Node_Id := Null_Stm : constant Node_Id :=
Make_Null_Statement (Token_Ptr); Make_Null_Statement (Token_Ptr);
......
...@@ -354,6 +354,22 @@ begin ...@@ -354,6 +354,22 @@ begin
Ada_Version_Pragma := Pragma_Node; Ada_Version_Pragma := Pragma_Node;
end if; 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 -- -- Debug --
----------- -----------
...@@ -1153,8 +1169,6 @@ begin ...@@ -1153,8 +1169,6 @@ begin
Pragma_CIL_Constructor | Pragma_CIL_Constructor |
Pragma_Compile_Time_Error | Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning | Pragma_Compile_Time_Warning |
Pragma_Compiler_Unit |
Pragma_Compiler_Unit_Warning |
Pragma_Contract_Cases | Pragma_Contract_Cases |
Pragma_Convention_Identifier | Pragma_Convention_Identifier |
Pragma_CPP_Class | Pragma_CPP_Class |
......
...@@ -168,10 +168,17 @@ package body Restrict is ...@@ -168,10 +168,17 @@ package body Restrict is
-- Check_Compiler_Unit -- -- Check_Compiler_Unit --
------------------------- -------------------------
procedure Check_Compiler_Unit (N : Node_Id) is procedure Check_Compiler_Unit (Feature : String; N : Node_Id) is
begin begin
if Is_Compiler_Unit (Get_Source_Unit (N)) then if Compiler_Unit then
Error_Msg_N ("use of construct not allowed in compiler!!??", N); 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 if;
end Check_Compiler_Unit; end Check_Compiler_Unit;
......
...@@ -192,10 +192,15 @@ package Restrict is ...@@ -192,10 +192,15 @@ package Restrict is
-- For abort to be allowed, either No_Abort_Statements must be False, -- For abort to be allowed, either No_Abort_Statements must be False,
-- or Max_Asynchronous_Select_Nesting must be non-zero. -- or Max_Asynchronous_Select_Nesting must be non-zero.
procedure Check_Compiler_Unit (N : Node_Id); procedure Check_Compiler_Unit (Feature : String; N : Node_Id);
-- If unit N is in a unit that has a pragma Compiler_Unit, then a message -- If unit N is in a unit that has a pragma Compiler_Unit_Warning, then
-- is posted on node N noting use of a construct that is not permitted in -- a message is posted on node N noting use of the given feature is not
-- the compiler. -- 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); procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id);
-- Checks if loading of unit U is prohibited by the setting of some -- Checks if loading of unit U is prohibited by the setting of some
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -436,7 +436,7 @@ package body Sem_Ch11 is ...@@ -436,7 +436,7 @@ package body Sem_Ch11 is
begin begin
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit ("raise expression", N);
end if; end if;
Check_SPARK_Restriction ("raise expression is not allowed", N); Check_SPARK_Restriction ("raise expression is not allowed", N);
......
...@@ -836,7 +836,7 @@ package body Sem_Ch3 is ...@@ -836,7 +836,7 @@ package body Sem_Ch3 is
-- the runtime library but must also be compilable in Ada 95 mode -- the runtime library but must also be compilable in Ada 95 mode
-- (when bootstrapping the compiler). -- (when bootstrapping the compiler).
Check_Compiler_Unit (N); Check_Compiler_Unit ("anonymous access to subprogram", N);
Access_Subprogram_Declaration Access_Subprogram_Declaration
(T_Name => Anon_Type, (T_Name => Anon_Type,
......
...@@ -1392,7 +1392,7 @@ package body Sem_Ch4 is ...@@ -1392,7 +1392,7 @@ package body Sem_Ch4 is
begin begin
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit ("case expression", N);
end if; end if;
Analyze_And_Resolve (Expr, Any_Discrete); Analyze_And_Resolve (Expr, Any_Discrete);
...@@ -2077,7 +2077,7 @@ package body Sem_Ch4 is ...@@ -2077,7 +2077,7 @@ package body Sem_Ch4 is
Else_Expr := Next (Then_Expr); Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit ("if expression", N);
end if; end if;
Analyze_Expression (Condition); Analyze_Expression (Condition);
...@@ -2669,7 +2669,7 @@ package body Sem_Ch4 is ...@@ -2669,7 +2669,7 @@ package body Sem_Ch4 is
begin begin
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit ("set membership", N);
end if; end if;
Analyze (L); Analyze (L);
...@@ -7038,7 +7038,7 @@ package body Sem_Ch4 is ...@@ -7038,7 +7038,7 @@ package body Sem_Ch4 is
-- a dereference operation. -- a dereference operation.
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit ("generalized indexing", N);
end if; end if;
declare declare
......
...@@ -525,6 +525,7 @@ package body Sem_Ch6 is ...@@ -525,6 +525,7 @@ package body Sem_Ch6 is
procedure Analyze_Extended_Return_Statement (N : Node_Id) is procedure Analyze_Extended_Return_Statement (N : Node_Id) is
begin begin
Check_Compiler_Unit ("extended return statement", N);
Analyze_Return_Statement (N); Analyze_Return_Statement (N);
end Analyze_Extended_Return_Statement; end Analyze_Extended_Return_Statement;
......
...@@ -12409,7 +12409,12 @@ package body Sem_Prag is ...@@ -12409,7 +12409,12 @@ package body Sem_Prag is
when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning => when Pragma_Compiler_Unit | Pragma_Compiler_Unit_Warning =>
GNAT_Pragma; GNAT_Pragma;
Check_Arg_Count (0); 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 -- -- Complete_Representation --
...@@ -21346,7 +21351,7 @@ package body Sem_Prag is ...@@ -21346,7 +21351,7 @@ package body Sem_Prag is
-- Not allowed in compiler units (bootstrap issues) -- 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 -- No REASON string, set null string as reason
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment