diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 40 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-attr-pm.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 73 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/prj-pp.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 82 | ||||
| -rw-r--r-- | gcc/ada/prj-strt.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 27 | ||||
| -rw-r--r-- | gcc/ada/projects.texi | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/switch-c.adb | 4 |
19 files changed, 347 insertions, 74 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 474921e..af2af30 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2014-08-04 Arnaud Charlet <charlet@adacore.com> + + * exp_util.adb (Check_Float_Op_Overflow): No-op in codepeer + mode for now, to revert to previous behavior. + * checks.adb: Revert previous change, no longer needed. + +2014-08-04 Robert Dewar <dewar@adacore.com> + + * gnat1drv.adb (Adjust_Global_Switches): Don't set + Check_Float_Overflow if Machine_Oveflows_On_Target is True. + * sem_prag.adb (Analyze_Pragma, case Check_Float_Overflow): Don't + set Check_Float_Overflow if Machine_Oveflows_On_Target is True. + * switch-c.adb (Scan_Front_End_Switches): Don't set + Check_Float_Overflow if Machine_Oveflows_On_Target is True. + +2014-08-04 Vincent Celier <celier@adacore.com> + + * prj-attr.adb: Add new default indications for + attributes Object_Dir, Exec_Dir, Source_Dirs and Target. + (Attribute_Default_Of): New function (Initialize): Set the + default for those attributes that have one specified. + * prj-attr.ads (Attribute_Data): New component Default. + * prj-proc.adb (Expression): Take into account the new defaults + for attributes Object_Dir, Exec_Dir and Source_Dirs. + * prj-strt.adb (Attribute_Reference): Set the default for + the attribute. + * prj-tree.ads, prj-tree.adb (Default_Of): New function. + (Set_Default_Of): New procedure. + * prj.adb (The_Dot_String): New global Name_Id variable, + initialized in procedure Initialize. + (Dot_String): New function + (Initialize): Initialize The_Dot_String. + (Reset): Create the string list Shared.Dot_String_List. + * prj.ads (Attribute_Default_Value): New enumeration type. + (Project_Qualifier): Change enumeration value Dry to Abstract_Project. + (Dot_String): New function. + (Shared_Project_Tree_Data): New string list component Dot_String_List. + * projects.texi: Document new defaults for attribute Object_Dir, + Exec_Dir and Source_Dirs. + 2014-08-04 Robert Dewar <dewar@adacore.com> * sem_ch12.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index cddd15a..0b934eb 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -9214,7 +9214,6 @@ package body Checks is Wnode : Node_Id := Warn_Node; Ret_Result : Check_Result := (Empty, Empty); Num_Checks : Integer := 0; - Reason : RT_Exception_Code := CE_Range_Check_Failed; procedure Add_Check (N : Node_Id); -- Adds the action given to Ret_Result if N is non-Empty @@ -9836,16 +9835,6 @@ package body Checks is else if not In_Subrange_Of (S_Typ, T_Typ) then Cond := Discrete_Expr_Cond (Ck_Node, T_Typ); - - -- Special case CodePeer_Mode and apparently redundant checks on - -- floating point types: these are used as overflow checks, see - -- Exp_Util.Check_Float_Op_Overflow. - - elsif CodePeer_Mode and then Check_Float_Overflow - and then Is_Floating_Point_Type (S_Typ) - then - Cond := Discrete_Expr_Cond (Ck_Node, T_Typ); - Reason := CE_Overflow_Check_Failed; end if; end if; end if; @@ -10040,7 +10029,7 @@ package body Checks is Add_Check (Make_Raise_Constraint_Error (Loc, Condition => Cond, - Reason => Reason)); + Reason => CE_Range_Check_Failed)); end if; return Ret_Result; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index f3ea21f..5532d58 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1643,30 +1643,12 @@ package body Exp_Util is if not Check_Float_Overflow or else not Is_Floating_Point_Type (Etype (N)) - then - return; - end if; - -- Special expansion for CodePeer_Mode: we reuse the Apply_Range_Check - -- machinery instead of expanding a 'Valid attribute, since CodePeer - -- does not know how to handle expansion of 'Valid on floating point. - -- ??? Consider using the same expansion in normal mode. This should - -- work assuming division checks are also enabled (to prevent generation - -- of NaNs), except for e.g. unchecked conversions which might also - -- generate NaNs. - - if CodePeer_Mode then - declare - Typ : constant Entity_Id := Etype (N); - begin - -- Prevent recursion + -- In CodePeer_Mode, rely on the overflow check flag being set instead - Set_Analyzed (N); - - Apply_Range_Check (N, Typ); - Analyze_And_Resolve (N, Typ); - return; - end; + or else CodePeer_Mode + then + return; end if; -- Otherwise we replace the expression by diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index e074b08..50f4bef 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -371,9 +371,11 @@ procedure Gnat1drv is -- Detect overflow on unconstrained floating-point types, such as -- the predefined types Float, Long_Float and Long_Long_Float from - -- package Standard. + -- package Standard. Not necessary if float overflows are checked + -- (Machine_Overflow true), since appropriate Do_Overflow_Check flags + -- will be set in any case. - Check_Float_Overflow := True; + Check_Float_Overflow := not Machine_Overflows_On_Target; -- Set STRICT mode for overflow checks if not set explicitly. This -- prevents suppressing of overflow checks by default, in code down diff --git a/gcc/ada/prj-attr-pm.adb b/gcc/ada/prj-attr-pm.adb index 9b75c05..f9f41b1 100644 --- a/gcc/ada/prj-attr-pm.adb +++ b/gcc/ada/prj-attr-pm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-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- -- @@ -47,6 +47,7 @@ package body Prj.Attr.PM is Attr_Kind => Unknown, Read_Only => False, Others_Allowed => False, + Default => Empty_Value, Next => Package_Attributes.Table (To_Package.Value).First_Attribute)); diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 04ce48a..9e003e4 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -34,7 +34,7 @@ package body Prj.Attr is -- Data for predefined attributes and packages - -- Names are in lower case and end with '#' + -- Names are in lower case and end with '#' or 'D'. -- Package names are preceded by 'P' @@ -59,6 +59,11 @@ package body Prj.Attr is -- 'O' to indicate that others is allowed as an index for an associative -- array + -- If the character after the name in lower case letter is a 'D' + -- (for default), then 'D' must be followed by an enumeration value of type + -- Attribute_Default_Value, followed by a '#'. + -- Example: + -- "SVobject_dirDdot_value#" -- End is indicated by two consecutive '#' Initialization_Data : constant String := @@ -76,9 +81,9 @@ package body Prj.Attr is -- Directories - "SVobject_dir#" & - "SVexec_dir#" & - "LVsource_dirs#" & + "SVobject_dirDdot_value#" & + "SVexec_dirDobject_dir_value#" & + "LVsource_dirsDdot_value#" & "Lainherit_source_path#" & "LVexcluded_source_dirs#" & "LVignore_source_sub_dirs#" & @@ -129,7 +134,7 @@ package body Prj.Attr is "Satoolchain_description#" & "Saobject_generated#" & "Saobjects_linked#" & - "SVtarget#" & + "SVtargetDtarget_value#" & -- Configuration - Libraries @@ -416,6 +421,21 @@ package body Prj.Attr is Package_Names (Last_Package_Name) := new String'(Name); end Add_Package_Name; + -------------------------- + -- Attribute_Default_Of -- + -------------------------- + + function Attribute_Default_Of + (Attribute : Attribute_Node_Id) return Attribute_Default_Value + is + begin + if Attribute = Empty_Attribute then + return Empty_Value; + else + return Attrs.Table (Attribute.Value).Default; + end if; + end Attribute_Default_Of; + ----------------------- -- Attribute_Kind_Of -- ----------------------- @@ -482,6 +502,7 @@ package body Prj.Attr is First_Attribute : Attr_Node_Id := Attr.First_Attribute; Read_Only : Boolean; Others_Allowed : Boolean; + Default : Attribute_Default_Value; function Attribute_Location return String; -- Returns a string depending if we are in the project level attributes @@ -611,9 +632,11 @@ package body Prj.Attr is Read_Only := False; Others_Allowed := False; + Default := Empty_Value; if Initialization_Data (Start) = 'R' then Read_Only := True; + Default := Read_Only_Value; Start := Start + 1; elsif Initialization_Data (Start) = 'O' then @@ -623,12 +646,42 @@ package body Prj.Attr is Finish := Start; - while Initialization_Data (Finish) /= '#' loop + while Initialization_Data (Finish) /= '#' + and then + Initialization_Data (Finish) /= 'D' + loop Finish := Finish + 1; end loop; Attribute_Name := Name_Id_Of (Initialization_Data (Start .. Finish - 1)); + + if Initialization_Data (Finish) = 'D' then + Start := Finish + 1; + Finish := Start; + + while Initialization_Data (Finish) /= '#' loop + Finish := Finish + 1; + end loop; + + declare + Default_Name : constant String := + Initialization_Data (Start .. Finish - 1); + pragma Unsuppress (All_Checks); + + begin + Default := Attribute_Default_Value'Value (Default_Name); + + exception + when Constraint_Error => + Osint.Fail + ("illegal default value """ & + Default_Name & + """ for attribute " & + Get_Name_String (Attribute_Name)); + end; + end if; + Attrs.Increment_Last; if Current_Attribute = Empty_Attr then @@ -662,6 +715,7 @@ package body Prj.Attr is Attr_Kind => Attr_Kind, Read_Only => Read_Only, Others_Allowed => Others_Allowed, + Default => Default, Next => Empty_Attr); Start := Finish + 1; end if; @@ -770,7 +824,8 @@ package body Prj.Attr is Attr_Kind : Defined_Attribute_Kind; Var_Kind : Defined_Variable_Kind; Index_Is_File_Name : Boolean := False; - Opt_Index : Boolean := False) + Opt_Index : Boolean := False; + Default : Attribute_Default_Value := Empty_Value) is Attr_Name : Name_Id; First_Attr : Attr_Node_Id := Empty_Attr; @@ -840,6 +895,7 @@ package body Prj.Attr is Attr_Kind => Real_Attr_Kind, Read_Only => False, Others_Allowed => False, + Default => Default, Next => First_Attr); Package_Attributes.Table (In_Package.Value).First_Attribute := @@ -952,6 +1008,7 @@ package body Prj.Attr is Attr_Kind => Attr_Kind, Read_Only => False, Others_Allowed => False, + Default => Attributes (Index).Default, Next => First_Attr); First_Attr := Attrs.Last; end loop; diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index dc60cd6..5b944f9b 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -107,6 +107,10 @@ package Prj.Attr is Var_Kind : Defined_Variable_Kind; -- The attribute value kind: single or list + Default : Attribute_Default_Value := Empty_Value; + -- The value of the attribute when referenced if the attribute has not + -- been (yet) declared. + end record; -- Name and characteristics of an attribute in a package registered -- explicitly with Register_New_Package (see below). @@ -190,6 +194,12 @@ package Prj.Attr is -- Set the variable kind of a known attribute. Does nothing if Attribute is -- Empty_Attribute. + function Attribute_Default_Of + (Attribute : Attribute_Node_Id) return Attribute_Default_Value; + -- Returns the default of the attribute, Read_Only_Value for read only + -- attributes, Empty_Value when ndefault not specified or specified + -- value. + function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean; -- Returns True if Attribute is a known attribute and may have an -- optional index. Returns False otherwise. @@ -232,12 +242,13 @@ package Prj.Attr is Attr_Kind : Defined_Attribute_Kind; Var_Kind : Defined_Variable_Kind; Index_Is_File_Name : Boolean := False; - Opt_Index : Boolean := False); + Opt_Index : Boolean := False; + Default : Attribute_Default_Value := Empty_Value); -- Add a new attribute to registered package In_Package. Fails if Name -- (the attribute name) is empty, if In_Package is Empty_Package or if -- the attribute name has a duplicate name. See definition of type -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind, - -- Index_Is_File_Name and Opt_Index. + -- Index_Is_File_Name, Opt_Index and Default. function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id; -- Returns the package node id of the package with name Name. Returns @@ -320,6 +331,7 @@ private Attr_Kind : Attribute_Kind; Read_Only : Boolean; Others_Allowed : Boolean; + Default : Attribute_Default_Value; Next : Attr_Node_Id; end record; -- Data for an attribute diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index fb14af7..93b5963b 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -8517,7 +8517,7 @@ package body Prj.Nmsc is Show_Source_Dirs (Project, Shared); end if; - if Project.Qualifier = Dry then + if Project.Qualifier = Abstract_Project then Check_Abstract_Project (Project, Data); end if; end case; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 48b57aa..6d4a7f1 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -1094,7 +1094,8 @@ package body Prj.Part is while Present (With_Clause) loop Imported := Project_Node_Of (With_Clause, In_Tree); - if Project_Qualifier_Of (Imported, In_Tree) /= Dry then + if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project + then Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree)); Error_Msg (Flags, "can only import abstract projects, not %%", Token_Ptr); @@ -1152,7 +1153,7 @@ package body Prj.Part is Qualifier_Location := Token_Ptr; if Token = Tok_Abstract then - Proj_Qualifier := Dry; + Proj_Qualifier := Abstract_Project; Scan (In_Tree); elsif Token = Tok_Identifier then @@ -1370,7 +1371,8 @@ package body Prj.Part is if Extended then if A_Project_Name_And_Node.Extended then - if A_Project_Name_And_Node.Proj_Qualifier /= Dry then + if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project + then Error_Msg (Env.Flags, "cannot extend the same project file several times", @@ -1811,8 +1813,11 @@ package body Prj.Part is -- with sources if it inherits sources from the project -- it extends. - if Project_Qualifier_Of (Project, In_Tree) = Dry and then - Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry + if Project_Qualifier_Of + (Project, In_Tree) = Abstract_Project + and then + Project_Qualifier_Of + (Extended_Project, In_Tree) /= Abstract_Project then Error_Msg (Env.Flags, "an abstract project can only extend " & @@ -1925,7 +1930,9 @@ package body Prj.Part is Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); if Present (Extended_Project) - and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry + and then + Project_Qualifier_Of + (Extended_Project, In_Tree) /= Abstract_Project then Set_Extending_Project_Of (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree, diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index 30402ea..9ccd935 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -403,7 +403,7 @@ package body Prj.PP is Write_String ("library ", Indent); when Configuration => Write_String ("configuration ", Indent); - when Dry => + when Abstract_Project => Write_String ("abstract ", Indent); end case; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 08232cd..bd681d6 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -519,6 +519,8 @@ package body Prj.Proc is Last : String_List_Id := Nil_String; -- Reference to the last string elements in Result, when Kind is List + Current_Term_Kind : Project_Node_Kind; + begin Result.Project := Project; Result.Location := Location_Of (First_Term, From_Project_Node_Tree); @@ -528,8 +530,10 @@ package body Prj.Proc is The_Term := First_Term; while Present (The_Term) loop The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); + Current_Term_Kind := + Kind_Of (The_Current_Term, From_Project_Node_Tree); - case Kind_Of (The_Current_Term, From_Project_Node_Tree) is + case Current_Term_Kind is when N_Literal_String => @@ -700,6 +704,13 @@ package body Prj.Proc is Index : Name_Id := No_Name; begin + <<Object_Dir_Restart>> + The_Project := Project; + The_Package := Pkg; + The_Name := No_Name; + The_Variable_Id := No_Variable; + Index := No_Name; + if Present (Term_Project) and then Term_Project /= From_Project_Node then @@ -741,9 +752,7 @@ package body Prj.Proc is The_Name := Name_Of (The_Current_Term, From_Project_Node_Tree); - if Kind_Of (The_Current_Term, From_Project_Node_Tree) = - N_Attribute_Reference - then + if Current_Term_Kind = N_Attribute_Reference then Index := Associative_Array_Index_Of (The_Current_Term, From_Project_Node_Tree); @@ -759,9 +768,7 @@ package body Prj.Proc is -- First, if there is a package, look into the package - if Kind_Of (The_Current_Term, From_Project_Node_Tree) = - N_Variable_Reference - then + if Current_Term_Kind = N_Variable_Reference then The_Variable_Id := Shared.Packages.Table (The_Package).Decl.Variables; @@ -786,9 +793,7 @@ package body Prj.Proc is -- If we have not found it, look into the project - if Kind_Of (The_Current_Term, From_Project_Node_Tree) = - N_Variable_Reference - then + if Current_Term_Kind = N_Variable_Reference then The_Variable_Id := The_Project.Decl.Variables; else The_Variable_Id := The_Project.Decl.Attributes; @@ -882,6 +887,63 @@ package body Prj.Proc is end; end if; + -- Check the defaults + + if Current_Term_Kind = N_Attribute_Reference + and then The_Variable.Default + then + declare + The_Default : constant Attribute_Default_Value := + Default_Of + (The_Current_Term, From_Project_Node_Tree); + begin + case The_Variable.Kind is + when Undefined => + null; + + when Single => + case The_Default is + when Read_Only_Value => + null; + + when Empty_Value => + The_Variable.Value := Empty_String; + + when Dot_Value => + The_Variable.Value := Dot_String; + + when Object_Dir_Value => + From_Project_Node_Tree.Project_Nodes.Table + (The_Current_Term).Name := + Snames.Name_Object_Dir; + From_Project_Node_Tree.Project_Nodes.Table + (The_Current_Term).Default := + Dot_Value; + goto Object_Dir_Restart; + + when Target_Value => + null; + end case; + + when List => + case The_Default is + when Read_Only_Value => + null; + + when Empty_Value => + The_Variable.Values := Nil_String; + + when Dot_Value => + The_Variable.Values := + Shared.Dot_String_List; + + when Object_Dir_Value | Target_Value => + null; + end case; + end case; + end; + end if; + case Kind is when Undefined => diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index a4c8ce0..cacae77 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -218,6 +218,9 @@ package body Prj.Strt is (Reference, In_Tree, To => Attribute_Kind_Of (Current_Attribute) in All_Case_Insensitive_Associative_Array); + Set_Default_Of + (Reference, In_Tree, + To => Attribute_Default_Of (Current_Attribute)); -- Scan past the attribute name diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 2ff5a9f..023947c 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -122,6 +122,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => No_Name, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -172,6 +173,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => Comments.Table (J).Value, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -340,6 +342,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => No_Name, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -385,6 +388,22 @@ package body Prj.Tree is return In_Tree.Project_Nodes.Table (Node).Field1; end Current_Term; + ---------------- + -- Default_Of -- + ---------------- + + function Default_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value + is + begin + pragma Assert + (Present (Node) + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference); + return In_Tree.Project_Nodes.Table (Node).Default; + end Default_Of; + -------------------------- -- Default_Project_Node -- -------------------------- @@ -416,6 +435,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => No_Name, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -452,6 +472,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => No_Name, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -486,6 +507,7 @@ package body Prj.Tree is Src_Index => 0, Path_Name => No_Path, Value => Comments.Table (J).Value, + Default => Empty_Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, @@ -1867,6 +1889,23 @@ package body Prj.Tree is In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Current_Term; + -------------------- + -- Set_Default_Of -- + -------------------- + + procedure Set_Default_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Attribute_Default_Value) + is + begin + pragma Assert + (Present (Node) + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference); + In_Tree.Project_Nodes.Table (Node).Default := To; + end Set_Default_Of; + ---------------------- -- Set_Directory_Of -- ---------------------- diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 0a7da7f..e798d6b 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -590,6 +590,12 @@ package Prj.Tree is -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes. -- May return Empty_Node. + function Default_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value; + pragma Inline (Default_Of); + -- Only valid for N_Attribute_Reference nodes + function String_Type_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; @@ -1068,7 +1074,14 @@ package Prj.Tree is In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id); pragma Inline (Set_Package_Node_Of); - -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes. + -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes + + procedure Set_Default_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Attribute_Default_Value); + pragma Inline (Set_Default_Of); + -- Only valid for N_Attribute_Reference nodes procedure Set_String_Type_Of (Node : Project_Node_Id; @@ -1179,6 +1192,9 @@ package Prj.Tree is Value : Name_Id := No_Name; -- See below for what Project_Node_Kind it is used + Default : Attribute_Default_Value := Empty_Value; + -- Only used in N_Attribute_Reference + Field1 : Project_Node_Id := Empty_Node; -- See below the meaning for each Project_Node_Kind diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 3c4d115..8e5914b 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -61,6 +61,8 @@ package body Prj is The_Empty_String : Name_Id := No_Name; + The_Dot_String : Name_Id := No_Name; + Debug_Level : Integer := 0; -- Current indentation level for debug traces @@ -308,6 +310,15 @@ package body Prj is end Dependency_Name; ---------------- + -- Dot_String -- + ---------------- + + function Dot_String return Name_Id is + begin + return The_Dot_String; + end Dot_String; + + ---------------- -- Empty_File -- ---------------- @@ -1057,6 +1068,10 @@ package body Prj is Name_Len := 0; The_Empty_String := Name_Find; + Name_Len := 1; + Name_Buffer (1) := '.'; + The_Dot_String := Name_Find; + Prj.Attr.Initialize; -- Make sure that new reserved words after Ada 95 may be used as @@ -1442,6 +1457,20 @@ package body Prj is Array_Table.Init (Tree.Shared.Arrays); Package_Table.Init (Tree.Shared.Packages); + -- Create Dot_String_List + + String_Element_Table.Append + (Tree.Shared.String_Elements, + String_Element' + (Value => The_Dot_String, + Index => 0, + Display_Value => The_Dot_String, + Location => No_Location, + Flag => False, + Next => Nil_String)); + Tree.Shared.Dot_String_List := + String_Element_Table.Last (Tree.Shared.String_Elements); + -- Private part table Temp_Files_Table.Init (Tree.Shared.Private_Part.Temp_Files); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 329cc6d..b44bfa4 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -72,6 +72,25 @@ package Prj is type Yes_No_Unknown is (Yes, No, Unknown); -- Tri-state to decide if -lgnarl is needed when linking + type Attribute_Default_Value is + (Read_Only_Value, + -- for read only attributes (Name, Project_Dir) + + Empty_Value, + -- empty string or empty string list + + Dot_Value, + -- "." or (".") + + Object_Dir_Value, + -- 'Object_Dir + + Target_Value + -- 'Target (special rules) + ); + -- Describe the default values of attributes that are referenced but not + -- declared. + pragma Warnings (Off); type Project_Qualifier is (Unspecified, @@ -83,7 +102,7 @@ package Prj is Library, Configuration, - Dry, + Abstract_Project, Aggregate, Aggregate_Library); pragma Warnings (On); @@ -91,7 +110,7 @@ package Prj is -- file: -- Standard: standard project ... -- Library: library project is ... - -- Dry: abstract project is + -- Abstract_Project: abstract project is -- Aggregate: aggregate project is -- Aggregate_Library: aggregate library project is ... -- Configuration: configuration project is ... @@ -123,6 +142,9 @@ package Prj is function Empty_String return Name_Id; -- Return the id for an empty string "" + function Dot_String return Name_Id; + -- Return the id for "." + type Path_Information is record Name : Path_Name_Type := No_Path; Display_Name : Path_Name_Type := No_Path; @@ -1570,6 +1592,7 @@ package Prj is Arrays : Array_Table.Instance; Packages : Package_Table.Instance; Private_Part : Private_Project_Tree_Data; + Dot_String_List : String_List_Id := Nil_String; end record; type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data; -- The data that is shared among multiple trees, when these trees are diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 9622e05..b61deca 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -3724,7 +3724,7 @@ Here are some examples of attribute declarations: Attributes references may appear anywhere in expressions, and are used to retrieve the value previously assigned to the attribute. If an attribute has not been set in a given package or project, its value defaults to the -empty string or the empty list. +empty string or the empty list, with some exceptions. @smallexample attribute_reference ::= @@ -3746,6 +3746,15 @@ Examples are: Builder'Default_Switches ("Ada") @end smallexample +The exceptions to the empty defaults are: + +@itemize @bullet +@item Object_Dir: default is "." +@item Exec_Dir: default is 'Object_Dir, that is the value of attribute + Object_Dir in the same project, declared or defaulted. +@item Source_Dirs: default is (".") +@end itemize + @noindent The prefix of an attribute may be: diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 21a2ae8..6b94a8b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11806,7 +11806,7 @@ package body Sem_Prag is GNAT_Pragma; Check_Valid_Configuration_Pragma; Check_Arg_Count (0); - Check_Float_Overflow := True; + Check_Float_Overflow := not Machine_Overflows_On_Target; ---------------- -- Check_Name -- diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 5cdbd41..46939c6 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -32,11 +32,13 @@ with Lib; use Lib; with Osint; use Osint; with Opt; use Opt; with Stylesw; use Stylesw; +with Targparm; use Targparm; with Ttypes; use Ttypes; with Validsw; use Validsw; with Warnsw; use Warnsw; with Ada.Unchecked_Deallocation; + with System.WCh_Con; use System.WCh_Con; with System.OS_Lib; @@ -572,7 +574,7 @@ package body Switch.C is when 'F' => Ptr := Ptr + 1; - Check_Float_Overflow := True; + Check_Float_Overflow := not Machine_Overflows_On_Target; -- -gnateG (save preprocessor output) |