mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-24 16:30:53 +08:00
Code Issues Packages Projects Releases Wiki Activity

make.adb (Switches_Of): Check for Switches (others), before checking for Default_Switches ("Ada").

Browse Source 
2008-08-05  Vincent Celier  <celier@adacore.com>

	* 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

From-SVN: r138683
This commit is contained in:
Arnaud Charlet 2008-08-05 11:14:48 +02:00
parent 9cc014f915
commit 0df218a9a7
9 changed files with 211 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
gcc/ada/ChangeLog
View File

@ -1,3 +1,50 @@
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)

57
gcc/ada/make.adb
View File

@ -645,8 +645,9 @@ package body Make is
-- 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;
@ -3463,6 +3464,7 @@ package body Make is
-- 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.
@ -5123,31 +5125,53 @@ package body Make is
(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'Default_Switches" &
"(""Ada""), as there are several mains");
("Warning: using Builder'Switches(others), " &
"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 Defaults /= Nil_Variable_Value then
if not Quiet_Output
and then Switches /= No_Array_Element
then
Write_Line
("Warning: using Builder'Default_Switches" &
"(""Ada""), as there are several mains");
end if;
Add_Switches
(File_Name => " ",
Index => 0,
The_Package => Builder_Package,
Program => None);
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;
@ -8162,6 +8186,15 @@ package body Make is
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

3
gcc/ada/prj-attr-pm.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -45,6 +45,7 @@ package body Prj.Attr.PM is
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 :=

49
gcc/ada/prj-attr.adb
View File

@ -56,6 +56,8 @@ package body Prj.Attr is
-- 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 '#'
@ -159,7 +161,7 @@ package body Prj.Attr is
"Pcompiler#" &
"Ladefault_switches#" &
"Lcswitches#" &
"LcOswitches#" &
"SVlocal_configuration_pragmas#" &
"Salocal_config_file#" &
@ -200,7 +202,7 @@ package body Prj.Attr is
"Pbuilder#" &
"Ladefault_switches#" &
"Lcswitches#" &
"LcOswitches#" &
"Lcglobal_compilation_switches#" &
"Scexecutable#" &
"SVexecutable_suffix#" &
@ -216,7 +218,7 @@ package body Prj.Attr is
"Pbinder#" &
"Ladefault_switches#" &
"Lcswitches#" &
"LcOswitches#" &
-- Configuration - Binding
@ -231,7 +233,7 @@ package body Prj.Attr is
"Plinker#" &
"LVrequired_switches#" &
"Ladefault_switches#" &
"Lcswitches#" &
"LcOswitches#" &
"LVlinker_options#" &
"SVmap_file_option#" &
@ -246,49 +248,49 @@ package body Prj.Attr is
"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
@ -411,6 +413,7 @@ package body Prj.Attr is
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
@ -538,12 +541,16 @@ package body Prj.Attr is
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;
@ -586,6 +593,7 @@ package body Prj.Attr is
Optional_Index => Optional_Index,
Attr_Kind => Attr_Kind,
Read_Only => Read_Only,
Others_Allowed => Others_Allowed,
Next => Empty_Attr);
Start := Finish + 1;
end if;
@ -643,6 +651,17 @@ package body Prj.Attr is
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 --
-----------------------
@ -750,6 +769,7 @@ package body Prj.Attr is
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 :=
@ -856,6 +876,7 @@ package body Prj.Attr is
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;

5
gcc/ada/prj-attr.ads
View File

@ -169,6 +169,10 @@ package Prj.Attr is
-- 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 --
--------------
@ -282,6 +286,7 @@ private
Optional_Index : Boolean;
Attr_Kind : Attribute_Kind;
Read_Only : Boolean;
Others_Allowed : Boolean;
Next : Attr_Node_Id;
end record;
-- Data for an attribute

37
gcc/ada/prj-dect.adb
View File

@ -223,8 +223,9 @@ package body Prj.Dect is
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;
@ -284,20 +285,33 @@ package body Prj.Dect is
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);
@ -329,7 +343,8 @@ package body Prj.Dect is
if Token = Tok_Integer_Literal then
Scan (In_Tree);
end if;
end case;
end case;
end if;
end if;
end if;

70
gcc/ada/prj-nmsc.adb
View File

@ -1295,12 +1295,13 @@ package body Prj.Nmsc is
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>)
@ -1342,7 +1343,8 @@ package body Prj.Nmsc is
when others =>
null;
end case;
end case;
end if;
end if;
Element_Id := Element.Next;
@ -1405,22 +1407,23 @@ package body Prj.Nmsc is
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;
@ -1442,7 +1445,7 @@ package body Prj.Nmsc is
then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Dependency_Kind :=
Makefile;
Makefile;
end if;
List := Element.Value.Values;
@ -1481,7 +1484,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path :=
Element.Value.Value;
Element.Value.Value;
when Name_Include_Path_File =>
@ -1489,7 +1492,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Include_Path_File :=
Element.Value.Value;
Element.Value.Value;
when Name_Driver =>
@ -1499,13 +1502,13 @@ package body Prj.Nmsc is
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);
@ -1513,8 +1516,8 @@ package body Prj.Nmsc is
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 =>
@ -1571,7 +1574,7 @@ package body Prj.Nmsc is
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 =>
@ -1579,7 +1582,7 @@ package body Prj.Nmsc is
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 =>
@ -1596,8 +1599,8 @@ package body Prj.Nmsc is
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);
@ -1607,7 +1610,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path :=
Element.Value.Value;
Element.Value.Value;
when Name_Objects_Path_File =>
@ -1615,7 +1618,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Path_File :=
Element.Value.Value;
Element.Value.Value;
when Name_Config_Body_File_Name =>
@ -1623,7 +1626,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Body :=
Element.Value.Value;
Element.Value.Value;
when Name_Config_Body_File_Name_Pattern =>
@ -1632,7 +1635,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Body_Pattern :=
Element.Value.Value;
Element.Value.Value;
when Name_Config_Spec_File_Name =>
@ -1640,7 +1643,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Spec :=
Element.Value.Value;
Element.Value.Value;
when Name_Config_Spec_File_Name_Pattern =>
@ -1649,7 +1652,7 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table
(Lang_Index).Config.Config_Spec_Pattern :=
Element.Value.Value;
Element.Value.Value;
when Name_Config_File_Unique =>
@ -1658,8 +1661,8 @@ package body Prj.Nmsc is
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
@ -1671,7 +1674,8 @@ package body Prj.Nmsc is
when others =>
null;
end case;
end case;
end if;
end if;
Element_Id := Element.Next;

16
gcc/ada/prj-util.adb
View File

@ -600,9 +600,11 @@ package body Prj.Util is
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
@ -610,9 +612,11 @@ package body Prj.Util is
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

4
gcc/ada/prj.ads
View File

@ -40,6 +40,10 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
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