+2014-07-31 Vincent Celier <celier@adacore.com>
+
+ * projects.texi: Minor spelling error fix.
+
+2014-07-31 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Document No_Elaboration_Code_All restriction.
+ * lib-writ.adb, lib-load.adb: Initialize No_Elab_Code field in unit
+ information.
+ * lib.ads, lib.adb (No_Elab_Code): New field in unit information.
+ * restrict.adb (Process_Restriction_Synonyms): Add handling
+ of No_Elaboration_Code_All.
+ * restrict.ads (Process_Restriction_Synonyms): Now handles
+ No_Elaboration_Code_All.
+ * sem_ch10.adb (Analyze_Context): Enforce transitive with for
+ No_Elaboration_Code_All.
+ * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
+ Handle setting of No_Elab_Code in unit information. Handle
+ No_Elaboration_Code_All.
+ * snames.ads-tmpl (Name_No_Elaboration_Code): New name for
+ pragma processing.
+ (Name_No_Elaboration_Code_All): New name for pragma processing.
+
+2014-07-31 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject array
+ types with a null range and use the Esize of the component
+ instead of its RM_Size to identify appropriate values.
+
+2014-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * freeze.adb Add with and use clause for Aspects.
+ (Freeze_Expression): Emit an error when a volatile constant lacks
+ Boolean aspect Import.
+ (Has_Boolean_Aspect_Import): New routine.
+
2014-07-31 Gary Dismukes <dismukes@adacore.com>
* exp_util.adb: Minor reformatting.
-- 3. The array type has no atomic components
- -- 4. The component type is discrete
+ -- 4. The array type has no null ranges (the purpose of this is to
+ -- avoid a bogus warning for an out-of-range value).
- -- 5. The component size is a multiple of Storage_Unit
+ -- 5. The component type is discrete
-- 6. The component size is Storage_Unit or the value is of the form
-- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is
Ctyp : Entity_Id;
+ Index : Entity_Id;
Expr : Node_Id := N;
+ Low : Node_Id;
+ High : Node_Id;
Remainder : Uint;
Value : Uint;
Nunits : Nat;
return False;
end if;
+ Index := First_Index (Ctyp);
+ while Present (Index) loop
+ Get_Index_Bounds (Index, Low, High);
+
+ if Is_Null_Range (Low, High) then
+ return False;
+ end if;
+
+ Next_Index (Index);
+ end loop;
+
Expr := Expression (First (Component_Associations (Expr)));
for J in 1 .. Number_Dimensions (Ctyp) - 1 loop
end if;
end loop;
- if not Is_Discrete_Type (Ctyp)
- or else RM_Size (Ctyp) mod System_Storage_Unit /= 0
- then
+ if not Is_Discrete_Type (Ctyp) then
return False;
end if;
Analyze_And_Resolve (Expr, Ctyp);
- Nunits := UI_To_Int (RM_Size (Ctyp) / System_Storage_Unit);
+ -- The back end uses the Esize as the precision of the type
+
+ Nunits := UI_To_Int (Esize (Ctyp)) / System_Storage_Unit;
+
if Nunits = 1 then
return True;
end if;
Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
end if;
- -- 0 and -1 immediately satisfy the last check
+ -- Values 0 and -1 immediately satisfy the last check
if Value = Uint_0 or else Value = Uint_Minus_1 then
return True;
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
-- Freeze record type, including freezing component types, and freezing
-- primitive operations if this is a tagged type.
+ function Has_Boolean_Aspect_Import (E : Entity_Id) return Boolean;
+ -- Determine whether an arbitrary entity is subject to Boolean aspect
+ -- Import and its value is specified as True.
+
procedure Wrap_Imported_Subprogram (E : Entity_Id);
-- If E is an entity for an imported subprogram with pre/post-conditions
-- then this procedure will create a wrapper to ensure that proper run-
end Check_Variant_Part;
end Freeze_Record_Type;
+ -------------------------------
+ -- Has_Boolean_Aspect_Import --
+ -------------------------------
+
+ function Has_Boolean_Aspect_Import (E : Entity_Id) return Boolean is
+ Decl : constant Node_Id := Declaration_Node (E);
+ Asp : Node_Id;
+ Expr : Node_Id;
+
+ begin
+ if Has_Aspects (Decl) then
+ Asp := First (Aspect_Specifications (Decl));
+ while Present (Asp) loop
+ Expr := Expression (Asp);
+
+ -- The value of aspect Import is True when the expression is
+ -- either missing or it is explicitly set to True.
+
+ if Get_Aspect_Id (Asp) = Aspect_Import
+ and then (No (Expr)
+ or else (Compile_Time_Known_Value (Expr)
+ and then Is_True (Expr_Value (Expr))))
+ then
+ return True;
+ end if;
+
+ Next (Asp);
+ end loop;
+ end if;
+
+ return False;
+ end Has_Boolean_Aspect_Import;
+
------------------------------
-- Wrap_Imported_Subprogram --
------------------------------
if Ekind (E) = E_Constant
and then (Has_Volatile_Components (E) or else Is_Volatile (E))
and then not Is_Imported (E)
+ and then not Has_Boolean_Aspect_Import (E)
then
-- Make sure we actually have a pragma, and have not merely
-- inherited the indication from elsewhere (e.g. an address
Program Unit Level Restrictions
* No_Elaboration_Code::
+* No_Elaboration_Code_All::
* No_Entry_Queue::
* No_Implementation_Aspect_Specifications::
* No_Implementation_Attributes::
@menu
* No_Elaboration_Code::
+* No_Elaboration_Code_All::
* No_Entry_Queue::
* No_Implementation_Aspect_Specifications::
* No_Implementation_Attributes::
code generation. If it is used in conjunction with "semantics only"
checking, then some cases of violations may be missed.
+@node No_Elaboration_Code_All
+@unnumberedsubsec No_Elaboration_Code_All
+@findex No_Elaboration_Code_All
+
+This restriction is identical in semantic effects to
+@code{No_Elaboration_Code}, and
+for most purposes is treated simply as a synonym of @code{No_Elaboration_Code}.
+
+The difference is that if @code{No_Elaboration_Code_All} is used then it
+must appear within a package or subprogram spec. As is the case for
+@code{No_Elaboration_Code}, it also applies to the corresponding body if
+there is one. In addition, any with'ed unit must itself contain a
+@code{No_Elaboration_Code_All} restriction,
+thus allowing transitive enforcement of the requirement for no elaboration
+code to be generated.
+
@node No_Entry_Queue
@unnumberedsubsec No_Entry_Queue
@findex No_Entry_Queue
Main_Priority => Default_Main_Priority,
Main_CPU => Default_Main_CPU,
Munit_Index => 0,
+ No_Elab_Code => None,
Serial_Number => 0,
Source_Index => No_Source_File,
Unit_File_Name => Get_File_Name (Spec_Name, Subunit => False),
Main_Priority => Default_Main_Priority,
Main_CPU => Default_Main_CPU,
Munit_Index => 0,
+ No_Elab_Code => None,
Serial_Number => 0,
Source_Index => Main_Source_File,
Unit_File_Name => Fname,
Main_Priority => Default_Main_Priority,
Main_CPU => Default_Main_CPU,
Munit_Index => 0,
+ No_Elab_Code => None,
Serial_Number => 0,
Source_Index => Src_Ind,
Unit_File_Name => Fname,
Main_Priority => -1,
Main_CPU => -1,
Munit_Index => 0,
+ No_Elab_Code => None,
Serial_Number => 0,
Version => 0,
Error_Location => No_Location,
Main_Priority => -1,
Main_CPU => -1,
Munit_Index => 0,
+ No_Elab_Code => None,
Serial_Number => 0,
Version => 0,
Error_Location => No_Location,
return Units.Table (U).Munit_Index;
end Munit_Index;
+ function No_Elab_Code (U : Unit_Number_Type) return No_Elab_Code_T is
+ begin
+ return Units.Table (U).No_Elab_Code;
+ end No_Elab_Code;
+
function OA_Setting (U : Unit_Number_Type) return Character is
begin
return Units.Table (U).OA_Setting;
Units.Table (U).Main_Priority := P;
end Set_Main_Priority;
+ procedure Set_No_Elab_Code (U : Unit_Number_Type; N : No_Elab_Code_T) is
+ begin
+ Units.Table (U).No_Elab_Code := N;
+ end Set_No_Elab_Code;
+
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character) is
begin
Units.Table (U).OA_Setting := C;
-- The index of the unit within the file for multiple unit per file
-- mode. Set to zero in normal single unit per file mode.
+ -- No_Elab_Code
+ -- A value set when a pragma Restriction or Restriction_Warning for
+ -- No_Elaboration_Code_All or No_Elaboration_Code is encountered. This
+ -- is used to implement the transitive WITH rules (and for no other
+ -- purpose). The possible values are:
+
+ type No_Elab_Code_T is
+ (None,
+ -- The unit contains no Elaboration_Code[_All} restrictions
+
+ No_Elab_Code,
+ -- The unit contains a pragma Restrictions or Restriction_Warnings
+ -- for No_Elaboration_Code, but does not contain either pragma for
+ -- No_Elaboration_Code_All. Note: this setting is not currently used,
+ -- but we maintain it for possible future use (e.g. if we decide after
+ -- all that No_Elaboration_Code is good enough to satisfy the rule for
+ -- transitive with's for No_Elaborate_Code_All.
+
+ No_Elab_Code_All_Warn,
+ -- The unit contains a pragma Restrictions_Warning for restriction
+ -- No_Elaboration_Code_All (but does not contain a pragma Restrictions
+ -- for this restriction).
+
+ No_Elab_Code_All);
+ -- The unit contains a pragma Restrictions (No_Elaboration_Code_All)
+
+ pragma Ordered (No_Elab_Code_T);
+ -- This set of values is ordered, we record the highest value seen
+
-- 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 Main_CPU (U : Unit_Number_Type) return Int;
function Main_Priority (U : Unit_Number_Type) return Int;
function Munit_Index (U : Unit_Number_Type) return Nat;
+ function No_Elab_Code (U : Unit_Number_Type) return No_Elab_Code_T;
function OA_Setting (U : Unit_Number_Type) return Character;
function Source_Index (U : Unit_Number_Type) return Source_File_Index;
function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type;
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);
+ procedure Set_No_Elab_Code (U : Unit_Number_Type; N : No_Elab_Code_T);
procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
pragma Inline (Main_CPU);
pragma Inline (Main_Priority);
pragma Inline (Munit_Index);
+ pragma Inline (No_Elab_Code);
pragma Inline (OA_Setting);
pragma Inline (Set_Cunit);
pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Loading);
pragma Inline (Set_Main_CPU);
pragma Inline (Set_Main_Priority);
+ pragma Inline (Set_No_Elab_Code);
pragma Inline (Set_OA_Setting);
pragma Inline (Set_Unit_Name);
pragma Inline (Source_Index);
Generate_Code : Boolean;
Has_RACW : Boolean;
Dynamic_Elab : Boolean;
+ No_Elab_Code : No_Elab_Code_T;
Filler : Boolean;
Loading : 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;
- Filler at 60 range 0 .. 15;
+ No_Elab_Code at 60 range 0 .. 7;
+ Filler at 61 range 0 .. 7;
OA_Setting at 62 range 0 .. 7;
Loading at 63 range 0 .. 7;
SPARK_Mode_Pragma at 64 range 0 .. 31;
Example:
@smallexample @c projectfile
-for ^Switches^Switches^ (other) use ("-v", "-k", "-j8");
+for ^Switches^Switches^ (others) use ("-v", "-k", "-j8");
@end smallexample
These switches are only read from the main aggregate project (the
when Name_No_Task_Attributes =>
New_Name := Name_No_Task_Attributes_Package;
+ -- No_Elaboration_Code_All is special, no warning needed
+
+ when Name_No_Elaboration_Code_All =>
+ return Name_No_Elaboration_Code;
+
-- SPARK is special in that we unconditionally warn
when Name_SPARK =>
-- Id is a node whose Chars field contains the name of a restriction.
-- If it is one of synonyms that we allow for historical purposes (for
-- list see System.Rident), then the proper official name is returned.
+ -- In addition, No_Elaboration_Code_All returns Name_No_Elaboration_Code.
-- Otherwise the Chars field of the argument is returned unchanged.
function Restriction_Active (R : All_Restrictions) return Boolean;
and then not Limited_Present (Item)
then
-- Skip analyzing with clause if no unit, nothing to do (this
- -- happens for a with that references a non-existent unit). Skip
- -- as well if this is a with_clause for the main unit, which
- -- happens if a subunit has a useless with_clause on its parent.
+ -- happens for a with that references a non-existent unit).
if Present (Library_Unit (Item)) then
+
+ -- Skip analyzing with clause if this is a with_clause for
+ -- the main unit, which happens if a subunit has a useless
+ -- with_clause on its parent.
+
if Library_Unit (Item) /= Cunit (Current_Sem_Unit) then
Analyze (Item);
+ -- This is the point at which we check for the case of an
+ -- improper WITH from a unit with No_Elaboration_Code_All.
+
+ if No_Elab_Code (Current_Sem_Unit) >=
+ No_Elab_Code_All_Warn
+ then
+ if No_Elab_Code
+ (Get_Source_Unit (Library_Unit (Item))) /=
+ No_Elab_Code_All
+ then
+ Error_Msg_Warn :=
+ No_Elab_Code (Current_Sem_Unit) =
+ No_Elab_Code_All_Warn;
+ Error_Msg_N
+ ("<unit with No_Elaboration_Code_All has bad WITH",
+ Item);
+ Error_Msg_NE
+ ("\<unit& does not have No_Elaboration_Code_All",
+ Item, Entity (Name (Item)));
+ end if;
+ end if;
+
+ -- Here for the case of a useless with for the main unit
+
else
Set_Entity (Name (Item), Cunit_Entity (Current_Sem_Unit));
end if;
end if;
+ -- Do version update (skipped for implicit with)
+
if not Implicit_With (Item) then
Version_Update (N, Library_Unit (Item));
end if;
-- Test-case should only appear in package spec unit
if Get_Source_Unit (N) = No_Unit
- or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))),
+ or else not Nkind_In (Sinfo.Unit (Cunit (Current_Sem_Unit)),
N_Package_Declaration,
N_Generic_Package_Declaration)
then
if Nkind (P) = N_Compilation_Unit then
Unit_Kind := Nkind (Unit (P));
- if Unit_Kind = N_Subprogram_Declaration
- or else Unit_Kind = N_Package_Declaration
+ if Nkind_In (Unit_Kind, N_Subprogram_Declaration,
+ N_Package_Declaration)
or else Unit_Kind in N_Generic_Declaration
then
Unit_Name := Defining_Entity (Unit (P));
Id := Chars (Arg);
Expr := Get_Pragma_Arg (Arg);
+ -- Special handling for No_Elaboration_Code
+
+ if Nkind (Expr) = N_Identifier
+ and then Chars (Expr) = Name_No_Elaboration_Code
+ then
+ if No_Elab_Code (Current_Sem_Unit) < No_Elab_Code then
+ Set_No_Elab_Code (Current_Sem_Unit, No_Elab_Code);
+ end if;
+ end if;
+
+ -- Special handling for No_Elaboration_Code_All
+
+ if Nkind (Expr) = N_Identifier
+ and then Chars (Expr) = Name_No_Elaboration_Code_All
+ then
+ -- Must appear within a spec
+
+ if not Nkind_In (Unit (Cunit (Current_Sem_Unit)),
+ N_Package_Declaration,
+ N_Subprogram_Declaration)
+ then
+ Error_Msg_Name_1 := Id;
+ Error_Msg_N
+ ("restriction% can appear only in package or "
+ & "subprogram spec", Arg);
+ end if;
+
+ -- Set special value in unit table
+
+ declare
+ New_Val : No_Elab_Code_T;
+
+ begin
+ if Warn then
+ New_Val := No_Elab_Code_All_Warn;
+ else
+ New_Val := No_Elab_Code_All;
+ end if;
+
+ if No_Elab_Code (Current_Sem_Unit) < New_Val then
+ Set_No_Elab_Code (Current_Sem_Unit, New_Val);
+ end if;
+ end;
+
+ -- Note that in the code below, Process_Restriction_Synonym
+ -- will treat No_Elaboration_Code_All like No_Elaboration_Code.
+
+ end if;
+
-- Case of no restriction identifier present
if Id = No_Name then
Name_No_Dependence : constant Name_Id := N + $;
Name_No_Dynamic_Attachment : constant Name_Id := N + $;
Name_No_Dynamic_Interrupts : constant Name_Id := N + $;
+ Name_No_Elaboration_Code : constant Name_Id := N + $;
+ Name_No_Elaboration_Code_All : constant Name_Id := N + $;
Name_No_Implementation_Extensions : constant Name_Id := N + $;
Name_No_Obsolescent_Features : constant Name_Id := N + $;
Name_No_Requeue : constant Name_Id := N + $;
projects / gcc.git / commitdiff