diff options
Diffstat (limited to 'gcc/ada/prj-nmsc.adb')
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 2173 |
1 files changed, 1146 insertions, 1027 deletions
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 |