+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.
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
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;
Add_Check
(Make_Raise_Constraint_Error (Loc,
Condition => Cond,
- Reason => Reason));
+ Reason => CE_Range_Check_Failed));
end if;
return Ret_Result;
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
-- 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
-- --
-- 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- --
Attr_Kind => Unknown,
Read_Only => False,
Others_Allowed => False,
+ Default => Empty_Value,
Next =>
Package_Attributes.Table (To_Package.Value).First_Attribute));
-- --
-- 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- --
-- 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'
-- '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 :=
-- 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#" &
"Satoolchain_description#" &
"Saobject_generated#" &
"Saobjects_linked#" &
- "SVtarget#" &
+ "SVtargetDtarget_value#" &
-- Configuration - Libraries
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 --
-----------------------
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
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
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
Attr_Kind => Attr_Kind,
Read_Only => Read_Only,
Others_Allowed => Others_Allowed,
+ Default => Default,
Next => Empty_Attr);
Start := Finish + 1;
end if;
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;
Attr_Kind => Real_Attr_Kind,
Read_Only => False,
Others_Allowed => False,
+ Default => Default,
Next => First_Attr);
Package_Attributes.Table (In_Package.Value).First_Attribute :=
Attr_Kind => Attr_Kind,
Read_Only => False,
Others_Allowed => False,
+ Default => Attributes (Index).Default,
Next => First_Attr);
First_Attr := Attrs.Last;
end loop;
-- --
-- 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- --
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).
-- 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.
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
Attr_Kind : Attribute_Kind;
Read_Only : Boolean;
Others_Allowed : Boolean;
+ Default : Attribute_Default_Value;
Next : Attr_Node_Id;
end record;
-- Data for an attribute
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;
-- --
-- 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- --
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);
Qualifier_Location := Token_Ptr;
if Token = Tok_Abstract then
- Proj_Qualifier := Dry;
+ Proj_Qualifier := Abstract_Project;
Scan (In_Tree);
elsif Token = Tok_Identifier then
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",
-- 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 " &
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,
Write_String ("library ", Indent);
when Configuration =>
Write_String ("configuration ", Indent);
- when Dry =>
+ when Abstract_Project =>
Write_String ("abstract ", Indent);
end case;
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);
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 =>
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
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);
-- 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;
-- 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;
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 =>
(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
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Src_Index => 0,
Path_Name => No_Path,
Value => Comments.Table (J).Value,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
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 --
--------------------------
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Src_Index => 0,
Path_Name => No_Path,
Value => Comments.Table (J).Value,
+ Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
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 --
----------------------
-- --
-- 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- --
-- 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;
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;
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
The_Empty_String : Name_Id := No_Name;
+ The_Dot_String : Name_Id := No_Name;
+
Debug_Level : Integer := 0;
-- Current indentation level for debug traces
end case;
end Dependency_Name;
+ ----------------
+ -- Dot_String --
+ ----------------
+
+ function Dot_String return Name_Id is
+ begin
+ return The_Dot_String;
+ end Dot_String;
+
----------------
-- Empty_File --
----------------
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
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);
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,
Library,
Configuration,
- Dry,
+ Abstract_Project,
Aggregate,
Aggregate_Library);
pragma Warnings (On);
-- 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 ...
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;
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
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 ::=
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:
GNAT_Pragma;
Check_Valid_Configuration_Pragma;
Check_Arg_Count (0);
- Check_Float_Overflow := True;
+ Check_Float_Overflow := not Machine_Overflows_On_Target;
----------------
-- Check_Name --
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;
when 'F' =>
Ptr := Ptr + 1;
- Check_Float_Overflow := True;
+ Check_Float_Overflow := not Machine_Overflows_On_Target;
-- -gnateG (save preprocessor output)
projects / thirdparty / gcc.git / commitdiff
