===================================================================
@@ -33,6 +33,8 @@ with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
with Snames;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.HTable;
@@ -1021,15 +1023,17 @@ package body Prj.Proc is
From_Project_Node_Tree));
declare
- Name : constant Name_Id := Name_Find;
- Default : Name_Id := No_Name;
- Value : Name_Id := No_Name;
-
- Def_Var : Variable_Value;
+ Name : constant Name_Id := Name_Find;
+ Default : Name_Id := No_Name;
+ Value : Name_Id := No_Name;
+ Ext_List : Boolean := False;
+ Str_List : String_List_Access := null;
+ Def_Var : Variable_Value;
Default_Node : constant Project_Node_Id :=
- External_Default_Of
- (The_Current_Term, From_Project_Node_Tree);
+ External_Default_Of
+ (The_Current_Term,
+ From_Project_Node_Tree);
begin
-- If there is a default value for the external reference,
@@ -1053,19 +1057,132 @@ package body Prj.Proc is
end if;
end if;
- Value :=
- Prj.Ext.Value_Of (From_Project_Node_Tree, Name, Default);
+ Ext_List := Expression_Kind_Of
+ (The_Current_Term,
+ From_Project_Node_Tree) = List;
+
+ if Ext_List then
+ Value :=
+ Prj.Ext.Value_Of
+ (From_Project_Node_Tree, Name, No_Name);
- if Value = No_Name then
- if not Quiet_Output then
- Error_Msg
- (Flags, "?undefined external reference",
- Location_Of
- (The_Current_Term, From_Project_Node_Tree),
- Project);
+ if Value /= No_Name then
+ declare
+ Sep : constant String :=
+ Get_Name_String (Default);
+ First : Positive := 1;
+ Lst : Natural;
+ Done : Boolean := False;
+ Nmb : Natural;
+
+ begin
+ Get_Name_String (Value);
+
+ if Name_Len = 0
+ or else Sep'Length = 0
+ or else Name_Buffer (1 .. Name_Len) = Sep
+ then
+ Done := True;
+ end if;
+
+ if not Done and then Name_Len < Sep'Length then
+ Str_List :=
+ new String_List'
+ (1 => new String'
+ (Name_Buffer (1 .. Name_Len)));
+ Done := True;
+ end if;
+
+ if not Done then
+ if Name_Buffer (1 .. Sep'Length) = Sep then
+ First := Sep'Length + 1;
+ end if;
+
+ if Name_Len - First + 1 >= Sep'Length
+ and then
+ Name_Buffer (Name_Len - Sep'Length + 1 ..
+ Name_Len) = Sep
+ then
+ Name_Len := Name_Len - Sep'Length;
+ end if;
+
+ if Name_Len = 0 then
+ Str_List :=
+ new String_List'(1 => new String'(""));
+ Done := True;
+ end if;
+ end if;
+
+ if not Done then
+ -- Count the number of string
+
+ declare
+ Saved : constant Positive := First;
+ begin
+
+ Nmb := 1;
+ loop
+ Lst :=
+ Index
+ (Source =>
+ Name_Buffer (First .. Name_Len),
+ Pattern => Sep);
+ exit when Lst = 0;
+ Nmb := Nmb + 1;
+ First := Lst + Sep'Length;
+ end loop;
+
+ First := Saved;
+ end;
+
+ Str_List := new String_List (1 .. Nmb);
+
+ -- Populate the string list
+
+ Nmb := 1;
+ loop
+ Lst :=
+ Index
+ (Source =>
+ Name_Buffer (First .. Name_Len),
+ Pattern => Sep);
+
+ if Lst = 0 then
+ Str_List (Nmb) :=
+ new String'
+ (Name_Buffer (First .. Name_Len));
+ exit;
+
+ else
+ Str_List (Nmb) :=
+ new String'
+ (Name_Buffer (First .. Lst - 1));
+ Nmb := Nmb + 1;
+ First := Lst + Sep'Length;
+ end if;
+ end loop;
+ end if;
+ end;
end if;
- Value := Empty_String;
+ else
+ -- Get the value
+
+ Value :=
+ Prj.Ext.Value_Of
+ (From_Project_Node_Tree, Name, Default);
+
+ if Value = No_Name then
+ if not Quiet_Output then
+ Error_Msg
+ (Flags, "?undefined external reference",
+ Location_Of
+ (The_Current_Term, From_Project_Node_Tree),
+ Project);
+ end if;
+
+ Value := Empty_String;
+ end if;
end if;
case Kind is
@@ -1074,34 +1191,75 @@ package body Prj.Proc is
null;
when Single =>
- Add (Result.Value, Value);
+ if Ext_List then
+ null; -- error
- when List =>
- String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ else
+ Add (Result.Value, Value);
+ end if;
- if Last = Nil_String then
- Result.Values := String_Element_Table.Last
+ when List =>
+ if not Ext_List or else Str_List /= null then
+ String_Element_Table.Increment_Last
(In_Tree.String_Elements);
- else
- In_Tree.String_Elements.Table
- (Last).Next := String_Element_Table.Last
- (In_Tree.String_Elements);
- end if;
+ if Last = Nil_String then
+ Result.Values :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
- Last := String_Element_Table.Last
+ else
+ In_Tree.String_Elements.Table (Last).Next :=
+ String_Element_Table.Last
(In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last) :=
- (Value => Value,
- Display_Value => No_Name,
- Location =>
- Location_Of
- (The_Current_Term, From_Project_Node_Tree),
- Flag => False,
- Next => Nil_String,
- Index => 0);
+ end if;
+ Last :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
+
+ if Ext_List then
+ for Ind in Str_List'Range loop
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Str_List (Ind).all);
+ Value := Name_Find;
+ In_Tree.String_Elements.Table (Last) :=
+ (Value => Value,
+ Display_Value => No_Name,
+ Location =>
+ Location_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
+
+ if Ind /= Str_List'Last then
+ String_Element_Table.Increment_Last
+ (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table
+ (Last).Next :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
+ Last :=
+ String_Element_Table.Last
+ (In_Tree.String_Elements);
+ end if;
+ end loop;
+
+ else
+ In_Tree.String_Elements.Table (Last) :=
+ (Value => Value,
+ Display_Value => No_Name,
+ Location =>
+ Location_Of
+ (The_Current_Term,
+ From_Project_Node_Tree),
+ Flag => False,
+ Next => Nil_String,
+ Index => 0);
+ end if;
+ end if;
end case;
end;
===================================================================
@@ -155,9 +155,10 @@ package body ALI.Util is
-- recognized as reserved words, but as identifiers. The byte info for
-- those names have been set if we are in gnatmake.
- Set_Name_Table_Byte (Name_Project, 0);
- Set_Name_Table_Byte (Name_Extends, 0);
- Set_Name_Table_Byte (Name_External, 0);
+ Set_Name_Table_Byte (Name_Project, 0);
+ Set_Name_Table_Byte (Name_Extends, 0);
+ Set_Name_Table_Byte (Name_External, 0);
+ Set_Name_Table_Byte (Name_External_As_List, 0);
-- Scan the complete file to compute its checksum
===================================================================
@@ -109,6 +109,7 @@ package body Prj.Strt is
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
External_Value : out Project_Node_Id;
+ Expr_Kind : in out Variable_Kind;
Flags : Processing_Flags);
-- Parse an external reference. Current token is "external"
@@ -368,23 +369,38 @@ package body Prj.Strt is
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
External_Value : out Project_Node_Id;
+ Expr_Kind : in out Variable_Kind;
Flags : Processing_Flags)
is
Field_Id : Project_Node_Id := Empty_Node;
+ Ext_List : Boolean := False;
begin
External_Value :=
Default_Project_Node
(Of_Kind => N_External_Value,
- In_Tree => In_Tree,
- And_Expr_Kind => Single);
+ In_Tree => In_Tree);
Set_Location_Of (External_Value, In_Tree, To => Token_Ptr);
- -- The current token is External
-
- -- Get the left parenthesis
+ -- The current token is either external or external_as_list
+ Ext_List := Token = Tok_External_As_List;
Scan (In_Tree);
+
+ if Ext_List then
+ Set_Expression_Kind_Of (External_Value, In_Tree, To => List);
+ else
+ Set_Expression_Kind_Of (External_Value, In_Tree, To => Single);
+ end if;
+
+ if Expr_Kind = Undefined then
+ if Ext_List then
+ Expr_Kind := List;
+ else
+ Expr_Kind := Single;
+ end if;
+ end if;
+
Expect (Tok_Left_Paren, "`(`");
-- Scan past the left parenthesis
@@ -413,6 +429,10 @@ package body Prj.Strt is
case Token is
when Tok_Right_Paren =>
+ if Ext_List then
+ Error_Msg (Flags, "`,` expected", Token_Ptr);
+ end if;
+
Scan (In_Tree); -- scan past right paren
when Tok_Comma =>
@@ -448,7 +468,11 @@ package body Prj.Strt is
end if;
when others =>
- Error_Msg (Flags, "`,` or `)` expected", Token_Ptr);
+ if Ext_List then
+ Error_Msg (Flags, "`,` expected", Token_Ptr);
+ else
+ Error_Msg (Flags, "`,` or `)` expected", Token_Ptr);
+ end if;
end case;
end if;
end External_Reference;
@@ -1493,19 +1517,13 @@ package body Prj.Strt is
end if;
end if;
- when Tok_External =>
-
- -- An external reference is always a single string
-
- if Expr_Kind = Undefined then
- Expr_Kind := Single;
- end if;
-
+ when Tok_External | Tok_External_As_List =>
External_Reference
(In_Tree => In_Tree,
Flags => Flags,
Current_Project => Current_Project,
Current_Package => Current_Package,
+ Expr_Kind => Expr_Kind,
External_Value => Reference);
Set_Current_Term (Term, In_Tree, To => Reference);
===================================================================
@@ -620,9 +620,15 @@ package body Prj is
The_Empty_String := Name_Find;
Prj.Attr.Initialize;
- Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
- Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
- Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
+
+ Set_Name_Table_Byte
+ (Name_Project, Token_Type'Pos (Tok_Project));
+ Set_Name_Table_Byte
+ (Name_Extends, Token_Type'Pos (Tok_Extends));
+ Set_Name_Table_Byte
+ (Name_External, Token_Type'Pos (Tok_External));
+ Set_Name_Table_Byte
+ (Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
end if;
if Tree /= No_Project_Tree then
===================================================================
@@ -192,7 +192,8 @@ package Scans is
Tok_Project,
Tok_Extends,
Tok_External,
- -- These three entries represent keywords for the project file language
+ Tok_External_As_List,
+ -- These four entries represent keywords for the project file language
-- and can be returned only in the case of scanning project files.
Tok_Comment,
===================================================================
@@ -2515,6 +2515,11 @@ An external value is an expression whose
that invoked the processing of the current project file (typically a
gnatmake or gprbuild command).
+There are two kinds of external values, one that returns a single string, and
+one that returns a string list.
+
+The syntax of a single string external value is:
+
@smallexample
external_value ::= @i{external} ( string_literal [, string_literal] )
@end smallexample
@@ -2532,7 +2537,7 @@ or be specified on the command line thro
are specified, then the command line value is used, so that a user can more
easily override the value.
-The function @code{external} always returns a string, possibly empty if the
+The function @code{external} always returns a string. It is an error if the
value was not found in the environment and no default was specified in the
call to @code{external}.
@@ -2545,6 +2550,42 @@ are then used in @b{case} statements to
attributes in various scenarios. Thus such variables are often called
@b{scenario variables}.
+The syntax for a string list external value is:
+
+@smallexample
+external_value ::= @i{external_as_list} ( string_literal , string_literal )
+@end smallexample
+
+@noindent
+The first string_literal is the string to be used on the command line or
+in the environment to specify the external value. The second string_literal is
+the separator between each component of the string list.
+
+If the external value does not exist in the environment or on the command line,
+the result is an empty list. This is also the case, if the separator is an
+empty string or if the external value is only one separator.
+
+Any separator at the beginning or at the end of the external value is
+discarded. Then, if there is no separator in the external vaue, the result is
+a string list with only one string. Otherwise, any string between the biginning
+and the first separator, between two consecutive separators and between the
+last separator and the end are components of the string list.
+
+@smallexample
+ @i{external_as_list} ("SWITCHES", ",")
+@end smallexample
+
+@noindent
+If the external value is "-O2,-g", the result is ("-O2", "-g").
+
+If the external value is ",-O2,-g,", the result is also ("-O2", "-g").
+
+if the external value is "-gnav", the result is ("-gnatv").
+
+If the external value is ",,", the result is ("").
+
+If the external value is ",", the result is (), the empty string list.
+
@c ---------------------------------------------
@node Typed String Declaration
@subsection Typed String Declaration
===================================================================
@@ -1063,6 +1063,7 @@ package Snames is
Name_Executable : constant Name_Id := N + $;
Name_Executable_Suffix : constant Name_Id := N + $;
Name_Extends : constant Name_Id := N + $;
+ Name_External_As_List : constant Name_Id := N + $;
Name_Externally_Built : constant Name_Id := N + $;
Name_Finder : constant Name_Id := N + $;
Name_Global_Compilation_Switches : constant Name_Id := N + $;
===================================================================
@@ -559,11 +559,12 @@ package body Prj.Tree is
function Expression_Kind_Of
(Node : Project_Node_Id;
- In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
+ In_Tree : Project_Node_Tree_Ref) return Variable_Kind
+ is
begin
pragma Assert
(Present (Node)
- and then
+ and then -- should use Nkind_In here ??? why not???
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
@@ -571,7 +572,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
In_Tree.Project_Nodes.Table (Node).Kind =
- N_Typed_Variable_Declaration
+ N_Typed_Variable_Declaration
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
or else
@@ -581,9 +582,9 @@ package body Prj.Tree is
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- In_Tree.Project_Nodes.Table (Node).Kind =
- N_Attribute_Reference));
-
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
end Expression_Kind_Of;
@@ -1837,7 +1838,7 @@ package body Prj.Tree is
begin
pragma Assert
(Present (Node)
- and then
+ and then -- should use Nkind_In here ??? why not???
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
@@ -1845,7 +1846,7 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
In_Tree.Project_Nodes.Table (Node).Kind =
- N_Typed_Variable_Declaration
+ N_Typed_Variable_Declaration
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
or else
@@ -1855,8 +1856,9 @@ package body Prj.Tree is
or else
In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- In_Tree.Project_Nodes.Table (Node).Kind =
- N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
end Set_Expression_Kind_Of;
===================================================================
@@ -296,7 +296,8 @@ package Prj.Tree is
pragma Inline (Expression_Kind_Of);
-- Only valid for N_Literal_String, N_Attribute_Declaration,
-- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
- -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
+ -- N_Term, N_Variable_Reference, N_Attribute_Reference nodes or
+ -- N_External_Value.
function Is_Extending_All
(Node : Project_Node_Id;
@@ -759,7 +760,8 @@ package Prj.Tree is
pragma Inline (Set_Expression_Kind_Of);
-- Only valid for N_Literal_String, N_Attribute_Declaration,
-- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
- -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
+ -- N_Term, N_Variable_Reference, N_Attribute_Reference or N_External_Value
+ -- nodes.
procedure Set_Is_Extending_All
(Node : Project_Node_Id;