From ef23710410fd2e10867efdcf7cfd6a35171c9fab Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 8 Oct 2010 12:22:31 +0200 Subject: [PATCH] [multiple changes] 2010-10-08 Robert Dewar * sem_ch3.adb: Minor reformatting. 2010-10-08 Vincent Celier * 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 --- gcc/ada/ChangeLog | 18 ++++ gcc/ada/ali-util.adb | 7 +- gcc/ada/prj-proc.adb | 234 ++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/prj-strt.adb | 46 +++++++--- gcc/ada/prj-tree.adb | 22 ++--- gcc/ada/prj-tree.ads | 6 +- gcc/ada/prj.adb | 12 ++- gcc/ada/projects.texi | 43 ++++++++- gcc/ada/scans.ads | 3 +- gcc/ada/sem_ch3.adb | 5 +- gcc/ada/snames.ads-tmpl | 1 + 11 files changed, 322 insertions(+), 75 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 00e7dba..cb0c7e9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2010-10-08 Robert Dewar + + * sem_ch3.adb: Minor reformatting. + +2010-10-08 Vincent Celier + + * 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 * sem_prag.adb: Minor reformatting. diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 8c837b4..a040d30 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -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 diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index c517a47..0553d33f 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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 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 Ext_List then + Value := + Prj.Ext.Value_Of + (From_Project_Node_Tree, Name, No_Name); + + 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; diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index 3120e17..aa63738 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -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); diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 55f2195..f1b700b 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -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; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 5ed88d5..b6ec054 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 5a69848..2c1d0d3 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -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 diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 67eb907..c1afd0d 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -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 diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index 0532862..7d89119 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -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, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index eee4dd7..3a4eecf 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0425ccc..2bb291f 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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 + $; -- 2.7.4