Commit ef237104 by Arnaud Charlet

[multiple changes]

2010-10-08  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor reformatting.

2010-10-08  Vincent Celier  <celier@adacore.com>

	* ali-util.adb (Get_File_Checksum): Make sure that external_as_list is
	not a reserved word.
	* prj-proc.adb (Expression): Process string list external references.
	* prj-strt.adb (External_Reference): Parse external_as_list external
	references.
	* prj-tree.ads (Expression_Kind_Of): Allowed for N_External_Value nodes
	(Set_Expression_Kind_Of): Ditto
	* prj.adb (Initialize): Set external_as_list as a reserved word
	* projects.texi: Document new string external reference external_as_list
	* scans.ads (Token_Type): New token Tok_External_As_List
	* snames.ads-tmpl: New standard name Name_External_As_List

From-SVN: r165157
parent 2604ec03
2010-10-08 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting.
2010-10-08 Vincent Celier <celier@adacore.com>
* ali-util.adb (Get_File_Checksum): Make sure that external_as_list is
not a reserved word.
* prj-proc.adb (Expression): Process string list external references.
* prj-strt.adb (External_Reference): Parse external_as_list external
references.
* prj-tree.ads (Expression_Kind_Of): Allowed for N_External_Value nodes
(Set_Expression_Kind_Of): Ditto
* prj.adb (Initialize): Set external_as_list as a reserved word
* projects.texi: Document new string external reference external_as_list
* scans.ads (Token_Type): New token Tok_External_As_List
* snames.ads-tmpl: New standard name Name_External_As_List
2010-10-08 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb: Minor reformatting.
......
......@@ -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);
......
......@@ -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;
......
......@@ -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
......
......@@ -2515,6 +2515,11 @@ An external value is an expression whose value is obtained from the command
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 through the
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 control the value assigned 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
......
......@@ -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,
......
......@@ -13738,8 +13738,7 @@ package body Sem_Ch3 is
(not Is_Interface (Parent_Type)
or else not Is_Limited_Interface (Parent_Type))
then
-- AI05-0096 : a derivation in the private part of an instance is
-- AI05-0096: a derivation in the private part of an instance is
-- legal if the generic formal is untagged limited, and the actual
-- is non-limited.
......@@ -13747,7 +13746,7 @@ package body Sem_Ch3 is
and then In_Private_Part (Current_Scope)
and then
not Is_Tagged_Type
(Generic_Parent_Type (Parent (Parent_Type)))
(Generic_Parent_Type (Parent (Parent_Type)))
then
null;
......
......@@ -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 + $;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment