+2008-08-05 Vincent Celier <celier@adacore.com>
+
+ * mlib.adb: Update comments.
+
+ * make.adb (Switches_Of): Check for Switches (others), before checking
+ for Default_Switches ("Ada").
+ (Gnatmake): Use Builder'Switches (others) in preference to
+ Builder'Default_Switches ("Ada") if there are several mains.
+
+ * prj-attr-pm.adb:
+ (Add_Attribute): Add component Others_Allowed in Attribute_Record
+ aggregate.
+
+ * prj-attr.adb:
+ Add markers to indicates that attributes Switches allow others as index
+ (Others_Allowed_For): New Boolean function, returning True for
+ attributes with the mark.
+ (Initialize): Recognize optional letter 'O' as the marker for
+ associative array attributes where others is allowed as the index.
+
+ * prj-attr.ads:
+ (Others_Allowed_For): New Boolean function
+ (Attribute_Record): New Boolean component Others_Allowed
+
+ * prj-dect.adb:
+ (Parse_Attribute_Declaration): For associative array attribute where
+ others is allowed as the index, allow others as an index.
+
+ * prj-nmsc.adb:
+ (Process_Binder): Skip associative array attributes with index others
+ (Process_Compiler): Ditto
+
+ * prj-util.adb:
+ (Value_Of (Index, In_Array)): Make no attempt to put in lower case when
+ index is All_Other_Names.
+
+ * prj.ads:
+ (All_Other_Names): New constant
+
+ * prj-proc.adb:
+ (Process_Declarative_Items): Skip associative array attribute when index
+ is reserved word "others".
+
+2008-08-05 Vasiliy Fofanov <fofanov@adacore.com>
+
+ * gen-oscons.c: Adapt for VMS where termios.h is not available.
+
2008-08-05 Thomas Quinot <quinot@adacore.com>
* a-rttiev.adb: Minor reformatting (comments)
-- project file. If the Source_File ends with a standard GNAT extension
-- (".ads" or ".adb"), try first the full name, then the name without the
-- extension, then, if Allow_ALI is True, the name with the extension
- -- ".ali". If there is no switches for either names, try the default
- -- switches for Ada. If all failed, return No_Variable_Value.
+ -- ".ali". If there is no switches for either names, try first Switches
+ -- (others) then the default switches for Ada. If all failed, return
+ -- No_Variable_Value.
function Is_In_Object_Directory
(Source_File : File_Name_Type;
-- If an ALI file was generated by this compilation, scan
-- the ALI file and record it.
+
-- If the scan fails, a previous ali file is inconsistent with
-- the unit just compiled.
(Builder_Package).Decl.Arrays,
In_Tree => Project_Tree);
+ Other_Switches : constant Variable_Value :=
+ Prj.Util.Value_Of
+ (Name => All_Other_Names,
+ Index => 0,
+ Attribute_Or_Array_Name => Name_Switches,
+ In_Package => Builder_Package,
+ In_Tree => Project_Tree);
+
begin
- if Defaults /= Nil_Variable_Value then
- if (not Quiet_Output)
+ if Other_Switches /= Nil_Variable_Value then
+ if not Quiet_Output
+ and then Switches /= No_Array_Element
+ and then Project_Tree.Array_Elements.Table
+ (Switches).Next /= No_Array_Element
+ then
+ Write_Line
+ ("Warning: using Builder'Switches(others), " &
+ "as there are several mains");
+ end if;
+
+ Add_Switches
+ (File_Name => " ",
+ Index => 0,
+ The_Package => Builder_Package,
+ Program => None);
+
+ elsif Defaults /= Nil_Variable_Value then
+ if not Quiet_Output
and then Switches /= No_Array_Element
then
Write_Line
"(""Ada""), as there are several mains");
end if;
- -- As there is never a source with name " ", we are
- -- guaranteed to always get the general switches.
-
Add_Switches
(File_Name => " ",
Index => 0,
The_Package => Builder_Package,
Program => None);
- elsif (not Quiet_Output)
+ elsif not Quiet_Output
and then Switches /= No_Array_Element
then
Write_Line
- ("Warning: using no switches from package Builder," &
- " as there are several mains");
+ ("Warning: using no switches from package " &
+ "Builder, as there are several mains");
end if;
end;
end if;
end;
end if;
+ if Switches = Nil_Variable_Value then
+ Switches :=
+ Prj.Util.Value_Of
+ (Index => All_Other_Names,
+ Src_Index => 0,
+ In_Array => Switches_Array,
+ In_Tree => Project_Tree);
+ end if;
+
if Switches = Nil_Variable_Value then
Switches :=
Prj.Util.Value_Of
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2008, 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- --
Optional_Index => False,
Attr_Kind => Unknown,
Read_Only => False,
+ Others_Allowed => False,
Next =>
Package_Attributes.Table (To_Package.Value).First_Attribute);
Package_Attributes.Table (To_Package.Value).First_Attribute :=
-- The third optional letter is
-- 'R' to indicate that the attribute is read-only
+ -- 'O' to indicate that others is allowed as an index for an associative
+ -- array
-- End is indicated by two consecutive '#'
"Pcompiler#" &
"Ladefault_switches#" &
- "Lcswitches#" &
+ "LcOswitches#" &
"SVlocal_configuration_pragmas#" &
"Salocal_config_file#" &
"Pbuilder#" &
"Ladefault_switches#" &
- "Lcswitches#" &
+ "LcOswitches#" &
"Lcglobal_compilation_switches#" &
"Scexecutable#" &
"SVexecutable_suffix#" &
"Pbinder#" &
"Ladefault_switches#" &
- "Lcswitches#" &
+ "LcOswitches#" &
-- Configuration - Binding
"Plinker#" &
"LVrequired_switches#" &
"Ladefault_switches#" &
- "Lcswitches#" &
+ "LcOswitches#" &
"LVlinker_options#" &
"SVmap_file_option#" &
"Pcross_reference#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Finder
"Pfinder#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Pretty_Printer
"Ppretty_printer#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package gnatstub
"Pgnatstub#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Check
"Pcheck#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Synchronize
"Psynchronize#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Eliminate
"Peliminate#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Metrics
"Pmetrics#" &
"Ladefault_switches#" &
- "Lbswitches#" &
+ "LbOswitches#" &
-- package Ide
Attribute_Name : Name_Id := No_Name;
First_Attribute : Attr_Node_Id := Attr.First_Attribute;
Read_Only : Boolean;
+ Others_Allowed : Boolean;
function Attribute_Location return String;
-- Returns a string depending if we are in the project level attributes
Start := Start + 1;
+ Read_Only := False;
+ Others_Allowed := False;
+
if Initialization_Data (Start) = 'R' then
Read_Only := True;
Start := Start + 1;
- else
- Read_Only := False;
+ elsif Initialization_Data (Start) = 'O' then
+ Others_Allowed := True;
+ Start := Start + 1;
end if;
Finish := Start;
Optional_Index => Optional_Index,
Attr_Kind => Attr_Kind,
Read_Only => Read_Only,
+ Others_Allowed => Others_Allowed,
Next => Empty_Attr);
Start := Finish + 1;
end if;
end if;
end Optional_Index_Of;
+ function Others_Allowed_For
+ (Attribute : Attribute_Node_Id) return Boolean
+ is
+ begin
+ if Attribute = Empty_Attribute then
+ return False;
+ else
+ return Attrs.Table (Attribute.Value).Others_Allowed;
+ end if;
+ end Others_Allowed_For;
+
-----------------------
-- Package_Name_List --
-----------------------
Optional_Index => Opt_Index,
Attr_Kind => Real_Attr_Kind,
Read_Only => False,
+ Others_Allowed => False,
Next => First_Attr);
Package_Attributes.Table (In_Package.Value).First_Attribute :=
Optional_Index => Attributes (Index).Opt_Index,
Attr_Kind => Attr_Kind,
Read_Only => False,
+ Others_Allowed => False,
Next => First_Attr);
First_Attr := Attrs.Last;
end loop;
-- Returns Empty_Attribute if After is either Empty_Attribute or is the
-- last of the list.
+ function Others_Allowed_For (Attribute : Attribute_Node_Id) return Boolean;
+ -- Returns True if the index for an associative array attributes may be
+ -- others.
+
--------------
-- Packages --
--------------
Optional_Index : Boolean;
Attr_Kind : Attribute_Kind;
Read_Only : Boolean;
+ Others_Allowed : Boolean;
Next : Attr_Node_Id;
end record;
-- Data for an attribute
else
if Is_Read_Only (Current_Attribute) then
+ Error_Msg_Name_1 := Token_Name;
Error_Msg
- ("read-only attribute cannot be given a value",
+ ("read-only attribute %% cannot be given a value",
Token_Ptr);
end if;
end if;
Scan (In_Tree); -- past the left parenthesis
- Expect (Tok_String_Literal, "literal string");
- if Token = Tok_String_Literal then
- Get_Name_String (Token_Name);
+ if Others_Allowed_For (Current_Attribute)
+ and then Token = Tok_Others
+ then
+ Set_Associative_Array_Index_Of
+ (Attribute, In_Tree, All_Other_Names);
+ Scan (In_Tree); -- past others
- if Case_Insensitive (Attribute, In_Tree) then
- To_Lower (Name_Buffer (1 .. Name_Len));
+ else
+ if Others_Allowed_For (Current_Attribute) then
+ Expect (Tok_String_Literal, "literal string or others");
+ else
+ Expect (Tok_String_Literal, "literal string");
end if;
- Set_Associative_Array_Index_Of (Attribute, In_Tree, Name_Find);
- Scan (In_Tree); -- past the literal string index
+ if Token = Tok_String_Literal then
+ Get_Name_String (Token_Name);
- if Token = Tok_At then
- case Attribute_Kind_Of (Current_Attribute) is
+ if Case_Insensitive (Attribute, In_Tree) then
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ end if;
+
+ Set_Associative_Array_Index_Of (Attribute, In_Tree, Name_Find);
+ Scan (In_Tree); -- past the literal string index
+
+ if Token = Tok_At then
+ case Attribute_Kind_Of (Current_Attribute) is
when Optional_Index_Associative_Array |
Optional_Index_Case_Insensitive_Associative_Array =>
Scan (In_Tree);
if Token = Tok_Integer_Literal then
Scan (In_Tree);
end if;
- end case;
+ end case;
+ end if;
end if;
end if;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
- -- Get the name of the language
+ if Element.Index /= All_Other_Names then
+ -- Get the name of the language
- Get_Language_Index_Of (Element.Index);
+ Get_Language_Index_Of (Element.Index);
- if Lang_Index /= No_Language_Index then
- case Current_Array.Name is
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
when Name_Driver =>
-- Attribute Driver (<language>)
when others =>
null;
- end case;
+ end case;
+ end if;
end if;
Element_Id := Element.Next;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
- -- Get the name of the language
+ if Element.Index /= All_Other_Names then
+ -- Get the name of the language
- Get_Language_Index_Of (Element.Index);
+ Get_Language_Index_Of (Element.Index);
- if Lang_Index /= No_Language_Index then
- case Current_Array.Name is
+ if Lang_Index /= No_Language_Index then
+ case Current_Array.Name is
when Name_Dependency_Switches =>
-- Attribute Dependency_Switches (<language>)
if In_Tree.Languages_Data.Table
- (Lang_Index).Config.Dependency_Kind = None
+ (Lang_Index).Config.Dependency_Kind = None
then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Dependency_Kind :=
- Makefile;
+ Makefile;
end if;
List := Element.Value.Values;
then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Dependency_Kind :=
- Makefile;
+ Makefile;
end if;
List := Element.Value.Values;
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Include_Path_File =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path_File :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Driver =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Compiler_Driver :=
- File_Name_Type (Element.Value.Value);
+ File_Name_Type (Element.Value.Value);
when Name_Required_Switches =>
Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.
- Compiler_Required_Switches,
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.
+ Compiler_Required_Switches,
From_List => Element.Value.Values,
In_Tree => In_Tree);
begin
In_Tree.Languages_Data.Table
(Lang_Index).Config.Path_Syntax :=
- Path_Syntax_Kind'Value
- (Get_Name_String (Element.Value.Value));
+ Path_Syntax_Kind'Value
+ (Get_Name_String (Element.Value.Value));
exception
when Constraint_Error =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Mapping_Spec_Suffix :=
- File_Name_Type (Element.Value.Value);
+ File_Name_Type (Element.Value.Value);
when Name_Mapping_Body_Suffix =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Mapping_Body_Suffix :=
- File_Name_Type (Element.Value.Value);
+ File_Name_Type (Element.Value.Value);
when Name_Config_File_Switches =>
end if;
Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.Config_File_Switches,
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Config_File_Switches,
From_List => List,
In_Tree => In_Tree);
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Objects_Path_File =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path_File :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Body_File_Name =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Body :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Body_File_Name_Pattern =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Body_Pattern :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Spec_File_Name =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Spec :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_Spec_File_Name_Pattern =>
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Spec_Pattern :=
- Element.Value.Value;
+ Element.Value.Value;
when Name_Config_File_Unique =>
begin
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_File_Unique :=
- Boolean'Value
- (Get_Name_String (Element.Value.Value));
+ Boolean'Value
+ (Get_Name_String (Element.Value.Value));
exception
when Constraint_Error =>
Error_Msg
when others =>
null;
- end case;
+ end case;
+ end if;
end if;
Element_Id := Element.Next;
Real_Index_1 := Index;
if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
- Get_Name_String (Index);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Real_Index_1 := Name_Find;
+ if Index /= All_Other_Names then
+ Get_Name_String (Index);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Real_Index_1 := Name_Find;
+ end if;
end if;
while Current /= No_Array_Element loop
Real_Index_2 := Element.Index;
if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
- Get_Name_String (Element.Index);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Real_Index_2 := Name_Find;
+ if Element.Index /= All_Other_Names then
+ Get_Name_String (Element.Index);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Real_Index_2 := Name_Find;
+ end if;
end if;
if Real_Index_1 = Real_Index_2 and then
package Prj is
+ All_Other_Names : constant Name_Id := Names_High_Bound;
+ -- Name used to replace others as an index of an associative array
+ -- attribute, when allowed.
+
Subdirs_Option : constant String := "--subdirs=";
-- Switch used to indicate that the real directories (object, exec,
-- library, ...) are subdirectories of what is indicated in the project
projects / thirdparty / gcc.git / commitdiff
