From: Arnaud Charlet Date: Thu, 31 Jul 2014 12:32:10 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e8cddc3b5a9c50a9c7bd4b58b97f6384bc1aa807;p=gcc.git [multiple changes] 2014-07-31 Vincent Celier * projects.texi: Minor spelling error fix. 2014-07-31 Robert Dewar * 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 * 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 * 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. From-SVN: r213347 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 03aa74363a7..0da286d62bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2014-07-31 Vincent Celier + + * projects.texi: Minor spelling error fix. + +2014-07-31 Robert Dewar + + * 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 + + * 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 + + * 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 * exp_util.adb: Minor reformatting. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 19debb301af..4638537a010 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4043,9 +4043,10 @@ package body Exp_Aggr is -- 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) @@ -4057,7 +4058,10 @@ package body Exp_Aggr is 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; @@ -4081,6 +4085,17 @@ package body Exp_Aggr is 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 @@ -4100,9 +4115,7 @@ package body Exp_Aggr is 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; @@ -4110,7 +4123,10 @@ package body Exp_Aggr is 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; @@ -4125,7 +4141,7 @@ package body Exp_Aggr is 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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index fb1b90485f7..4d502f17629 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; @@ -1849,6 +1850,10 @@ package body Freeze is -- 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- @@ -3548,6 +3553,39 @@ package body Freeze is 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 -- ------------------------------ @@ -4454,6 +4492,7 @@ package body Freeze is 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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c0bbfb88229..d936cdb1d6b 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -490,6 +490,7 @@ Partition-Wide Restrictions Program Unit Level Restrictions * No_Elaboration_Code:: +* No_Elaboration_Code_All:: * No_Entry_Queue:: * No_Implementation_Aspect_Specifications:: * No_Implementation_Attributes:: @@ -10964,6 +10965,7 @@ other compilation units in the partition. @menu * No_Elaboration_Code:: +* No_Elaboration_Code_All:: * No_Entry_Queue:: * No_Implementation_Aspect_Specifications:: * No_Implementation_Attributes:: @@ -11024,6 +11026,22 @@ Note that this the implementation of this restriction requires full 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 diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 262cefe00a7..f1ef626ec6d 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -221,6 +221,7 @@ package body Lib.Load is 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), @@ -327,6 +328,7 @@ package body Lib.Load is 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, @@ -690,6 +692,7 @@ package body Lib.Load is 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, diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 92c43247e05..61d48e22fc4 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -90,6 +90,7 @@ package body Lib.Writ is Main_Priority => -1, Main_CPU => -1, Munit_Index => 0, + No_Elab_Code => None, Serial_Number => 0, Version => 0, Error_Location => No_Location, @@ -147,6 +148,7 @@ package body Lib.Writ is Main_Priority => -1, Main_CPU => -1, Munit_Index => 0, + No_Elab_Code => None, Serial_Number => 0, Version => 0, Error_Location => No_Location, diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 53b611d983a..b2f9c36e40e 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -146,6 +146,11 @@ package body Lib is 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; @@ -226,6 +231,11 @@ package body Lib is 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; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index a2a2410f5a7..c5d3f4fefba 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -347,6 +347,35 @@ package Lib is -- 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. @@ -410,6 +439,7 @@ package Lib is 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; @@ -426,6 +456,7 @@ package Lib is 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); @@ -726,6 +757,7 @@ private 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); @@ -735,6 +767,7 @@ private 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); @@ -760,6 +793,7 @@ private Generate_Code : Boolean; Has_RACW : Boolean; Dynamic_Elab : Boolean; + No_Elab_Code : No_Elab_Code_T; Filler : Boolean; Loading : Boolean; OA_Setting : Character; @@ -789,7 +823,8 @@ private 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; diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 65df6f73204..54a43e0686a 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -2728,7 +2728,7 @@ be ignored. 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 diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 8983f78ee1c..237ee421409 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -883,6 +883,11 @@ package body Restrict is 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 => diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 5cae0d6bd58..4f414aa0df8 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -336,6 +336,7 @@ package Restrict is -- 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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index aea29d098fe..c0f874ea857 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1333,19 +1333,48 @@ package body Sem_Ch10 is 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 + ("