+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,
-- --
-- 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- --
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,
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,
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,
-- --
-- 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- --
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
- Is_Compiler_Unit => False,
+ Filler => False,
Ident_String => Empty,
Loading => False,
Main_Priority => -1,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
- Is_Compiler_Unit => False,
+ Filler => False,
Ident_String => Empty,
Loading => False,
Main_Priority => -1,
-- --
-- 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- --
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;
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;
-- --
-- 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- --
-- (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.
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;
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);
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);
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;
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;
-- 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
-- --
-- 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- --
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);
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 --
-----------
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 |
-- 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;
-- 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
-- --
-- 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- --
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);
-- 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,
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);
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);
begin
if Comes_From_Source (N) then
- Check_Compiler_Unit (N);
+ Check_Compiler_Unit ("set membership", N);
end if;
Analyze (L);
-- a dereference operation.
if Comes_From_Source (N) then
- Check_Compiler_Unit (N);
+ Check_Compiler_Unit ("generalized indexing", N);
end if;
declare
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;
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 --
-- 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
projects / gcc.git / commitdiff