+2010-10-08 Robert Dewar <dewar@adacore.com>
+
+ * ali.adb: Set Allocator_In_Body if AB parameter present on M line
+ * ali.ads (Allocator_In_Body): New flag
+ * bcheck.adb (Check_Consistent_Restrictions): Handle case of main
+ program violating No_Allocators_After_Elaboration restriction.
+ * gnatbind.adb (No_Restriction_List): Add entries for
+ No_Anonymous_Allocators, and No_Allocators_After_Elaboration.
+ * lib-load.adb: Initialize Has_Allocator flag
+ * lib-writ.adb: Initialize Has_Allocator flag
+ (M_Parameters): Set AB switch if Has_Allocator flag set
+ * lib-writ.ads: Document AB flag on M line
+ * lib.adb (Has_Allocator): New function
+ (Set_Has_Allocator): New procedure
+ * lib.ads (Has_Allocator): New function
+ (Set_Has_Allocator): New procedure
+ (Has_Allocator): New flag in Unit_Record
+ * sem_ch4.adb (Analyze_Allocator): Add processing for
+ No_Allocators_After_Elaboration.
+
2010-10-08 Geert Bosch <bosch@adacore.com>
* a-textio.adb (Get_Line): Rewrite to use fgets instead of fgetc.
Sfile => No_File,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
+ Allocator_In_Body => False,
WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
Skip_Space;
+ if Nextc = 'A' then
+ P := P + 1;
+ Checkc ('B');
+ ALIs.Table (Id).Allocator_In_Body := True;
+ end if;
+
+ Skip_Space;
+
Checkc ('W');
Checkc ('=');
ALIs.Table (Id).WC_Encoding := Getc;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- line. A value of -1 indicates that no T=xxx parameter was found, or
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
+ Allocator_In_Body : Boolean;
+ -- Set True if an AB switch appears on the main program line. False
+ -- if no M line, or AB not present, or 'M appears in Ignore_Lines.
+
WC_Encoding : Character;
-- Wide character encoding if main procedure. Otherwise not relevant.
-- Not set if 'M' appears in Ignore_Lines.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- Start of processing for Check_Consistent_Restrictions
begin
+ -- A special test, if we have a main program, then if it has an
+ -- allocator in the body, this is considered to be a violation of
+ -- the restriction No_Allocators_After_Elaboration. We just mark
+ -- this restriction and then the normal circuit will flag it.
+
+ if Bind_Main_Program
+ and then ALIs.Table (ALIs.First).Main_Program /= None
+ and then not No_Main_Subprogram
+ and then ALIs.Table (ALIs.First).Allocator_In_Body
+ then
+ Cumulative_Restrictions.Violated
+ (No_Allocators_After_Elaboration) := True;
+ ALIs.Table (ALIs.First).Restrictions.Violated
+ (No_Allocators_After_Elaboration) := True;
+ end if;
+
-- Loop through all restriction violations
for R in All_Restrictions loop
-- should not be listed.
No_Restriction_List : constant array (All_Restrictions) of Boolean :=
- (No_Exception_Propagation => True,
+ (No_Allocators_After_Elaboration => True,
+ -- This involves run-time conditions not checkable at compile time
+
+ No_Anonymous_Allocators => True,
+ -- Premature, since we have not implemented this yet
+
+ No_Exception_Propagation => True,
-- Modifies code resulting in different exception semantics
- No_Exceptions => True,
+ No_Exceptions => True,
-- Has unexpected Suppress (All_Checks) effect
- No_Implicit_Conditionals => True,
+ No_Implicit_Conditionals => True,
-- This could modify and pessimize generated code
- No_Implicit_Dynamic_Code => True,
+ No_Implicit_Dynamic_Code => True,
-- This could modify and pessimize generated code
- No_Implicit_Loops => True,
+ No_Implicit_Loops => True,
-- This could modify and pessimize generated code
- No_Recursion => True,
+ No_Recursion => True,
-- Not checkable at compile time
- No_Reentrancy => True,
+ No_Reentrancy => True,
-- Not checkable at compile time
- Max_Entry_Queue_Length => True,
+ Max_Entry_Queue_Length => True,
-- Not checkable at compile time
- Max_Storage_At_Blocking => True,
+ Max_Storage_At_Blocking => True,
-- Not checkable at compile time
- others => False);
+ others => False);
Additional_Restrictions_Listed : Boolean := False;
-- Set True if we have listed header for restrictions
Expected_Unit => Spec_Name,
Fatal_Error => True,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Expected_Unit => No_Unit_Name,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Expected_Unit => Uname_Actual,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Write_Info_Nat (Opt.Time_Slice_Value);
end if;
+ if Has_Allocator (Main_Unit) then
+ Write_Info_Str (" AB");
+ end if;
+
Write_Info_Str (" W=");
Write_Info_Char
(WC_Encoding_Letters (Wide_Character_Encoding_Method));
-- -- M Main Program --
-- ---------------------
- -- M type [priority] [T=time-slice] W=?
+ -- M type [priority] [T=time-slice] [AB] W=?
-- This line appears only if the main unit for this file is suitable
-- for use as a main program. The parameters are:
-- milliseconds. The actual significance of this parameter is
-- target dependent.
+ -- AB
+
+ -- Present if there is an allocator in the body of the procedure
+ -- after the BEGIN. This will be a violation of the restriction
+ -- No_Allocators_After_Elaboration if it is present, and this
+ -- unit is used as a main program (only the binder can find the
+ -- violation, since only the binder knows the main program).
+ --
+
-- W=?
-- This parameter indicates the wide character encoding method used
return Units.Table (U).Generate_Code;
end Generate_Code;
+ function Has_Allocator (U : Unit_Number_Type) return Boolean is
+ begin
+ return Units.Table (U).Has_Allocator;
+ end Has_Allocator;
+
function Has_RACW (U : Unit_Number_Type) return Boolean is
begin
return Units.Table (U).Has_RACW;
Units.Table (U).Generate_Code := B;
end Set_Generate_Code;
+ procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True) is
+ begin
+ Units.Table (U).Has_Allocator := B;
+ end Set_Has_Allocator;
+
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is
begin
Units.Table (U).Has_RACW := B;
-- that the default priority is to be used (and is also used for
-- entries that do not correspond to possible main programs).
+ -- Has_Allocator
+ -- This flag is set if a subprogram unit has an allocator after the
+ -- BEGIN (it is used to set the AB flag in the M ALI line).
+
-- OA_Setting
-- This is a character field containing L if Optimize_Alignment mode
-- was set locally, and O/T/S for Off/Time/Space default if not.
function Fatal_Error (U : Unit_Number_Type) return Boolean;
function Generate_Code (U : Unit_Number_Type) return Boolean;
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;
procedure Set_Fatal_Error (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_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);
pragma Inline (Dependency_Num);
pragma Inline (Fatal_Error);
pragma Inline (Generate_Code);
+ pragma Inline (Has_Allocator);
pragma Inline (Has_RACW);
pragma Inline (Is_Compiler_Unit);
pragma Inline (Increment_Serial_Number);
pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Fatal_Error);
pragma Inline (Set_Generate_Code);
+ pragma Inline (Set_Has_Allocator);
pragma Inline (Set_Has_RACW);
pragma Inline (Set_Loading);
pragma Inline (Set_Main_Priority);
Is_Compiler_Unit : Boolean;
Dynamic_Elab : Boolean;
Loading : Boolean;
+ Has_Allocator : Boolean;
OA_Setting : Character;
end record;
Dynamic_Elab at 55 range 0 .. 7;
Is_Compiler_Unit at 56 range 0 .. 7;
OA_Setting at 57 range 0 .. 7;
- Loading at 58 range 0 .. 15;
+ Loading at 58 range 0 .. 7;
+ Has_Allocator at 59 range 0 .. 7;
end record;
for Unit_Record'Size use 60 * 8;
E : Node_Id := Expression (N);
Acc_Type : Entity_Id;
Type_Id : Entity_Id;
+ P : Node_Id;
+ C : Node_Id;
begin
+ -- Deal with allocator restrictions
+
-- In accordance with H.4(7), the No_Allocators restriction only applies
- -- to user-written allocators.
+ -- to user-written allocators. The same consideration applies to the
+ -- No_Allocators_Before_Elaboration restriction.
if Comes_From_Source (N) then
Check_Restriction (No_Allocators, N);
+
+ -- Processing for No_Allocators_After_Elaboration, loop to look at
+ -- enclosing context, checking task case and main subprogram case.
+
+ C := N;
+ P := Parent (C);
+ while Present (P) loop
+
+ -- In both cases we need a handled sequence of statements, where
+ -- the occurrence of the allocator is within the statements.
+
+ if Nkind (P) = N_Handled_Sequence_Of_Statements
+ and then Is_List_Member (C)
+ and then List_Containing (C) = Statements (P)
+ then
+ -- Check for allocator within task body, this is a definite
+ -- violation of No_Allocators_After_Elaboration we can detect.
+
+ if Nkind (Original_Node (Parent (P))) = N_Task_Body then
+ Check_Restriction (No_Allocators_After_Elaboration, N);
+ exit;
+ end if;
+
+ -- The other case is appearence in a subprogram body. This may
+ -- be a violation if this is a library level subprogram, and it
+ -- turns out to be used as the main program, but only the
+ -- binder knows that, so just record the occurrence.
+
+ if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body
+ and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
+ then
+ Set_Has_Allocator (Current_Sem_Unit);
+ end if;
+ end if;
+
+ C := P;
+ P := Parent (C);
+ end loop;
end if;
+ -- Analyze the allocator
+
if Nkind (E) = N_Qualified_Expression then
Acc_Type := Create_Itype (E_Allocator_Type, N);
Set_Etype (Acc_Type, Acc_Type);
projects / thirdparty / gcc.git / commitdiff
