diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 86 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 66 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 56 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 2173 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 39 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/prj-util.ads | 42 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 140 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 115 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 50 |
16 files changed, 1669 insertions, 1240 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 529a6a34340..3593fd6f29b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,89 @@ +2001-10-10 Vincent Celier <celier@gnat.com> + + * make.adb: + (Add_Switches): reflect the changes for the switches attributes + Default_Switches indexed by the programming language, + Switches indexed by the file name. + (Collect_Arguments_And_Compile): Idem. + Reflect the attribute name changes. + + * prj-attr.adb: + (Initialisation_Data): Change the names of some packages and + attributes. + (Initialize): process case insensitive associative arrays. + + * prj-attr.ads: + (Attribute_Kind): Remove Both, add Case_Insensitive_Associative_Array. + + * prj-dect.adb: + (Parse_Attribute_Declaration): For case insensitive associative + arrays, set the index string to lower case. + + * prj-env.adb: + Reflect the changes of the project attributes. + + * prj-nmsc.adb: + Replace Check_Naming_Scheme by Ada_Check and + Language_Independent_Check. + + * prj-nmsc.ads: + Replaced Check_Naming_Scheme by 2 procedures: + Ada_Check and Language_Independent_Check. + + * prj-proc.adb: + (Process_Declarative_Items): For case-insensitive associative + arrays, set the index string to lower case. + (Recursive_Check): Call Prj.Nmsc.Ada_Check, instead of + Prj.Nmsc.Check_Naming_Scheme. + + * prj-tree.adb: + (Case_Insensitive): New function + (Set_Case_Insensitive): New procedure + + * prj-tree.ads: + (Case_Insensitive): New function + (Set_Case_Insensitive): New procedure + (Project_Node_Record): New flag Case_Insensitive. + + * prj-util.adb: + (Value_Of): new function to get the string value of a single + string variable or attribute. + + * prj-util.ads: + (Value_Of): new function to get the string value of a single + string variable or attribute. + + * prj.adb: + (Ada_Default_Spec_Suffix): New function + (Ada_Default_Impl_Suffix): New function + Change definitions of several constants to reflect + new components of record types. + + * prj.ads: + (Naming_Data): Change several components to reflect new + elements of naming schemes. + (Project_Data): New flags Sources_Present and + Language_Independent_Checked. + (Ada_Default_Spec_Suffix): New function. + (Ada_Default_Impl_Suffix): New function. + + * snames.ads: + Modification of predefined names for project manager: added + Implementation, Specification_Exceptions, Implementation_Exceptions, + Specification_Suffix, Implementation_Suffix, Separate_Suffix, + Default_Switches, _Languages, Builder, Cross_Reference, + Finder. Removed Body_Part, Specification_Append, Body_Append, + Separate_Append, Gnatmake, Gnatxref, Gnatfind, Gnatbind, + Gnatlink. + + * prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix): + Add comments. + + * prj-nmsc.adb (Ada_Check): Test that Separate_Suffix is defaulted, + not that it is Nil_Variable_Value. + + * prj.ads: Add ??? for uncommented declarations + 2001-10-10 Ed Schonberg <schonber@gnat.com> * sem_prag.adb: (Analyze_Pragma, case External): If entity is a diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 945dd20ce56..7bf6eeda61a 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.172 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- -- @@ -623,15 +623,27 @@ package body Make is Switch_List : String_List_Id; Element : String_Element; + Switches_Array : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Switches, + In_Arrays => Packages.Table (The_Package).Decl.Arrays); + Default_Switches_Array : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Default_Switches, + In_Arrays => Packages.Table (The_Package).Decl.Arrays); + begin if File_Name'Length > 0 then Name_Len := File_Name'Length; Name_Buffer (1 .. Name_Len) := File_Name; Switches := - Prj.Util.Value_Of - (Name => Name_Find, - Attribute_Or_Array_Name => Name_Switches, - In_Package => The_Package); + Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array); + + if Switches = Nil_Variable_Value then + Switches := Prj.Util.Value_Of + (Index => Name_Ada, + In_Array => Default_Switches_Array); + end if; case Switches.Kind is when Undefined => @@ -1660,11 +1672,32 @@ package body Make is -- the specific switches for the current source, -- or the global switches, if any. - Switches := - Prj.Util.Value_Of - (Name => Source_File, - Attribute_Or_Array_Name => Name_Switches, - In_Package => Compiler_Package); + declare + Defaults : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Default_Switches, + In_Arrays => Packages.Table + (Compiler_Package).Decl.Arrays); + Switches_Array : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Switches, + In_Arrays => Packages.Table + (Compiler_Package).Decl.Arrays); + + begin + Switches := + Prj.Util.Value_Of + (Index => Source_File, + In_Array => Switches_Array); + + if Switches = Nil_Variable_Value then + Switches := + Prj.Util.Value_Of + (Index => Name_Ada, In_Array => Defaults); + end if; + + end; + end if; case Switches.Kind is @@ -2609,17 +2642,17 @@ package body Make is Gnatmake : constant Prj.Package_Id := Prj.Util.Value_Of - (Name => Name_Gnatmake, + (Name => Name_Builder, In_Packages => The_Packages); Binder_Package : constant Prj.Package_Id := Prj.Util.Value_Of - (Name => Name_Gnatbind, + (Name => Name_Binder, In_Packages => The_Packages); Linker_Package : constant Prj.Package_Id := Prj.Util.Value_Of - (Name => Name_Gnatlink, + (Name => Name_Linker, In_Packages => The_Packages); begin @@ -2924,12 +2957,13 @@ package body Make is Body_Append : constant String := Get_Name_String (Projects.Table - (Main_Project).Naming.Body_Append); + (Main_Project). + Naming.Current_Impl_Suffix); Spec_Append : constant String := Get_Name_String (Projects.Table (Main_Project). - Naming.Specification_Append); + Naming.Current_Spec_Suffix); begin Get_Name_String (Main_Source_File); @@ -3444,7 +3478,7 @@ package body Make is -- Avoid looking in the current directory for ALI files - Opt.Look_In_Primary_Dir := False; + -- Opt.Look_In_Primary_Dir := False; -- Set the project parsing verbosity to whatever was specified -- by a possible -vP switch. diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index aa793025f8a..3840b9c6a1c 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.4 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -36,7 +36,8 @@ package body Prj.Attr is -- Package names are preceded by 'P' -- Attribute names are preceded by two capital letters: -- 'S' for Single or 'L' for list, then - -- 'V' for single variable, 'A' for associative array, or 'B' for both. + -- 'V' for single variable, 'A' for associative array or + -- 'a' for case insensitive associative array. -- End is indicated by two consecutive '#'. Initialisation_Data : constant String := @@ -53,28 +54,33 @@ package body Prj.Attr is "SVlibrary_elaboration#" & "SVlibrary_version#" & "LVmain#" & + "LVlanguages#" & -- package Naming "Pnaming#" & - "SVspecification_append#" & - "SVbody_append#" & - "SVseparate_append#" & + "Saspecification_suffix#" & + "Saimplementation_suffix#" & + "SVseparate_suffix#" & "SVcasing#" & "SVdot_replacement#" & "SAspecification#" & - "SAbody_part#" & + "SAimplementation#" & + "LAspecification_exceptions#" & + "LAimplementation_exceptions#" & -- package Compiler "Pcompiler#" & - "LBswitches#" & + "Ladefault_switches#" & + "LAswitches#" & "SVlocal_configuration_pragmas#" & - -- package gnatmake + -- package Builder - "Pgnatmake#" & - "LBswitches#" & + "Pbuilder#" & + "Ladefault_switches#" & + "LAswitches#" & "SVglobal_configuration_pragmas#" & -- package gnatls @@ -82,15 +88,29 @@ package body Prj.Attr is "Pgnatls#" & "LVswitches#" & - -- package gnatbind + -- package Binder - "Pgnatbind#" & - "LBswitches#" & + "Pbinder#" & + "Ladefault_switches#" & + "LAswitches#" & - -- package gnatlink + -- package Linker - "Pgnatlink#" & - "LBswitches#" & + "Plinker#" & + "Ladefault_switches#" & + "LAswitches#" & + + -- package Cross_Reference + + "Pcross_reference#" & + "Ladefault_switches#" & + "LAswitches#" & + + -- package Finder + + "Pfinder#" & + "Ladefault_switches#" & + "LAswitches#" & "#"; @@ -162,8 +182,8 @@ package body Prj.Attr is Kind_2 := Single; when 'A' => Kind_2 := Associative_Array; - when 'B' => - Kind_2 := Both; + when 'a' => + Kind_2 := Case_Insensitive_Associative_Array; when others => raise Program_Error; end case; diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index ba4bb2e543b..5c91719ca85 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.1 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -51,7 +51,10 @@ package Prj.Attr is Empty_Attribute : constant Attribute_Node_Id := Attribute_Node_Low_Bound; - type Attribute_Kind is (Single, Associative_Array, Both); + type Attribute_Kind is + (Single, + Associative_Array, + Case_Insensitive_Associative_Array); type Attribute_Record is record Name : Name_Id; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 65f7e43a4b6..df5528d0945 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.5 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -131,6 +131,13 @@ package body Prj.Dect is if Token = Tok_Identifier then Set_Name_Of (Attribute, To => Token_Name); Set_Location_Of (Attribute, To => Token_Ptr); + + if Attributes.Table (Current_Attribute).Kind_2 = + Case_Insensitive_Associative_Array + then + Set_Case_Insensitive (Attribute, To => True); + end if; + while Current_Attribute /= Empty_Attribute and then Attributes.Table (Current_Attribute).Name /= Token_Name diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 171a2d03c1a..cc812e958eb 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.17 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -470,7 +470,7 @@ package body Prj.Env is (File, "pragma Source_File_Name"); Put_Line (File, " (Spec_File_Name => ""*" & - Namet.Get_Name_String (Data.Naming.Specification_Append) & + Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) & ""","); Put_Line (File, " Casing => " & @@ -486,7 +486,7 @@ package body Prj.Env is (File, "pragma Source_File_Name"); Put_Line (File, " (Body_File_Name => ""*" & - Namet.Get_Name_String (Data.Naming.Body_Append) & + Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) & ""","); Put_Line (File, " Casing => " & @@ -498,12 +498,14 @@ package body Prj.Env is -- and maybe separate - if Data.Naming.Body_Append /= Data.Naming.Separate_Append then + if + Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix + then Put_Line (File, "pragma Source_File_Name"); Put_Line (File, " (Subunit_File_Name => ""*" & - Namet.Get_Name_String (Data.Naming.Separate_Append) & + Namet.Get_Name_String (Data.Naming.Separate_Suffix) & ""","); Put_Line (File, " Casing => " & @@ -714,7 +716,7 @@ package body Prj.Env is The_Packages := Projects.Table (Main_Project).Decl.Packages; Gnatmake := Prj.Util.Value_Of - (Name => Name_Gnatmake, + (Name => Name_Builder, In_Packages => The_Packages); if Gnatmake /= No_Package then @@ -800,10 +802,10 @@ package body Prj.Env is Extended_Spec_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Specification_Append); + (Data.Naming.Current_Spec_Suffix); Extended_Body_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Body_Append); + (Data.Naming.Current_Impl_Suffix); Unit : Unit_Data; @@ -1252,10 +1254,10 @@ package body Prj.Env is Extended_Spec_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Specification_Append); + (Data.Naming.Current_Spec_Suffix); Extended_Body_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Body_Append); + (Data.Naming.Current_Impl_Suffix); First : Unit_Id := Units.First; Current : Unit_Id; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 66031878d2b..777c99d95c8 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.25 $ +-- $Revision$ -- -- -- Copyright (C) 2000-2001 Free Software Foundation, Inc. -- -- -- @@ -26,21 +26,22 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Strings; use Ada.Strings; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Strings; use Ada.Strings; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Errout; use Errout; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with Namet; use Namet; -with Osint; use Osint; -with Output; use Output; -with Prj.Com; use Prj.Com; -with Prj.Util; use Prj.Util; -with Snames; use Snames; -with Stringt; use Stringt; -with Types; use Types; +with Errout; use Errout; +with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; +with Namet; use Namet; +with Osint; use Osint; +with Output; use Output; +with Prj.Com; use Prj.Com; +with Prj.Util; use Prj.Util; +with Snames; use Snames; +with Stringt; use Stringt; +with Types; use Types; package body Prj.Nmsc is @@ -48,18 +49,18 @@ package body Prj.Nmsc is Error_Report : Put_Line_Access := null; - procedure Check_Naming_Scheme (Naming : Naming_Data); + procedure Check_Ada_Naming_Scheme (Naming : Naming_Data); -- Check that the package Naming is correct. - procedure Check_Naming_Scheme + procedure Check_Ada_Name (Name : Name_Id; Unit : out Name_Id); - -- Check that a name is a valid unit name. + -- Check that a name is a valid Ada unit name. procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr); - -- Output an error message. - -- If Error_Report is null, simply call Errout.Error_Msg. - -- Otherwise, disregard Flag_Location and use Error_Report. + -- Output an error message. If Error_Report is null, simply call + -- Errout.Error_Msg. Otherwise, disregard Flag_Location and use + -- Error_Report. function Get_Name_String (S : String_Id) return String; -- Get the string from a String_Id @@ -70,10 +71,9 @@ package body Prj.Nmsc is Unit_Name : out Name_Id; Unit_Kind : out Spec_Or_Body; Needs_Pragma : out Boolean); - -- Find out, from a file name, the unit name, the unit kind - -- and if a specific SFN pragma is needed. - -- If the file name corresponds to no unit, then Unit_Name - -- will be No_Name. + -- Find out, from a file name, the unit name, the unit kind and if a + -- specific SFN pragma is needed. If the file name corresponds to no + -- unit, then Unit_Name will be No_Name. function Is_Illegal_Append (This : String) return Boolean; -- Returns True if the string This cannot be used as @@ -84,13 +84,10 @@ package body Prj.Nmsc is Path_Name : Name_Id; Project : Project_Id; Data : in out Project_Data; - Error_If_Invalid : Boolean; Location : Source_Ptr; Current_Source : in out String_List_Id); -- Put a unit in the list of units of a project, if the file name -- corresponds to a valid unit name. - -- If it does not correspond to a valid unit name, report an error - -- only if Error_If_Invalid is true. procedure Show_Source_Dirs (Project : Project_Id); -- List all the source directories of a project. @@ -98,247 +95,38 @@ package body Prj.Nmsc is function Locate_Directory (Name : Name_Id; Parent : Name_Id) - return Name_Id; + return Name_Id; -- Locate a directory. -- Returns No_Name if directory does not exist. function Path_Name_Of (File_Name : String_Id; Directory : Name_Id) - return String; + return String; -- Returns the path name of a (non project) file. -- Returns an empty string if file cannot be found. function Path_Name_Of (File_Name : String_Id; Directory : String_Id) - return String; + return String; -- Same as above except that Directory is a String_Id instead -- of a Name_Id. - ------------------------- - -- Check_Naming_Scheme -- - ------------------------- - - procedure Check_Naming_Scheme (Naming : Naming_Data) is - begin - -- Only check if we are not using the standard naming scheme - - if Naming /= Standard_Naming_Data then - declare - Dot_Replacement : constant String := - Get_Name_String - (Naming.Dot_Replacement); - Specification_Append : constant String := - Get_Name_String - (Naming.Specification_Append); - Body_Append : constant String := - Get_Name_String - (Naming.Body_Append); - Separate_Append : constant String := - Get_Name_String - (Naming.Separate_Append); - - begin - -- Dot_Replacement cannot - -- - be empty - -- - start or end with an alphanumeric - -- - be a single '_' - -- - start with an '_' followed by an alphanumeric - -- - contain a '.' except if it is "." - - if Dot_Replacement'Length = 0 - or else Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'First)) - or else Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'Last)) - or else (Dot_Replacement (Dot_Replacement'First) = '_' - and then - (Dot_Replacement'Length = 1 - or else - Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'First + 1)))) - or else (Dot_Replacement'Length > 1 - and then - Index (Source => Dot_Replacement, - Pattern => ".") /= 0) - then - Error_Msg - ('"' & Dot_Replacement & - """ is illegal for Dot_Replacement.", - Naming.Dot_Repl_Loc); - end if; - - -- Appends cannot - -- - be empty - -- - start with an alphanumeric - -- - start with an '_' followed by an alphanumeric - - if Is_Illegal_Append (Specification_Append) then - Error_Msg - ('"' & Specification_Append & - """ is illegal for Specification_Append.", - Naming.Spec_Append_Loc); - end if; - - if Is_Illegal_Append (Body_Append) then - Error_Msg - ('"' & Body_Append & - """ is illegal for Body_Append.", - Naming.Body_Append_Loc); - end if; - - if Body_Append /= Separate_Append then - if Is_Illegal_Append (Separate_Append) then - Error_Msg - ('"' & Separate_Append & - """ is illegal for Separate_Append.", - Naming.Sep_Append_Loc); - end if; - end if; - - -- Specification_Append cannot have the same termination as - -- Body_Append or Separate_Append - - if Specification_Append'Length >= Body_Append'Length - and then - Body_Append (Body_Append'Last - - Specification_Append'Length + 1 .. - Body_Append'Last) = Specification_Append - then - Error_Msg - ("Body_Append (""" & - Body_Append & - """) cannot end with" & - " Specification_Append (""" & - Specification_Append & """).", - Naming.Body_Append_Loc); - end if; - - if Specification_Append'Length >= Separate_Append'Length - and then - Separate_Append - (Separate_Append'Last - Specification_Append'Length + 1 - .. - Separate_Append'Last) = Specification_Append - then - Error_Msg - ("Separate_Append (""" & - Separate_Append & - """) cannot end with" & - " Specification_Append (""" & - Specification_Append & """).", - Naming.Sep_Append_Loc); - end if; - end; - end if; - end Check_Naming_Scheme; - - procedure Check_Naming_Scheme - (Name : Name_Id; - Unit : out Name_Id) - is - The_Name : String := Get_Name_String (Name); - Need_Letter : Boolean := True; - Last_Underscore : Boolean := False; - OK : Boolean := The_Name'Length > 0; - - begin - for Index in The_Name'Range loop - if Need_Letter then - - -- We need a letter (at the beginning, and following a dot), - -- but we don't have one. - - if Is_Letter (The_Name (Index)) then - Need_Letter := False; - - else - OK := False; - - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is not a letter."); - end if; - - exit; - end if; - - elsif Last_Underscore - and then (The_Name (Index) = '_' or else The_Name (Index) = '.') - then - -- Two underscores are illegal, and a dot cannot follow - -- an underscore. - - OK := False; - - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is illegal here."); - end if; - - exit; - - elsif The_Name (Index) = '.' then - - -- We need a letter after a dot - - Need_Letter := True; - - elsif The_Name (Index) = '_' then - Last_Underscore := True; - - else - -- We need an letter or a digit - - Last_Underscore := False; - - if not Is_Alphanumeric (The_Name (Index)) then - OK := False; - - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is not alphanumeric."); - end if; - - exit; - end if; - end if; - end loop; - - -- We cannot end with an underscore or a dot - - OK := OK and then not Need_Letter and then not Last_Underscore; - - if OK then - Unit := Name; - else - -- We signal a problem with No_Name - - Unit := No_Name; - end if; - end Check_Naming_Scheme; + --------------- + -- Ada_Check -- + --------------- - procedure Check_Naming_Scheme + procedure Ada_Check (Project : Project_Id; Report_Error : Put_Line_Access) is - Last_Source_Dir : String_List_Id := Nil_String; - Data : Project_Data := Projects.Table (Project); + Data : Project_Data; + Languages : Variable_Value := Nil_Variable_Value; procedure Check_Unit_Names (List : Array_Element_Id); -- Check that a list of unit names contains only valid names. - procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr); - -- Find one or several source directories, and add them - -- to the list of source directories of the project. - procedure Find_Sources; -- Find all the sources in all of the source directories -- of a project. @@ -372,7 +160,7 @@ package body Prj.Nmsc is -- Check that it contains a valid unit name - Check_Naming_Scheme (Element.Index, Unit_Name); + Check_Ada_Name (Element.Index, Unit_Name); if Unit_Name = No_Name then Error_Msg_Name_1 := Element.Index; @@ -381,7 +169,6 @@ package body Prj.Nmsc is Element.Value.Location); else - if Current_Verbosity = High then Write_Str (" Body_Part ("""); Write_Str (Get_Name_String (Unit_Name)); @@ -396,241 +183,6 @@ package body Prj.Nmsc is end loop; end Check_Unit_Names; - ---------------------- - -- Find_Source_Dirs -- - ---------------------- - - procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is - - Directory : String (1 .. Integer (String_Length (From))); - Directory_Id : Name_Id; - Element : String_Element; - - procedure Recursive_Find_Dirs (Path : String_Id); - -- Find all the subdirectories (recursively) of Path - -- and add them to the list of source directories - -- of the project. - - ------------------------- - -- Recursive_Find_Dirs -- - ------------------------- - - procedure Recursive_Find_Dirs (Path : String_Id) is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - The_Path : String := Get_Name_String (Path) & Dir_Sep; - - The_Path_Last : Positive := The_Path'Last; - - begin - if The_Path'Length > 1 - and then - (The_Path (The_Path_Last - 1) = Dir_Sep - or else The_Path (The_Path_Last - 1) = '/') - then - The_Path_Last := The_Path_Last - 1; - end if; - - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (The_Path (The_Path'First .. The_Path_Last)); - end if; - - String_Elements.Increment_Last; - Element := - (Value => Path, - Location => No_Location, - Next => Nil_String); - - -- Case of first source directory - - if Last_Source_Dir = Nil_String then - Data.Source_Dirs := String_Elements.Last; - - -- Here we already have source directories. - - else - -- Link the previous last to the new one - - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; - end if; - - -- And register this source directory as the new last - - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; - - -- Now look for subdirectories - - Open (Dir, The_Path (The_Path'First .. The_Path_Last)); - - loop - Read (Dir, Name, Last); - exit when Last = 0; - - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name (1 .. Last)); - end if; - - if Name (1 .. Last) /= "." - and then Name (1 .. Last) /= ".." - then - -- Avoid . and .. - - declare - Path_Name : constant String := - The_Path (The_Path'First .. The_Path_Last) & - Name (1 .. Last); - - begin - if Is_Directory (Path_Name) then - - -- We have found a new subdirectory, - -- register it and find its own subdirectories. - - Start_String; - Store_String_Chars (Path_Name); - Recursive_Find_Dirs (End_String); - end if; - end; - end if; - end loop; - - Close (Dir); - - exception - when Directory_Error => - null; - end Recursive_Find_Dirs; - - -- Start of processing for Find_Source_Dirs - - begin - if Current_Verbosity = High then - Write_Str ("Find_Source_Dirs ("""); - end if; - - String_To_Name_Buffer (From); - Directory := Name_Buffer (1 .. Name_Len); - Directory_Id := Name_Find; - - if Current_Verbosity = High then - Write_Str (Directory); - Write_Line (""")"); - end if; - - -- First, check if we are looking for a directory tree, - -- indicated by "/**" at the end. - - if Directory'Length >= 3 - and then Directory (Directory'Last - 1 .. Directory'Last) = "**" - and then (Directory (Directory'Last - 2) = '/' - or else - Directory (Directory'Last - 2) = Dir_Sep) - then - Name_Len := Directory'Length - 3; - - if Name_Len = 0 then - -- This is the case of "/**": all directories - -- in the file system. - - Name_Len := 1; - Name_Buffer (1) := Directory (Directory'First); - - else - Name_Buffer (1 .. Name_Len) := - Directory (Directory'First .. Directory'Last - 3); - end if; - - if Current_Verbosity = High then - Write_Str ("Looking for all subdirectories of """); - Write_Str (Name_Buffer (1 .. Name_Len)); - Write_Line (""""); - end if; - - declare - Base_Dir : constant Name_Id := Name_Find; - Root : constant Name_Id := - Locate_Directory (Base_Dir, Data.Directory); - - begin - if Root = No_Name then - Error_Msg_Name_1 := Base_Dir; - if Location = No_Location then - Error_Msg ("{ is not a valid directory.", Data.Location); - else - Error_Msg ("{ is not a valid directory.", Location); - end if; - - else - -- We have an existing directory, - -- we register it and all of its subdirectories. - - if Current_Verbosity = High then - Write_Line ("Looking for source directories:"); - end if; - - Start_String; - Store_String_Chars (Get_Name_String (Root)); - Recursive_Find_Dirs (End_String); - - if Current_Verbosity = High then - Write_Line ("End of looking for source directories."); - end if; - end if; - end; - - -- We have a single directory - - else - declare - Path_Name : constant Name_Id := - Locate_Directory (Directory_Id, Data.Directory); - - begin - if Path_Name = No_Name then - Error_Msg_Name_1 := Directory_Id; - if Location = No_Location then - Error_Msg ("{ is not a valid directory", Data.Location); - else - Error_Msg ("{ is not a valid directory", Location); - end if; - else - - -- As it is an existing directory, we add it to - -- the list of directories. - - String_Elements.Increment_Last; - Start_String; - Store_String_Chars (Get_Name_String (Path_Name)); - Element.Value := End_String; - - if Last_Source_Dir = Nil_String then - - -- This is the first source directory - - Data.Source_Dirs := String_Elements.Last; - - else - -- We already have source directories, - -- link the previous last to the new one. - - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; - end if; - - -- And register this source directory as the new last - - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; - end if; - end; - end if; - end Find_Source_Dirs; - ------------------ -- Find_Sources -- ------------------ @@ -707,7 +259,6 @@ package body Prj.Nmsc is Path_Name => Path_Name, Project => Project, Data => Data, - Error_If_Invalid => False, Location => No_Location, Current_Source => Current_Source); @@ -795,8 +346,7 @@ package body Prj.Nmsc is Name_Len := Path_Name'Length; Name_Buffer (1 .. Name_Len) := Path_Name.all; - -- We register the source. - -- We report an error if the file does not + -- Register the source. Report an error if the file does not -- correspond to a source. Record_Source @@ -804,7 +354,6 @@ package body Prj.Nmsc is Path_Name => Name_Find, Project => Project, Data => Data, - Error_If_Invalid => True, Location => Location, Current_Source => Current_Source); Found := True; @@ -819,13 +368,6 @@ package body Prj.Nmsc is end if; end loop; - if not Found then - Name_Len := File_Name'Length; - Name_Buffer (1 .. Name_Len) := File_Name; - Error_Msg_Name_1 := Name_Find; - Error_Msg - ("cannot find source {", Location); - end if; end Get_Path_Name_And_Record_Source; --------------------------- @@ -886,324 +428,46 @@ package body Prj.Nmsc is end if; end Get_Sources_From_File; - -- Start of processing for Check_Naming_Scheme + -- Start of processing for Ada_Check begin + Language_Independent_Check (Project, Report_Error); Error_Report := Report_Error; - if Current_Verbosity = High then - Write_Line ("Starting to look for directories"); - end if; - - -- Let's check the object directory - - declare - Object_Dir : Variable_Value := - Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); - - begin - pragma Assert (Object_Dir.Kind = Single, - "Object_Dir is not a single string"); - - -- We set the object directory to its default - - Data.Object_Directory := Data.Directory; - - if not String_Equal (Object_Dir.Value, Empty_String) then - - String_To_Name_Buffer (Object_Dir.Value); - - if Name_Len = 0 then - Error_Msg ("Object_Dir cannot be empty", - Object_Dir.Location); - - else - -- We check that the specified object directory - -- does exist. - - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - - declare - Dir_Id : constant Name_Id := Name_Find; - - begin - Data.Object_Directory := - Locate_Directory (Dir_Id, Data.Directory); - - if Data.Object_Directory = No_Name then - Error_Msg_Name_1 := Dir_Id; - Error_Msg - ("the object directory { cannot be found", - Data.Location); - end if; - end; - end if; - end if; - end; - - if Current_Verbosity = High then - if Data.Object_Directory = No_Name then - Write_Line ("No object directory"); - else - Write_Str ("Object directory: """); - Write_Str (Get_Name_String (Data.Object_Directory)); - Write_Line (""""); - end if; - end if; - - -- Let's check the source directories - - declare - Source_Dirs : Variable_Value := - Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes); - - begin - - if Current_Verbosity = High then - Write_Line ("Starting to look for source directories"); - end if; - - pragma Assert (Source_Dirs.Kind = List, - "Source_Dirs is not a list"); - - if Source_Dirs.Default then - - -- No Source_Dirs specified: the single source directory - -- is the one containing the project file - - String_Elements.Increment_Last; - Data.Source_Dirs := String_Elements.Last; - Start_String; - Store_String_Chars (Get_Name_String (Data.Directory)); - String_Elements.Table (Data.Source_Dirs) := - (Value => End_String, - Location => No_Location, - Next => Nil_String); - - if Current_Verbosity = High then - Write_Line ("(Undefined) Single object directory:"); - Write_Str (" """); - Write_Str (Get_Name_String (Data.Directory)); - Write_Line (""""); - end if; - - elsif Source_Dirs.Values = Nil_String then - - -- If Source_Dirs is an empty string list, this means - -- that this project contains no source. - - if Data.Object_Directory = Data.Directory then - Data.Object_Directory := No_Name; - end if; - - Data.Source_Dirs := Nil_String; - - else - declare - Source_Dir : String_List_Id := Source_Dirs.Values; - Element : String_Element; - - begin - -- We will find the source directories for each - -- element of the list - - while Source_Dir /= Nil_String loop - Element := String_Elements.Table (Source_Dir); - Find_Source_Dirs (Element.Value, Element.Location); - Source_Dir := Element.Next; - end loop; - end; - end if; + Data := Projects.Table (Project); + Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); - if Current_Verbosity = High then - Write_Line ("Puting source directories in canonical cases"); - end if; + Data.Naming.Current_Language := Name_Ada; + Data.Sources_Present := Data.Source_Dirs /= Nil_String; + if not Languages.Default then declare - Current : String_List_Id := Data.Source_Dirs; - Element : String_Element; + Current : String_List_Id := Languages.Values; + Element : String_Element; + Ada_Found : Boolean := False; begin - while Current /= Nil_String loop + Look_For_Ada : while Current /= Nil_String loop Element := String_Elements.Table (Current); - if Element.Value /= No_String then - String_To_Name_Buffer (Element.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Start_String; - Store_String_Chars (Name_Buffer (1 .. Name_Len)); - Element.Value := End_String; - String_Elements.Table (Current) := Element; - end if; - - Current := Element.Next; - end loop; - end; - end; - - -- Library Dir, Name, Version and Kind - - declare - Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; - - Lib_Dir : Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); - - Lib_Name : Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); - - Lib_Version : Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes); - - The_Lib_Kind : Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes); - - begin - pragma Assert (Lib_Dir.Kind = Single); - - if Lib_Dir.Value = Empty_String then - - if Current_Verbosity = High then - Write_Line ("No library directory"); - end if; + String_To_Name_Buffer (Element.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); - else - -- Find path name, check that it is a directory - - Stringt.String_To_Name_Buffer (Lib_Dir.Value); - - declare - Dir_Id : constant Name_Id := Name_Find; - - begin - Data.Library_Dir := - Locate_Directory (Dir_Id, Data.Directory); - - if Data.Library_Dir = No_Name then - Error_Msg ("not an existing directory", - Lib_Dir.Location); - - elsif Data.Library_Dir = Data.Object_Directory then - Error_Msg - ("library directory cannot be the same " & - "as object directory", - Lib_Dir.Location); - Data.Library_Dir := No_Name; - - else - if Current_Verbosity = High then - Write_Str ("Library directory ="""); - Write_Str (Get_Name_String (Data.Library_Dir)); - Write_Line (""""); - end if; - end if; - end; - end if; - - pragma Assert (Lib_Name.Kind = Single); - - if Lib_Name.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library name"); - end if; - - else - Stringt.String_To_Name_Buffer (Lib_Name.Value); - - if not Is_Letter (Name_Buffer (1)) then - Error_Msg ("must start with a letter", - Lib_Name.Location); - - else - Data.Library_Name := Name_Find; - - for Index in 2 .. Name_Len loop - if not Is_Alphanumeric (Name_Buffer (Index)) then - Data.Library_Name := No_Name; - Error_Msg ("only letters and digits are allowed", - Lib_Name.Location); - exit; - end if; - end loop; - - if Data.Library_Name /= No_Name - and then Current_Verbosity = High then - Write_Str ("Library name = """); - Write_Str (Get_Name_String (Data.Library_Name)); - Write_Line (""""); - end if; - end if; - end if; - - Data.Library := - Data.Library_Dir /= No_Name - and then - Data.Library_Name /= No_Name; - - if Data.Library then - if Current_Verbosity = High then - Write_Line ("This is a library project file"); - end if; - - pragma Assert (Lib_Version.Kind = Single); - - if Lib_Version.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library version specified"); + if Name_Buffer (1 .. Name_Len) = "ada" then + Ada_Found := True; + exit Look_For_Ada; end if; - else - Stringt.String_To_Name_Buffer (Lib_Version.Value); - Data.Lib_Internal_Name := Name_Find; - end if; - - pragma Assert (The_Lib_Kind.Kind = Single); - - if The_Lib_Kind.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library kind specified"); - end if; - - else - Stringt.String_To_Name_Buffer (The_Lib_Kind.Value); - - declare - Kind_Name : constant String := - Ada.Characters.Handling.To_Lower - (Name_Buffer (1 .. Name_Len)); - - OK : Boolean := True; + Current := Element.Next; + end loop Look_For_Ada; - begin - if Kind_Name = "static" then - Data.Library_Kind := Static; + if not Ada_Found then - elsif Kind_Name = "dynamic" then - Data.Library_Kind := Dynamic; - - elsif Kind_Name = "relocatable" then - Data.Library_Kind := Relocatable; + -- Mark the project file as having no sources for Ada - else - Error_Msg - ("illegal value for Library_Kind", - The_Lib_Kind.Location); - OK := False; - end if; - - if Current_Verbosity = High and then OK then - Write_Str ("Library kind = "); - Write_Line (Kind_Name); - end if; - end; + Data.Sources_Present := False; end if; - end if; - end; - - if Current_Verbosity = High then - Show_Source_Dirs (Project); + end; end if; declare @@ -1220,12 +484,13 @@ package body Prj.Nmsc is Naming := Packages.Table (Naming_Id); if Current_Verbosity = High then - Write_Line ("Checking ""Naming""."); + Write_Line ("Checking ""Naming"" for Ada."); end if; declare Bodies : constant Array_Element_Id := - Util.Value_Of (Name_Body_Part, Naming.Decl.Arrays); + Util.Value_Of + (Name_Implementation, Naming.Decl.Arrays); Specifications : constant Array_Element_Id := Util.Value_Of @@ -1270,10 +535,11 @@ package body Prj.Nmsc is -- We are now checking if variables Dot_Replacement, Casing, -- Specification_Append, Body_Append and/or Separate_Append -- exist. + -- For each variable, if it does not exist, we do nothing, -- because we already have the default. - -- Let's check Dot_Replacement + -- Check Dot_Replacement declare Dot_Replacement : constant Variable_Value := @@ -1318,7 +584,7 @@ package body Prj.Nmsc is begin pragma Assert (Casing_String.Kind = Single, - "Dot_Replacement is not a single string"); + "Casing is not a single string"); if not Casing_String.Default then declare @@ -1359,304 +625,514 @@ package body Prj.Nmsc is Write_Eol; end if; - -- Let's check Specification_Append + -- Check Specification_Suffix declare - Specification_Append : constant Variable_Value := - Util.Value_Of - (Name_Specification_Append, - Naming.Decl.Attributes); + Ada_Spec_Suffix : constant Name_Id := + Prj.Util.Value_Of + (Index => Name_Ada, + In_Array => Data.Naming.Specification_Suffix); begin - pragma Assert (Specification_Append.Kind = Single, - "Specification_Append is not a single string"); - - if not Specification_Append.Default then - String_To_Name_Buffer (Specification_Append.Value); - - if Name_Len = 0 then - Error_Msg ("Specification_Append cannot be empty", - Specification_Append.Location); + if Ada_Spec_Suffix /= No_Name then + Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix; - else - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Specification_Append := Name_Find; - Data.Naming.Spec_Append_Loc := - Specification_Append.Location; - end if; + else + Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix; end if; end; if Current_Verbosity = High then - Write_Str (" Specification_Append = """); - Write_Str (Get_Name_String (Data.Naming.Specification_Append)); - Write_Line ("""."); + Write_Str (" Specification_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix)); + Write_Char ('"'); + Write_Eol; end if; - -- Check Body_Append + -- Check Implementation_Suffix declare - Body_Append : constant Variable_Value := - Util.Value_Of - (Name_Body_Append, Naming.Decl.Attributes); + Ada_Impl_Suffix : constant Name_Id := + Prj.Util.Value_Of + (Index => Name_Ada, + In_Array => Data.Naming.Implementation_Suffix); begin - pragma Assert (Body_Append.Kind = Single, - "Body_Append is not a single string"); + if Ada_Impl_Suffix /= No_Name then + Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix; - if not Body_Append.Default then + else + Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix; + end if; + end; - String_To_Name_Buffer (Body_Append.Value); + if Current_Verbosity = High then + Write_Str (" Implementation_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Current_Impl_Suffix)); + Write_Char ('"'); + Write_Eol; + end if; - if Name_Len = 0 then - Error_Msg ("Body_Append cannot be empty", - Body_Append.Location); + -- Check Separate_Suffix - else - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Body_Append := Name_Find; - Data.Naming.Body_Append_Loc := Body_Append.Location; + declare + Ada_Sep_Suffix : constant Variable_Value := + Prj.Util.Value_Of + (Variable_Name => Name_Separate_Suffix, + In_Variables => Naming.Decl.Attributes); + begin + if Ada_Sep_Suffix.Default then + Data.Naming.Separate_Suffix := + Data.Naming.Current_Impl_Suffix; - -- As we have a new Body_Append, we set Separate_Append - -- to the same value. + else + String_To_Name_Buffer (Ada_Sep_Suffix.Value); + + if Name_Len = 0 then + Error_Msg ("Separate_Suffix cannot be empty", + Ada_Sep_Suffix.Location); - Data.Naming.Separate_Append := Data.Naming.Body_Append; - Data.Naming.Sep_Append_Loc := Data.Naming.Body_Append_Loc; + else + Data.Naming.Separate_Suffix := Name_Find; + Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location; end if; + end if; + end; if Current_Verbosity = High then - Write_Str (" Body_Append = """); - Write_Str (Get_Name_String (Data.Naming.Body_Append)); - Write_Line ("""."); + Write_Str (" Separate_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Separate_Suffix)); + Write_Char ('"'); + Write_Eol; end if; - -- Check Separate_Append + -- Check if Data.Naming is valid + + Check_Ada_Naming_Scheme (Data.Naming); + else + Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix; + Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix; + Data.Naming.Separate_Suffix := Ada_Default_Impl_Suffix; + end if; + end; + + -- If we have source directories, then find the sources + + if Data.Sources_Present then + if Data.Source_Dirs = Nil_String then + Data.Sources_Present := False; + + else declare - Separate_Append : constant Variable_Value := - Util.Value_Of - (Name_Separate_Append, - Naming.Decl.Attributes); + Sources : constant Variable_Value := + Util.Value_Of + (Name_Source_Files, + Data.Decl.Attributes); + + Source_List_File : constant Variable_Value := + Util.Value_Of + (Name_Source_List_File, + Data.Decl.Attributes); begin - pragma Assert (Separate_Append.Kind = Single, - "Separate_Append is not a single string"); + pragma Assert + (Sources.Kind = List, + "Source_Files is not a list"); + pragma Assert + (Source_List_File.Kind = Single, + "Source_List_File is not a single string"); + + if not Sources.Default then + if not Source_List_File.Default then + Error_Msg + ("?both variables source_files and " & + "source_list_file are present", + Source_List_File.Location); + end if; - if not Separate_Append.Default then - String_To_Name_Buffer (Separate_Append.Value); + -- Sources is a list of file names - if Name_Len = 0 then - Error_Msg ("Separate_Append cannot be empty", - Separate_Append.Location); + declare + Current_Source : String_List_Id := Nil_String; + Current : String_List_Id := Sources.Values; + Element : String_Element; - else - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Separate_Append := Name_Find; - Data.Naming.Sep_Append_Loc := Separate_Append.Location; - end if; + begin + Data.Sources_Present := Current /= Nil_String; + + while Current /= Nil_String loop + Element := String_Elements.Table (Current); + String_To_Name_Buffer (Element.Value); + + declare + File_Name : constant String := + Name_Buffer (1 .. Name_Len); + + begin + Get_Path_Name_And_Record_Source + (File_Name => File_Name, + Location => Element.Location, + Current_Source => Current_Source); + Current := Element.Next; + end; + end loop; + end; + + -- No source_files specified. + -- We check Source_List_File has been specified. + + elsif not Source_List_File.Default then + + -- Source_List_File is the name of the file + -- that contains the source file names + + declare + Source_File_Path_Name : constant String := + Path_Name_Of + (Source_List_File.Value, + Data.Directory); + + begin + if Source_File_Path_Name'Length = 0 then + String_To_Name_Buffer (Source_List_File.Value); + Error_Msg_Name_1 := Name_Find; + Error_Msg + ("file with sources { does not exist", + Source_List_File.Location); + + else + Get_Sources_From_File + (Source_File_Path_Name, + Source_List_File.Location); + end if; + end; + + else + -- Neither Source_Files nor Source_List_File has been + -- specified. + -- Find all the files that satisfy + -- the naming scheme in all the source directories. + + Find_Sources; end if; end; + end if; + end if; + + Projects.Table (Project) := Data; + end Ada_Check; + + -------------------- + -- Check_Ada_Name -- + -------------------- + + procedure Check_Ada_Name + (Name : Name_Id; + Unit : out Name_Id) + is + The_Name : String := Get_Name_String (Name); + Need_Letter : Boolean := True; + Last_Underscore : Boolean := False; + OK : Boolean := The_Name'Length > 0; + + begin + for Index in The_Name'Range loop + if Need_Letter then + + -- We need a letter (at the beginning, and following a dot), + -- but we don't have one. + + if Is_Letter (The_Name (Index)) then + Need_Letter := False; + + else + OK := False; + + if Current_Verbosity = High then + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is not a letter."); + end if; + + exit; + end if; + + elsif Last_Underscore + and then (The_Name (Index) = '_' or else The_Name (Index) = '.') + then + -- Two underscores are illegal, and a dot cannot follow + -- an underscore. + + OK := False; if Current_Verbosity = High then - Write_Str (" Separate_Append = """); - Write_Str (Get_Name_String (Data.Naming.Separate_Append)); - Write_Line ("""."); - Write_Line ("end Naming."); + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is illegal here."); end if; - -- Now, we check if Data.Naming is valid + exit; - Check_Naming_Scheme (Data.Naming); - end if; - end; + elsif The_Name (Index) = '.' then - -- If we have source directories, then let's find the sources. + -- We need a letter after a dot - if Data.Source_Dirs /= Nil_String then - declare - Sources : constant Variable_Value := - Util.Value_Of - (Name_Source_Files, - Data.Decl.Attributes); + Need_Letter := True; - Source_List_File : constant Variable_Value := - Util.Value_Of - (Name_Source_List_File, - Data.Decl.Attributes); + elsif The_Name (Index) = '_' then + Last_Underscore := True; - begin - pragma Assert - (Sources.Kind = List, - "Source_Files is not a list"); - pragma Assert - (Source_List_File.Kind = Single, - "Source_List_File is not a single string"); - - if not Sources.Default then - if not Source_List_File.Default then - Error_Msg - ("?both variables source_files and " & - "source_list_file are present", - Source_List_File.Location); + else + -- We need an letter or a digit + + Last_Underscore := False; + + if not Is_Alphanumeric (The_Name (Index)) then + OK := False; + + if Current_Verbosity = High then + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is not alphanumeric."); end if; - -- Sources is a list of file names + exit; + end if; + end if; + end loop; - declare - Current_Source : String_List_Id := Nil_String; - Current : String_List_Id := Sources.Values; - Element : String_Element; + -- Cannot end with an underscore or a dot - begin - while Current /= Nil_String loop - Element := String_Elements.Table (Current); - String_To_Name_Buffer (Element.Value); + OK := OK and then not Need_Letter and then not Last_Underscore; - declare - File_Name : constant String := - Name_Buffer (1 .. Name_Len); + if OK then + Unit := Name; + else + -- Signal a problem with No_Name - begin - Get_Path_Name_And_Record_Source - (File_Name => File_Name, - Location => Element.Location, - Current_Source => Current_Source); - Current := Element.Next; - end; - end loop; - end; + Unit := No_Name; + end if; + end Check_Ada_Name; + + ------------------------- + -- Check_Naming_Scheme -- + ------------------------- - -- No source_files specified. - -- We check Source_List_File has been specified. + procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is + begin + -- Only check if we are not using the standard naming scheme - elsif not Source_List_File.Default then + if Naming /= Standard_Naming_Data then + declare + Dot_Replacement : constant String := + Get_Name_String + (Naming.Dot_Replacement); - -- Source_List_File is the name of the file - -- that contains the source file names + Specification_Suffix : constant String := + Get_Name_String + (Naming.Current_Spec_Suffix); - declare - Source_File_Path_Name : constant String := - Path_Name_Of - (Source_List_File.Value, - Data.Directory); + Implementation_Suffix : constant String := + Get_Name_String + (Naming.Current_Impl_Suffix); - begin - if Source_File_Path_Name'Length = 0 then - String_To_Name_Buffer (Source_List_File.Value); - Error_Msg_Name_1 := Name_Find; - Error_Msg - ("file with sources { does not exist", - Source_List_File.Location); + Separate_Suffix : constant String := + Get_Name_String + (Naming.Separate_Suffix); - else - Get_Sources_From_File - (Source_File_Path_Name, - Source_List_File.Location); - end if; - end; + begin + -- Dot_Replacement cannot + -- - be empty + -- - start or end with an alphanumeric + -- - be a single '_' + -- - start with an '_' followed by an alphanumeric + -- - contain a '.' except if it is "." - else - -- Neither Source_Files nor Source_List_File has been - -- specified. - -- Find all the files that satisfy - -- the naming scheme in all the source directories. + if Dot_Replacement'Length = 0 + or else Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'First)) + or else Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'Last)) + or else (Dot_Replacement (Dot_Replacement'First) = '_' + and then + (Dot_Replacement'Length = 1 + or else + Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'First + 1)))) + or else (Dot_Replacement'Length > 1 + and then + Index (Source => Dot_Replacement, + Pattern => ".") /= 0) + then + Error_Msg + ('"' & Dot_Replacement & + """ is illegal for Dot_Replacement.", + Naming.Dot_Repl_Loc); + end if; + + -- Suffixs cannot + -- - be empty + -- - start with an alphanumeric + -- - start with an '_' followed by an alphanumeric + + if Is_Illegal_Append (Specification_Suffix) then + Error_Msg + ('"' & Specification_Suffix & + """ is illegal for Specification_Suffix.", + Naming.Spec_Suffix_Loc); + end if; + + if Is_Illegal_Append (Implementation_Suffix) then + Error_Msg + ('"' & Implementation_Suffix & + """ is illegal for Implementation_Suffix.", + Naming.Impl_Suffix_Loc); + end if; - Find_Sources; + if Implementation_Suffix /= Separate_Suffix then + if Is_Illegal_Append (Separate_Suffix) then + Error_Msg + ('"' & Separate_Suffix & + """ is illegal for Separate_Append.", + Naming.Sep_Suffix_Loc); + end if; + end if; + + -- Specification_Suffix cannot have the same termination as + -- Implementation_Suffix or Separate_Suffix + + if Specification_Suffix'Length <= Implementation_Suffix'Length + and then + Implementation_Suffix (Implementation_Suffix'Last - + Specification_Suffix'Length + 1 .. + Implementation_Suffix'Last) = Specification_Suffix + then + Error_Msg + ("Implementation_Suffix (""" & + Implementation_Suffix & + """) cannot end with" & + "Specification_Suffix (""" & + Specification_Suffix & """).", + Naming.Impl_Suffix_Loc); + end if; + + if Specification_Suffix'Length <= Separate_Suffix'Length + and then + Separate_Suffix + (Separate_Suffix'Last - Specification_Suffix'Length + 1 + .. + Separate_Suffix'Last) = Specification_Suffix + then + Error_Msg + ("Separate_Suffix (""" & + Separate_Suffix & + """) cannot end with" & + " Specification_Suffix (""" & + Specification_Suffix & """).", + Naming.Sep_Suffix_Loc); end if; end; end if; - - Projects.Table (Project) := Data; - end Check_Naming_Scheme; + end Check_Ada_Naming_Scheme; --------------- -- Error_Msg -- --------------- procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is + + Error_Buffer : String (1 .. 5_000); + Error_Last : Natural := 0; + Msg_Name : Natural := 0; + First : Positive := Msg'First; + + procedure Add (C : Character); + -- Add a character to the buffer + + procedure Add (S : String); + -- Add a string to the buffer + + procedure Add (Id : Name_Id); + -- Add a name to the buffer + + --------- + -- Add -- + --------- + + procedure Add (C : Character) is + begin + Error_Last := Error_Last + 1; + Error_Buffer (Error_Last) := C; + end Add; + + procedure Add (S : String) is + begin + Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S; + Error_Last := Error_Last + S'Length; + end Add; + + procedure Add (Id : Name_Id) is + begin + Get_Name_String (Id); + Add (Name_Buffer (1 .. Name_Len)); + end Add; + + -- Start of processing for Error_Msg + begin if Error_Report = null then Errout.Error_Msg (Msg, Flag_Location); + return; + end if; - else - declare - Error_Buffer : String (1 .. 5_000); - Error_Last : Natural := 0; - Msg_Name : Natural := 0; - First : Positive := Msg'First; + if Msg (First) = '\' then - procedure Add (C : Character); - -- Add a character to the buffer + -- Continuation character, ignore. - procedure Add (S : String); - -- Add a string to the buffer + First := First + 1; - procedure Add (Id : Name_Id); - -- Add a name to the buffer + elsif Msg (First) = '?' then - --------- - -- Add -- - --------- + -- Warning character. It is always the first one, + -- in this package. - procedure Add (C : Character) is - begin - Error_Last := Error_Last + 1; - Error_Buffer (Error_Last) := C; - end Add; - - procedure Add (S : String) is - begin - Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S; - Error_Last := Error_Last + S'Length; - end Add; + First := First + 1; + Add ("Warning: "); + end if; - procedure Add (Id : Name_Id) is - begin - Get_Name_String (Id); - Add (Name_Buffer (1 .. Name_Len)); - end Add; + for Index in First .. Msg'Last loop + if Msg (Index) = '{' or else Msg (Index) = '%' then - begin - if Msg (First) = '\' then - -- Continuation character, ignore. - First := First + 1; - - elsif Msg (First) = '?' then - -- Warning character. It is always the first one, - -- in this package. - First := First + 1; - Add ("Warning: "); - end if; + -- Include a name between double quotes. - for Index in First .. Msg'Last loop - if Msg (Index) = '{' or else Msg (Index) = '%' then - -- Include a name between double quotes. - Msg_Name := Msg_Name + 1; - Add ('"'); + Msg_Name := Msg_Name + 1; + Add ('"'); - case Msg_Name is - when 1 => Add (Error_Msg_Name_1); + case Msg_Name is + when 1 => Add (Error_Msg_Name_1); - when 2 => Add (Error_Msg_Name_2); + when 2 => Add (Error_Msg_Name_2); - when 3 => Add (Error_Msg_Name_3); + when 3 => Add (Error_Msg_Name_3); - when others => null; - end case; + when others => null; + end case; - Add ('"'); + Add ('"'); - else - Add (Msg (Index)); - end if; + else + Add (Msg (Index)); + end if; - end loop; + end loop; - Error_Report (Error_Buffer (1 .. Error_Last)); - end; - end if; + Error_Report (Error_Buffer (1 .. Error_Last)); end Error_Msg; --------------------- @@ -1770,7 +1246,7 @@ package body Prj.Nmsc is begin -- Check if the end of the file name is Specification_Append - Get_Name_String (Naming.Specification_Append); + Get_Name_String (Naming.Current_Spec_Suffix); if File'Length > Name_Len and then File (Last - Name_Len + 1 .. Last) = @@ -1787,7 +1263,7 @@ package body Prj.Nmsc is end if; else - Get_Name_String (Naming.Body_Append); + Get_Name_String (Naming.Current_Impl_Suffix); -- Check if the end of the file name is Body_Append @@ -1805,8 +1281,8 @@ package body Prj.Nmsc is Write_Line (File (First .. Last)); end if; - elsif Naming.Separate_Append /= Naming.Body_Append then - Get_Name_String (Naming.Separate_Append); + elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then + Get_Name_String (Naming.Separate_Suffix); -- Check if the end of the file name is Separate_Append @@ -1939,7 +1415,7 @@ package body Prj.Nmsc is -- Now, we check if this name is a valid unit name - Check_Naming_Scheme (Name => Name_Find, Unit => Unit_Name); + Check_Ada_Name (Name => Name_Find, Unit => Unit_Name); end; end; @@ -1959,6 +1435,658 @@ package body Prj.Nmsc is and then Is_Alphanumeric (This (This'First + 1))); end Is_Illegal_Append; + -------------------------------- + -- Language_Independent_Check -- + -------------------------------- + + procedure Language_Independent_Check + (Project : Project_Id; + Report_Error : Put_Line_Access) + is + Last_Source_Dir : String_List_Id := Nil_String; + Data : Project_Data := Projects.Table (Project); + + procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr); + -- Find one or several source directories, and add them + -- to the list of source directories of the project. + + ---------------------- + -- Find_Source_Dirs -- + ---------------------- + + procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is + + Directory : String (1 .. Integer (String_Length (From))); + Directory_Id : Name_Id; + Element : String_Element; + + procedure Recursive_Find_Dirs (Path : String_Id); + -- Find all the subdirectories (recursively) of Path + -- and add them to the list of source directories + -- of the project. + + ------------------------- + -- Recursive_Find_Dirs -- + ------------------------- + + procedure Recursive_Find_Dirs (Path : String_Id) is + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + The_Path : String := Get_Name_String (Path) & Dir_Sep; + + The_Path_Last : Positive := The_Path'Last; + + begin + if The_Path'Length > 1 + and then + (The_Path (The_Path_Last - 1) = Dir_Sep + or else The_Path (The_Path_Last - 1) = '/') + then + The_Path_Last := The_Path_Last - 1; + end if; + + if Current_Verbosity = High then + Write_Str (" "); + Write_Line (The_Path (The_Path'First .. The_Path_Last)); + end if; + + String_Elements.Increment_Last; + Element := + (Value => Path, + Location => No_Location, + Next => Nil_String); + + -- Case of first source directory + + if Last_Source_Dir = Nil_String then + Data.Source_Dirs := String_Elements.Last; + + -- Here we already have source directories. + + else + -- Link the previous last to the new one + + String_Elements.Table (Last_Source_Dir).Next := + String_Elements.Last; + end if; + + -- And register this source directory as the new last + + Last_Source_Dir := String_Elements.Last; + String_Elements.Table (Last_Source_Dir) := Element; + + -- Now look for subdirectories + + Open (Dir, The_Path (The_Path'First .. The_Path_Last)); + + loop + Read (Dir, Name, Last); + exit when Last = 0; + + if Current_Verbosity = High then + Write_Str (" Checking "); + Write_Line (Name (1 .. Last)); + end if; + + if Name (1 .. Last) /= "." + and then Name (1 .. Last) /= ".." + then + -- Avoid . and .. + + declare + Path_Name : constant String := + The_Path (The_Path'First .. The_Path_Last) & + Name (1 .. Last); + + begin + if Is_Directory (Path_Name) then + + -- We have found a new subdirectory, + -- register it and find its own subdirectories. + + Start_String; + Store_String_Chars (Path_Name); + Recursive_Find_Dirs (End_String); + end if; + end; + end if; + end loop; + + Close (Dir); + + exception + when Directory_Error => + null; + end Recursive_Find_Dirs; + + -- Start of processing for Find_Source_Dirs + + begin + if Current_Verbosity = High then + Write_Str ("Find_Source_Dirs ("""); + end if; + + String_To_Name_Buffer (From); + Directory := Name_Buffer (1 .. Name_Len); + Directory_Id := Name_Find; + + if Current_Verbosity = High then + Write_Str (Directory); + Write_Line (""")"); + end if; + + -- First, check if we are looking for a directory tree, + -- indicated by "/**" at the end. + + if Directory'Length >= 3 + and then Directory (Directory'Last - 1 .. Directory'Last) = "**" + and then (Directory (Directory'Last - 2) = '/' + or else + Directory (Directory'Last - 2) = Dir_Sep) + then + Name_Len := Directory'Length - 3; + + if Name_Len = 0 then + -- This is the case of "/**": all directories + -- in the file system. + + Name_Len := 1; + Name_Buffer (1) := Directory (Directory'First); + + else + Name_Buffer (1 .. Name_Len) := + Directory (Directory'First .. Directory'Last - 3); + end if; + + if Current_Verbosity = High then + Write_Str ("Looking for all subdirectories of """); + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Line (""""); + end if; + + declare + Base_Dir : constant Name_Id := Name_Find; + Root : constant Name_Id := + Locate_Directory (Base_Dir, Data.Directory); + + begin + if Root = No_Name then + Error_Msg_Name_1 := Base_Dir; + if Location = No_Location then + Error_Msg ("{ is not a valid directory.", Data.Location); + else + Error_Msg ("{ is not a valid directory.", Location); + end if; + + else + -- We have an existing directory, + -- we register it and all of its subdirectories. + + if Current_Verbosity = High then + Write_Line ("Looking for source directories:"); + end if; + + Start_String; + Store_String_Chars (Get_Name_String (Root)); + Recursive_Find_Dirs (End_String); + + if Current_Verbosity = High then + Write_Line ("End of looking for source directories."); + end if; + end if; + end; + + -- We have a single directory + + else + declare + Path_Name : constant Name_Id := + Locate_Directory (Directory_Id, Data.Directory); + + begin + if Path_Name = No_Name then + Error_Msg_Name_1 := Directory_Id; + if Location = No_Location then + Error_Msg ("{ is not a valid directory", Data.Location); + else + Error_Msg ("{ is not a valid directory", Location); + end if; + else + + -- As it is an existing directory, we add it to + -- the list of directories. + + String_Elements.Increment_Last; + Start_String; + Store_String_Chars (Get_Name_String (Path_Name)); + Element.Value := End_String; + + if Last_Source_Dir = Nil_String then + + -- This is the first source directory + + Data.Source_Dirs := String_Elements.Last; + + else + -- We already have source directories, + -- link the previous last to the new one. + + String_Elements.Table (Last_Source_Dir).Next := + String_Elements.Last; + end if; + + -- And register this source directory as the new last + + Last_Source_Dir := String_Elements.Last; + String_Elements.Table (Last_Source_Dir) := Element; + end if; + end; + end if; + end Find_Source_Dirs; + + -- Start of processing for Language_Independent_Check + + begin + + if Data.Language_Independent_Checked then + return; + end if; + + Data.Language_Independent_Checked := True; + + Error_Report := Report_Error; + + if Current_Verbosity = High then + Write_Line ("Starting to look for directories"); + end if; + + -- Let's check the object directory + + declare + Object_Dir : Variable_Value := + Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); + + begin + pragma Assert (Object_Dir.Kind = Single, + "Object_Dir is not a single string"); + + -- We set the object directory to its default + + Data.Object_Directory := Data.Directory; + + if not String_Equal (Object_Dir.Value, Empty_String) then + + String_To_Name_Buffer (Object_Dir.Value); + + if Name_Len = 0 then + Error_Msg ("Object_Dir cannot be empty", + Object_Dir.Location); + + else + -- We check that the specified object directory + -- does exist. + + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + + declare + Dir_Id : constant Name_Id := Name_Find; + + begin + Data.Object_Directory := + Locate_Directory (Dir_Id, Data.Directory); + + if Data.Object_Directory = No_Name then + Error_Msg_Name_1 := Dir_Id; + Error_Msg + ("the object directory { cannot be found", + Data.Location); + end if; + end; + end if; + end if; + end; + + if Current_Verbosity = High then + if Data.Object_Directory = No_Name then + Write_Line ("No object directory"); + else + Write_Str ("Object directory: """); + Write_Str (Get_Name_String (Data.Object_Directory)); + Write_Line (""""); + end if; + end if; + + -- Look for the source directories + + declare + Source_Dirs : Variable_Value := + Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes); + + begin + + if Current_Verbosity = High then + Write_Line ("Starting to look for source directories"); + end if; + + pragma Assert (Source_Dirs.Kind = List, + "Source_Dirs is not a list"); + + if Source_Dirs.Default then + + -- No Source_Dirs specified: the single source directory + -- is the one containing the project file + + String_Elements.Increment_Last; + Data.Source_Dirs := String_Elements.Last; + Start_String; + Store_String_Chars (Get_Name_String (Data.Directory)); + String_Elements.Table (Data.Source_Dirs) := + (Value => End_String, + Location => No_Location, + Next => Nil_String); + + if Current_Verbosity = High then + Write_Line ("(Undefined) Single object directory:"); + Write_Str (" """); + Write_Str (Get_Name_String (Data.Directory)); + Write_Line (""""); + end if; + + elsif Source_Dirs.Values = Nil_String then + + -- If Source_Dirs is an empty string list, this means + -- that this project contains no source. + + if Data.Object_Directory = Data.Directory then + Data.Object_Directory := No_Name; + end if; + + Data.Source_Dirs := Nil_String; + Data.Sources_Present := False; + + else + declare + Source_Dir : String_List_Id := Source_Dirs.Values; + Element : String_Element; + + begin + -- We will find the source directories for each + -- element of the list + + while Source_Dir /= Nil_String loop + Element := String_Elements.Table (Source_Dir); + Find_Source_Dirs (Element.Value, Element.Location); + Source_Dir := Element.Next; + end loop; + end; + end if; + + if Current_Verbosity = High then + Write_Line ("Puting source directories in canonical cases"); + end if; + + declare + Current : String_List_Id := Data.Source_Dirs; + Element : String_Element; + + begin + while Current /= Nil_String loop + Element := String_Elements.Table (Current); + if Element.Value /= No_String then + String_To_Name_Buffer (Element.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Start_String; + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + Element.Value := End_String; + String_Elements.Table (Current) := Element; + end if; + + Current := Element.Next; + end loop; + end; + end; + + -- Library Dir, Name, Version and Kind + + declare + Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; + + Lib_Dir : Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); + + Lib_Name : Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); + + Lib_Version : Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Version, Attributes); + + The_Lib_Kind : Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Kind, Attributes); + + begin + pragma Assert (Lib_Dir.Kind = Single); + + if Lib_Dir.Value = Empty_String then + + if Current_Verbosity = High then + Write_Line ("No library directory"); + end if; + + else + -- Find path name, check that it is a directory + + Stringt.String_To_Name_Buffer (Lib_Dir.Value); + + declare + Dir_Id : constant Name_Id := Name_Find; + + begin + Data.Library_Dir := + Locate_Directory (Dir_Id, Data.Directory); + + if Data.Library_Dir = No_Name then + Error_Msg ("not an existing directory", + Lib_Dir.Location); + + elsif Data.Library_Dir = Data.Object_Directory then + Error_Msg + ("library directory cannot be the same " & + "as object directory", + Lib_Dir.Location); + Data.Library_Dir := No_Name; + + else + if Current_Verbosity = High then + Write_Str ("Library directory ="""); + Write_Str (Get_Name_String (Data.Library_Dir)); + Write_Line (""""); + end if; + end if; + end; + end if; + + pragma Assert (Lib_Name.Kind = Single); + + if Lib_Name.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library name"); + end if; + + else + Stringt.String_To_Name_Buffer (Lib_Name.Value); + + if not Is_Letter (Name_Buffer (1)) then + Error_Msg ("must start with a letter", + Lib_Name.Location); + + else + Data.Library_Name := Name_Find; + + for Index in 2 .. Name_Len loop + if not Is_Alphanumeric (Name_Buffer (Index)) then + Data.Library_Name := No_Name; + Error_Msg ("only letters and digits are allowed", + Lib_Name.Location); + exit; + end if; + end loop; + + if Data.Library_Name /= No_Name + and then Current_Verbosity = High then + Write_Str ("Library name = """); + Write_Str (Get_Name_String (Data.Library_Name)); + Write_Line (""""); + end if; + end if; + end if; + + Data.Library := + Data.Library_Dir /= No_Name + and then + Data.Library_Name /= No_Name; + + if Data.Library then + if Current_Verbosity = High then + Write_Line ("This is a library project file"); + end if; + + pragma Assert (Lib_Version.Kind = Single); + + if Lib_Version.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library version specified"); + end if; + + else + Stringt.String_To_Name_Buffer (Lib_Version.Value); + Data.Lib_Internal_Name := Name_Find; + end if; + + pragma Assert (The_Lib_Kind.Kind = Single); + + if The_Lib_Kind.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library kind specified"); + end if; + + else + Stringt.String_To_Name_Buffer (The_Lib_Kind.Value); + + declare + Kind_Name : constant String := + To_Lower (Name_Buffer (1 .. Name_Len)); + + OK : Boolean := True; + + begin + + if Kind_Name = "static" then + Data.Library_Kind := Static; + + elsif Kind_Name = "dynamic" then + Data.Library_Kind := Dynamic; + + elsif Kind_Name = "relocatable" then + Data.Library_Kind := Relocatable; + + else + Error_Msg + ("illegal value for Library_Kind", + The_Lib_Kind.Location); + OK := False; + end if; + + if Current_Verbosity = High and then OK then + Write_Str ("Library kind = "); + Write_Line (Kind_Name); + end if; + end; + end if; + end if; + end; + + if Current_Verbosity = High then + Show_Source_Dirs (Project); + end if; + + declare + Naming_Id : constant Package_Id := + Util.Value_Of (Name_Naming, Data.Decl.Packages); + + Naming : Package_Element; + + begin + -- If there is a package Naming, we will put in Data.Naming + -- what is in this package Naming. + + if Naming_Id /= No_Package then + Naming := Packages.Table (Naming_Id); + + if Current_Verbosity = High then + Write_Line ("Checking ""Naming""."); + end if; + + -- Check Specification_Suffix + + Data.Naming.Specification_Suffix := Util.Value_Of + (Name_Specification_Suffix, + Naming.Decl.Arrays); + + declare + Current : Array_Element_Id := Data.Naming.Specification_Suffix; + Element : Array_Element; + + begin + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); + String_To_Name_Buffer (Element.Value.Value); + + if Name_Len = 0 then + Error_Msg + ("Specification_Suffix cannot be empty", + Element.Value.Location); + end if; + + Array_Elements.Table (Current) := Element; + Current := Element.Next; + end loop; + end; + + -- Check Implementation_Suffix + + Data.Naming.Implementation_Suffix := Util.Value_Of + (Name_Implementation_Suffix, + Naming.Decl.Arrays); + + declare + Current : Array_Element_Id := Data.Naming.Implementation_Suffix; + Element : Array_Element; + + begin + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); + String_To_Name_Buffer (Element.Value.Value); + + if Name_Len = 0 then + Error_Msg + ("Implementation_Suffix cannot be empty", + Element.Value.Location); + end if; + + Array_Elements.Table (Current) := Element; + Current := Element.Next; + end loop; + end; + + end if; + end; + + Projects.Table (Project) := Data; + end Language_Independent_Check; + ---------------------- -- Locate_Directory -- ---------------------- @@ -1966,7 +2094,7 @@ package body Prj.Nmsc is function Locate_Directory (Name : Name_Id; Parent : Name_Id) - return Name_Id + return Name_Id is The_Name : constant String := Get_Name_String (Name); The_Parent : constant String := @@ -2049,7 +2177,7 @@ package body Prj.Nmsc is function Path_Name_Of (File_Name : String_Id; Directory : Name_Id) - return String + return String is Result : String_Access; The_Directory : constant String := Get_Name_String (Directory); @@ -2077,7 +2205,6 @@ package body Prj.Nmsc is Path_Name : Name_Id; Project : Project_Id; Data : in out Project_Data; - Error_If_Invalid : Boolean; Location : Source_Ptr; Current_Source : in out String_List_Id) is @@ -2101,18 +2228,10 @@ package body Prj.Nmsc is -- Error_If_Invalid is true. if Unit_Name = No_Name then - if Error_If_Invalid then - Error_Msg_Name_1 := File_Name; - Error_Msg - ("{ is not a valid source file name", - Location); - - else - if Current_Verbosity = High then - Write_Str (" """); - Write_Str (Get_Name_String (File_Name)); - Write_Line (""" is not a valid source file name (ignored)."); - end if; + if Current_Verbosity = High then + Write_Str (" """); + Write_Str (Get_Name_String (File_Name)); + Write_Line (""" is not a valid source file name (ignored)."); end if; else diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index 5fcc00538da..9a3e14915b7 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.3 $ +-- $Revision$ -- -- -- Copyright (C) 2000-2001 Free Software Foundation, Inc. -- -- -- @@ -31,12 +31,21 @@ private package Prj.Nmsc is - procedure Check_Naming_Scheme + procedure Ada_Check (Project : Project_Id; Report_Error : Put_Line_Access); - -- Check that the Naming Scheme of a project is legal. Find the - -- object directory, the source directories, and the source files. - -- Check the source files against the Naming Scheme. + -- Call Language_Independent_Check. + -- Check the naming scheme for Ada. + -- Find the Ada source files if any. + -- If Report_Error is null , use the standard error reporting mechanism + -- (Errout). Otherwise, report errors using Report_Error. + + procedure Language_Independent_Check + (Project : Project_Id; + Report_Error : Put_Line_Access); + -- Check the object directory and the source directories. + -- Check the library attributes, including the library directory if any. + -- Get the set of specification and implementation suffixs, if any. -- If Report_Error is null , use the standard error reporting mechanism -- (Errout). Otherwise, report errors using Report_Error. diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 4822596f964..eece34c9f6a 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.16 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -27,6 +27,7 @@ ------------------------------------------------------------------------------ with Errout; use Errout; +with GNAT.Case_Util; with Namet; use Namet; with Opt; with Output; use Output; @@ -1015,6 +1016,10 @@ package body Prj.Proc is String_To_Name_Buffer (Associative_Array_Index_Of (Current_Item)); + if Case_Insensitive (Current_Item) then + GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len)); + end if; + declare The_Array : Array_Id; @@ -1260,7 +1265,7 @@ package body Prj.Proc is Write_Line (""""); end if; - Prj.Nmsc.Check_Naming_Scheme (Project, Error_Report); + Prj.Nmsc.Ada_Check (Project, Error_Report); end if; end Recursive_Check; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 322e4aae39f..9f0df4851fd 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.7 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -48,6 +48,19 @@ package body Prj.Tree is return Project_Nodes.Table (Node).Value; end Associative_Array_Index_Of; + ---------------------- + -- Case_Insensitive -- + ---------------------- + + function Case_Insensitive (Node : Project_Node_Id) return Boolean is + begin + pragma Assert + (Node /= Empty_Node + and then + (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); + return Project_Nodes.Table (Node).Case_Insensitive; + end Case_Insensitive; + -------------------------------- -- Case_Variable_Reference_Of -- -------------------------------- @@ -108,19 +121,20 @@ package body Prj.Tree is begin Project_Nodes.Increment_Last; Project_Nodes.Table (Project_Nodes.Last) := - (Kind => Of_Kind, - Location => No_Location, - Directory => No_Name, - Expr_Kind => And_Expr_Kind, - Variables => Empty_Node, - Packages => Empty_Node, - Pkg_Id => Empty_Package, - Name => No_Name, - Path_Name => No_Name, - Value => No_String, - Field1 => Empty_Node, - Field2 => Empty_Node, - Field3 => Empty_Node); + (Kind => Of_Kind, + Location => No_Location, + Directory => No_Name, + Expr_Kind => And_Expr_Kind, + Variables => Empty_Node, + Packages => Empty_Node, + Pkg_Id => Empty_Package, + Name => No_Name, + Path_Name => No_Name, + Value => No_String, + Field1 => Empty_Node, + Field2 => Empty_Node, + Field3 => Empty_Node, + Case_Insensitive => False); return Project_Nodes.Last; end Default_Project_Node; @@ -723,6 +737,22 @@ package body Prj.Tree is Project_Nodes.Table (Node).Value := To; end Set_Associative_Array_Index_Of; + -------------------------- + -- Set_Case_Insensitive -- + -------------------------- + + procedure Set_Case_Insensitive + (Node : Project_Node_Id; + To : Boolean) + is + begin + pragma Assert + (Node /= Empty_Node + and then + Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); + Project_Nodes.Table (Node).Case_Insensitive := To; + end Set_Case_Insensitive; + ------------------------------------ -- Set_Case_Variable_Reference_Of -- ------------------------------------ diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index d32fcb19808..6cc7c6b99d8 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.9 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -306,6 +306,9 @@ package Prj.Tree is return Project_Node_Id; -- Only valid for N_Case_Item nodes + function Case_Insensitive (Node : Project_Node_Id) return Boolean; + -- Only valid for N_Attribute_Declaration nodes + -------------------- -- Set Procedures -- -------------------- @@ -480,6 +483,10 @@ package Prj.Tree is (Node : Project_Node_Id; To : Project_Node_Id); + procedure Set_Case_Insensitive + (Node : Project_Node_Id; + To : Boolean); + ------------------------------- -- Restricted Access Section -- ------------------------------- @@ -491,43 +498,47 @@ package Prj.Tree is type Project_Node_Record is record - Kind : Project_Node_Kind; + Kind : Project_Node_Kind; - Location : Source_Ptr := No_Location; + Location : Source_Ptr := No_Location; - Directory : Name_Id := No_Name; + Directory : Name_Id := No_Name; -- Only for N_Project - Expr_Kind : Variable_Kind := Undefined; + Expr_Kind : Variable_Kind := Undefined; -- See below for what Project_Node_Kind it is used - Variables : Variable_Node_Id := Empty_Node; + Variables : Variable_Node_Id := Empty_Node; -- First variable in a project or a package - Packages : Package_Declaration_Id := Empty_Node; + Packages : Package_Declaration_Id := Empty_Node; -- First package declaration in a project - Pkg_Id : Package_Node_Id := Empty_Package; + Pkg_Id : Package_Node_Id := Empty_Package; -- Only use in Package_Declaration - Name : Name_Id := No_Name; + Name : Name_Id := No_Name; -- See below for what Project_Node_Kind it is used - Path_Name : Name_Id := No_Name; + Path_Name : Name_Id := No_Name; -- See below for what Project_Node_Kind it is used - Value : String_Id := No_String; + Value : String_Id := No_String; -- See below for what Project_Node_Kind it is used - Field1 : Project_Node_Id := Empty_Node; + Field1 : Project_Node_Id := Empty_Node; -- See below the meaning for each Project_Node_Kind - Field2 : Project_Node_Id := Empty_Node; + Field2 : Project_Node_Id := Empty_Node; -- See below the meaning for each Project_Node_Kind - Field3 : Project_Node_Id := Empty_Node; + Field3 : Project_Node_Id := Empty_Node; -- See below the meaning for each Project_Node_Kind + Case_Insensitive : Boolean := False; + -- Indicates, for an associative array attribute, that the + -- index is case insensitive. + end record; -- type Project_Node_Kind is diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 6a94a0cfc4c..5188a21ca10 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.8 $ -- +-- $Revision$ -- -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -188,6 +188,22 @@ package body Prj.Util is -------------- function Value_Of + (Variable : Variable_Value; + Default : String) + return String is + begin + if Variable.Kind /= Single + or else Variable.Default + or else Variable.Value = No_String then + return Default; + + else + String_To_Name_Buffer (Variable.Value); + return Name_Buffer (1 .. Name_Len); + end if; + end Value_Of; + + function Value_Of (Index : Name_Id; In_Array : Array_Element_Id) return Name_Id diff --git a/gcc/ada/prj-util.ads b/gcc/ada/prj-util.ads index baef0404f0e..cec6f9e1b32 100644 --- a/gcc/ada/prj-util.ads +++ b/gcc/ada/prj-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.6 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -34,6 +34,13 @@ with Types; use Types; package Prj.Util is function Value_Of + (Variable : Variable_Value; + Default : String) + return String; + -- Get the value of a single string variable. If Variable is + -- Nil_Variable_Value, is a string list or is defaulted, return Default. + + function Value_Of (Index : Name_Id; In_Array : Array_Element_Id) return Name_Id; @@ -53,7 +60,7 @@ package Prj.Util is (Name : Name_Id; Attribute_Or_Array_Name : Name_Id; In_Package : Package_Id) - return Variable_Value; + return Variable_Value; -- In a specific package, -- - if there exists an array Variable_Or_Array_Name with an index -- Name, returns the corresponding component, @@ -76,41 +83,36 @@ package Prj.Util is (Name : Name_Id; In_Arrays : Array_Id) return Array_Element_Id; - -- Returns a specified array in an array list. - -- Returns No_Array_Element if In_Arrays is null or if Name is not the - -- name of an array in In_Arrays. - -- Assumption: Name is in lower case. + -- Returns a specified array in an array list. Returns No_Array_Element + -- if In_Arrays is null or if Name is not the name of an array in + -- In_Arrays. The caller must ensure that Name is in lower case. function Value_Of (Name : Name_Id; In_Packages : Package_Id) return Package_Id; - -- Returns a specified package in a package list. - -- Returns No_Package if In_Packages is null or if Name is not the - -- name of a package in Package_List. - -- Assumption: Name is in lower case. + -- Returns a specified package in a package list. Returns No_Package + -- if In_Packages is null or if Name is not the name of a package in + -- Package_List. The caller must ensure that Name is in lower case. function Value_Of (Variable_Name : Name_Id; In_Variables : Variable_Id) return Variable_Value; - -- Returns a specified variable in a variable list. - -- Returns null if In_Variables is null or if Variable_Name - -- is not the name of a variable in In_Variables. - -- Assumption: Variable_Name is in lower case. + -- Returns a specified variable in a variable list. Returns null if + -- In_Variables is null or if Variable_Name is not the name of a + -- variable in In_Variables. Caller must ensure that Name is lower case. procedure Write_Str (S : String; Max_Length : Positive; Separator : Character); - -- Output string S using Output.Write_Str. - -- If S is too long to fit in one line of Max_Length, cut it in - -- several lines, using Separator as the last character of each line, - -- if possible. + -- Output string S using Output.Write_Str. If S is too long to fit in + -- one line of Max_Length, cut it in several lines, using Separator as + -- the last character of each line, if possible. type Text_File is limited private; - -- Represents a text file. - -- Default is invalid text file. + -- Represents a text file. Default is invalid text file. function Is_Valid (File : Text_File) return Boolean; -- Returns True if File designates an open text file that diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 8e302117917..5f4cf46ef8b 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.16 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -30,7 +30,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Errout; use Errout; with GNAT.OS_Lib; use GNAT.OS_Lib; with Namet; use Namet; -with Osint; use Osint; with Prj.Attr; with Prj.Com; with Prj.Env; @@ -42,7 +41,10 @@ with Snames; use Snames; package body Prj is - The_Empty_String : String_Id; + The_Empty_String : String_Id; + + Default_Ada_Spec_Suffix : Name_Id := No_Name; + Default_Ada_Impl_Suffix : Name_Id := No_Name; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; @@ -55,52 +57,74 @@ package body Prj is Standard_Dot_Replacement : constant Name_Id := First_Name_Id + Character'Pos ('-'); - Standard_Specification_Append : Name_Id; - Standard_Body_Append : Name_Id; Std_Naming_Data : Naming_Data := - (Dot_Replacement => Standard_Dot_Replacement, - Dot_Repl_Loc => No_Location, - Casing => All_Lower_Case, - Specification_Append => No_Name, - Spec_Append_Loc => No_Location, - Body_Append => No_Name, - Body_Append_Loc => No_Location, - Separate_Append => No_Name, - Sep_Append_Loc => No_Location, - Specifications => No_Array_Element, - Bodies => No_Array_Element); - - Project_Empty : Project_Data := - (First_Referred_By => No_Project, - Name => No_Name, - Path_Name => No_Name, - Location => No_Location, - Directory => No_Name, - File_Name => No_Name, - Library => False, - Library_Dir => No_Name, - Library_Name => No_Name, - Library_Kind => Static, - Lib_Internal_Name => No_Name, - Lib_Elaboration => False, - Sources => Nil_String, - Source_Dirs => Nil_String, - Object_Directory => No_Name, - Modifies => No_Project, - Modified_By => No_Project, - Naming => Std_Naming_Data, - Decl => No_Declarations, - Imported_Projects => Empty_Project_List, - Include_Path => null, - Objects_Path => null, - Config_File_Name => No_Name, - Config_File_Temp => False, - Config_Checked => False, - Checked => False, - Seen => False, - Flag1 => False, - Flag2 => False); + (Current_Language => No_Name, + Dot_Replacement => Standard_Dot_Replacement, + Dot_Repl_Loc => No_Location, + Casing => All_Lower_Case, + Specification_Suffix => No_Array_Element, + Current_Spec_Suffix => No_Name, + Spec_Suffix_Loc => No_Location, + Implementation_Suffix => No_Array_Element, + Current_Impl_Suffix => No_Name, + Impl_Suffix_Loc => No_Location, + Separate_Suffix => No_Name, + Sep_Suffix_Loc => No_Location, + Specifications => No_Array_Element, + Bodies => No_Array_Element, + Specification_Exceptions => No_Array_Element, + Implementation_Exceptions => No_Array_Element); + + Project_Empty : constant Project_Data := + (First_Referred_By => No_Project, + Name => No_Name, + Path_Name => No_Name, + Location => No_Location, + Directory => No_Name, + Library => False, + Library_Dir => No_Name, + Library_Name => No_Name, + Library_Kind => Static, + Lib_Internal_Name => No_Name, + Lib_Elaboration => False, + Sources_Present => True, + Sources => Nil_String, + Source_Dirs => Nil_String, + Object_Directory => No_Name, + Modifies => No_Project, + Modified_By => No_Project, + Naming => Std_Naming_Data, + Decl => No_Declarations, + Imported_Projects => Empty_Project_List, + Include_Path => null, + Objects_Path => null, + Config_File_Name => No_Name, + Config_File_Temp => False, + Config_Checked => False, + Language_Independent_Checked => False, + Checked => False, + Seen => False, + Flag1 => False, + Flag2 => False); + + ----------------------------- + -- Ada_Default_Spec_Suffix -- + ----------------------------- + + function Ada_Default_Spec_Suffix return Name_Id is + begin + return Default_Ada_Spec_Suffix; + end Ada_Default_Spec_Suffix; + + ----------------------------- + -- Ada_Default_Impl_Suffix -- + ----------------------------- + + function Ada_Default_Impl_Suffix return Name_Id is + begin + return Default_Ada_Impl_Suffix; + end Ada_Default_Impl_Suffix; ------------------- -- Empty_Project -- @@ -192,15 +216,13 @@ package body Prj is The_Empty_String := End_String; Name_Len := 4; Name_Buffer (1 .. 4) := ".ads"; - Canonical_Case_File_Name (Name_Buffer (1 .. 4)); - Standard_Specification_Append := Name_Find; - Name_Buffer (4) := 'b'; - Canonical_Case_File_Name (Name_Buffer (1 .. 4)); - Standard_Body_Append := Name_Find; - Std_Naming_Data.Specification_Append := Standard_Specification_Append; - Std_Naming_Data.Body_Append := Standard_Body_Append; - Std_Naming_Data.Separate_Append := Standard_Body_Append; - Project_Empty.Naming := Std_Naming_Data; + Default_Ada_Spec_Suffix := Name_Find; + Name_Len := 4; + Name_Buffer (1 .. 4) := ".adb"; + Default_Ada_Impl_Suffix := Name_Find; + Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix; + Std_Naming_Data.Current_Impl_Suffix := Default_Ada_Impl_Suffix; + Std_Naming_Data.Separate_Suffix := Default_Ada_Impl_Suffix; Prj.Env.Initialize; Prj.Attr.Initialize; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); @@ -236,9 +258,9 @@ package body Prj is begin return Left.Dot_Replacement = Right.Dot_Replacement and then Left.Casing = Right.Casing - and then Left.Specification_Append = Right.Specification_Append - and then Left.Body_Append = Right.Body_Append - and then Left.Separate_Append = Right.Separate_Append; + and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix + and then Left.Current_Impl_Suffix = Right.Current_Impl_Suffix + and then Left.Separate_Suffix = Right.Separate_Suffix; end Same_Naming_Scheme; ---------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 409a0717223..f59216577d3 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- $Revision: 1.18 $ +-- $Revision$ -- -- -- Copyright (C) 2001 Free Software Foundation, Inc. -- -- -- @@ -195,47 +195,66 @@ package Prj is -- Raises Constraint_Error if not a Casing_Type image. type Naming_Data is record - Dot_Replacement : Name_Id := No_Name; - -- The string to replace '.' in the source file name. + Current_Language : Name_Id := No_Name; + -- The programming language being currently considered - Dot_Repl_Loc : Source_Ptr := No_Location; + Dot_Replacement : Name_Id := No_Name; + -- The string to replace '.' in the source file name (for Ada). + + Dot_Repl_Loc : Source_Ptr := No_Location; -- The position in the project file source where -- Dot_Replacement is defined. - Casing : Casing_Type := All_Lower_Case; - -- The casing of the source file name. + Casing : Casing_Type := All_Lower_Case; + -- The casing of the source file name (for Ada). - Specification_Append : Name_Id := No_Name; + Specification_Suffix : Array_Element_Id := No_Array_Element; -- The string to append to the unit name for the -- source file name of a specification. + -- Indexed by the programming language. + + Current_Spec_Suffix : Name_Id := No_Name; + -- The specification suffix of the current programming language - Spec_Append_Loc : Source_Ptr := No_Location; + Spec_Suffix_Loc : Source_Ptr := No_Location; -- The position in the project file source where - -- Specification_Append is defined. + -- Current_Spec_Suffix is defined. - Body_Append : Name_Id := No_Name; + Implementation_Suffix : Array_Element_Id := No_Array_Element; -- The string to append to the unit name for the -- source file name of a body. + -- Indexed by the programming language. + + Current_Impl_Suffix : Name_Id := No_Name; + -- The implementation suffix of the current programming language - Body_Append_Loc : Source_Ptr := No_Location; + Impl_Suffix_Loc : Source_Ptr := No_Location; -- The position in the project file source where - -- Body_Append is defined. + -- Current_Impl_Suffix is defined. - Separate_Append : Name_Id := No_Name; + Separate_Suffix : Name_Id := No_Name; -- The string to append to the unit name for the - -- source file name of a subunit. + -- source file name of an Ada subunit. - Sep_Append_Loc : Source_Ptr := No_Location; + Sep_Suffix_Loc : Source_Ptr := No_Location; -- The position in the project file source where - -- Separate_Append is defined. + -- Separate_Suffix is defined. + + Specifications : Array_Element_Id := No_Array_Element; + -- An associative array mapping individual specifications + -- to source file names. Specific to Ada. + + Bodies : Array_Element_Id := No_Array_Element; + -- An associative array mapping individual bodies + -- to source file names. Specific to Ada. - Specifications : Array_Element_Id := No_Array_Element; + Specification_Exceptions : Array_Element_Id := No_Array_Element; -- An associative array mapping individual specifications - -- to source file names. + -- to source file names. Indexed by the programming language name. - Bodies : Array_Element_Id := No_Array_Element; + Implementation_Exceptions : Array_Element_Id := No_Array_Element; -- An associative array mapping individual bodies - -- to source file names. + -- to source file names. Indexed by the programming language name. end record; -- A naming scheme. @@ -278,88 +297,122 @@ package Prj is First_Referred_By : Project_Id := No_Project; -- The project, if any, that was the first to be known -- as importing or modifying this project. + -- Set by Prj.Proc.Process. Name : Name_Id := No_Name; -- The name of the project. + -- Set by Prj.Proc.Process. Path_Name : Name_Id := No_Name; -- The path name of the project file. + -- Set by Prj.Proc.Process. Location : Source_Ptr := No_Location; -- The location in the project file source of the -- reserved word project. + -- Set by Prj.Proc.Process. Directory : Name_Id := No_Name; -- The directory where the project file resides. - - File_Name : Name_Id := No_Name; - -- The file name of the project file. + -- Set by Prj.Proc.Process. Library : Boolean := False; - -- True if this is a library project + -- True if this is a library project. + -- Set by Prj.Nmsc.Check_Naming_Scheme. Library_Dir : Name_Id := No_Name; -- If a library project, directory where resides the library + -- Set by Prj.Nmsc.Check_Naming_Scheme. Library_Name : Name_Id := No_Name; -- If a library project, name of the library + -- Set by Prj.Nmsc.Check_Naming_Scheme. Library_Kind : Lib_Kind := Static; -- If a library project, kind of library + -- Set by Prj.Nmsc.Check_Naming_Scheme. Lib_Internal_Name : Name_Id := No_Name; -- If a library project, internal name store inside the library + -- Set by Prj.Nmsc.Check_Naming_Scheme. Lib_Elaboration : Boolean := False; -- If a library project, indicate if <lib>init and <lib>final -- procedures need to be defined. + -- Set by Prj.Nmsc.Check_Naming_Scheme. + + Sources_Present : Boolean := True; + -- A flag that indicates if there are sources in this project file. + -- There are no sources if 1) Source_Dirs is specified as an + -- empty list, 2) Source_Files is specified as an empty list, or + -- 3) the current language is not in the list of the specified + -- Languages. Sources : String_List_Id := Nil_String; -- The list of all the source file names. + -- Set by Prj.Nmsc.Check_Naming_Scheme. Source_Dirs : String_List_Id := Nil_String; -- The list of all the source directories. + -- Set by Prj.Nmsc.Check_Naming_Scheme. Object_Directory : Name_Id := No_Name; -- The object directory of this project file. + -- Set by Prj.Nmsc.Check_Naming_Scheme. Modifies : Project_Id := No_Project; -- The reference of the project file, if any, that this -- project file modifies. + -- Set by Prj.Proc.Process. Modified_By : Project_Id := No_Project; -- The reference of the project file, if any, that -- modifies this project file. + -- Set by Prj.Proc.Process. Naming : Naming_Data := Standard_Naming_Data; -- The naming scheme of this project file. + -- Set by Prj.Nmsc.Check_Naming_Scheme. Decl : Declarations := No_Declarations; -- The declarations (variables, attributes and packages) -- of this project file. + -- Set by Prj.Proc.Process. Imported_Projects : Project_List := Empty_Project_List; -- The list of all directly imported projects, if any. + -- Set by Prj.Proc.Process. Include_Path : String_Access := null; -- The cached value of ADA_INCLUDE_PATH for this project file. + -- Set by gnatmake (prj.Env.Set_Ada_Paths). Objects_Path : String_Access := null; -- The cached value of ADA_OBJECTS_PATH for this project file. + -- Set by gnatmake (prj.Env.Set_Ada_Paths). Config_File_Name : Name_Id := No_Name; -- The name of the configuration pragmas file, if any. + -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File). Config_File_Temp : Boolean := False; -- An indication that the configuration pragmas file is -- a temporary file that must be deleted at the end. + -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File). Config_Checked : Boolean := False; - -- A flag to avoid checking repetively the configuration pragmas file. + -- A flag to avoid checking repetitively the configuration pragmas file. + -- Set by gnatmage (Prj.Env.Create_Config_Pragmas_File). + + Language_Independent_Checked : Boolean := False; + -- A flag that indicates that the project file has been checked + -- for language independent features: Object_Directory, + -- Source_Directories, Library, non empty Naming Suffixs. Checked : Boolean := False; - -- A flag to avoid checking repetively the naming scheme of + -- A flag to avoid checking repetitively the naming scheme of -- this project file. + -- Set by Prj.Nmsc.Check_Naming_Scheme. -- Various flags that are used in an ad hoc manner @@ -403,11 +456,19 @@ package Prj is (By : Project_Id; With_State : in out State); -- Call Action for each project imported directly or indirectly by project - -- By.-- Action is called according to the order of importation: if A + -- By. Action is called according to the order of importation: if A -- imports B, directly or indirectly, Action will be called for A before -- it is called for B. With_State may be used by Action to choose a -- behavior or to report some global result. + function Ada_Default_Spec_Suffix return Name_Id; + -- Return the Name_Id for the standard GNAT suffix for Ada spec source + -- file name ".ads". + + function Ada_Default_Impl_Suffix return Name_Id; + -- Return the Name_Id for the standard GNAT suffix for Ada body source + -- file name ".adb". + private procedure Scan; diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 680ac213923..c98c25f5853 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -862,7 +862,7 @@ package Snames is Name_Project : constant Name_Id := N + 523; Name_Modifying : constant Name_Id := N + 524; - -- Name_External is already declared as N + 243 + -- Name_External is already declared as N + 161 -- Names used in GNAT Project Files @@ -870,32 +870,34 @@ package Snames is Name_Object_Dir : constant Name_Id := N + 526; Name_Source_Dirs : constant Name_Id := N + 527; Name_Specification : constant Name_Id := N + 528; - Name_Body_Part : constant Name_Id := N + 529; - Name_Specification_Append : constant Name_Id := N + 530; - Name_Body_Append : constant Name_Id := N + 531; - Name_Separate_Append : constant Name_Id := N + 532; - Name_Source_Files : constant Name_Id := N + 533; - Name_Source_List_File : constant Name_Id := N + 534; - Name_Switches : constant Name_Id := N + 535; - Name_Library_Dir : constant Name_Id := N + 536; - Name_Library_Name : constant Name_Id := N + 537; - Name_Library_Kind : constant Name_Id := N + 538; - Name_Library_Version : constant Name_Id := N + 539; - Name_Library_Elaboration : constant Name_Id := N + 540; - - Name_Gnatmake : constant Name_Id := N + 541; - Name_Gnatls : constant Name_Id := N + 542; - Name_Gnatxref : constant Name_Id := N + 543; - Name_Gnatfind : constant Name_Id := N + 544; - Name_Gnatbind : constant Name_Id := N + 545; - Name_Gnatlink : constant Name_Id := N + 546; - Name_Compiler : constant Name_Id := N + 547; - Name_Binder : constant Name_Id := N + 548; - Name_Linker : constant Name_Id := N + 549; + Name_Implementation : constant Name_Id := N + 529; + Name_Specification_Exceptions : constant Name_Id := N + 530; + Name_Implementation_Exceptions : constant Name_Id := N + 531; + Name_Specification_Suffix : constant Name_Id := N + 532; + Name_Implementation_Suffix : constant Name_Id := N + 533; + Name_Separate_Suffix : constant Name_Id := N + 534; + Name_Source_Files : constant Name_Id := N + 535; + Name_Source_List_File : constant Name_Id := N + 536; + Name_Default_Switches : constant Name_Id := N + 537; + Name_Switches : constant Name_Id := N + 538; + Name_Library_Dir : constant Name_Id := N + 539; + Name_Library_Name : constant Name_Id := N + 540; + Name_Library_Kind : constant Name_Id := N + 541; + Name_Library_Version : constant Name_Id := N + 542; + Name_Library_Elaboration : constant Name_Id := N + 543; + Name_Languages : constant Name_Id := N + 544; + + Name_Builder : constant Name_Id := N + 545; + Name_Gnatls : constant Name_Id := N + 546; + Name_Cross_Reference : constant Name_Id := N + 547; + Name_Finder : constant Name_Id := N + 548; + Name_Binder : constant Name_Id := N + 549; + Name_Linker : constant Name_Id := N + 550; + Name_Compiler : constant Name_Id := N + 551; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 549; + Last_Predefined_Name : constant Name_Id := N + 551; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; |