-- --
-- B o d y --
-- --
--- $Revision: 1.25 $
+-- $Revision$
-- --
-- Copyright (C) 2000-2001 Free Software Foundation, Inc. --
-- --
-- --
------------------------------------------------------------------------------
-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
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
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
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.
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.
-- 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;
Element.Value.Location);
else
-
if Current_Verbosity = High then
Write_Str (" Body_Part (""");
Write_Str (Get_Name_String (Unit_Name));
end loop;
end Check_Unit_Names;
- ----------------------
- -- Find_Source_Dirs --
- ----------------------
-
- procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
+ ------------------
+ -- Find_Sources --
+ ------------------
- Directory : String (1 .. Integer (String_Length (From)));
- Directory_Id : Name_Id;
- Element : String_Element;
+ procedure Find_Sources is
+ Source_Dir : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
+ Dir : Dir_Type;
+ Current_Source : String_List_Id := Nil_String;
- 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.
+ begin
+ if Current_Verbosity = High then
+ Write_Line ("Looking for sources:");
+ end if;
- -------------------------
- -- Recursive_Find_Dirs --
- -------------------------
+ -- For each subdirectory
- 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;
+ while Source_Dir /= Nil_String loop
+ begin
+ Element := String_Elements.Table (Source_Dir);
+ if Element.Value /= No_String then
+ declare
+ Source_Directory : String
+ (1 .. Integer (String_Length (Element.Value)));
+ begin
+ String_To_Name_Buffer (Element.Value);
+ Source_Directory := Name_Buffer (1 .. Name_Len);
+ if Current_Verbosity = High then
+ Write_Str ("Source_Dir = ");
+ Write_Line (Source_Directory);
+ end if;
- The_Path_Last : Positive := The_Path'Last;
+ -- We look to every entry in the source directory
- 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;
+ Open (Dir, Source_Directory);
- if Current_Verbosity = High then
- Write_Str (" ");
- Write_Line (The_Path (The_Path'First .. The_Path_Last));
- end if;
+ loop
+ Read (Dir, Name_Buffer, Name_Len);
- String_Elements.Increment_Last;
- Element :=
- (Value => Path,
- Location => No_Location,
- Next => Nil_String);
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name_Buffer (1 .. Name_Len));
+ end if;
- -- Case of first source directory
+ exit when Name_Len = 0;
- if Last_Source_Dir = Nil_String then
- Data.Source_Dirs := String_Elements.Last;
+ declare
+ Path_Access : constant GNAT.OS_Lib.String_Access :=
+ Locate_Regular_File
+ (Name_Buffer (1 .. Name_Len),
+ Source_Directory);
- -- 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 --
- ------------------
-
- procedure Find_Sources is
- Source_Dir : String_List_Id := Data.Source_Dirs;
- Element : String_Element;
- Dir : Dir_Type;
- Current_Source : String_List_Id := Nil_String;
-
- begin
- if Current_Verbosity = High then
- Write_Line ("Looking for sources:");
- end if;
-
- -- For each subdirectory
-
- while Source_Dir /= Nil_String loop
- begin
- Element := String_Elements.Table (Source_Dir);
- if Element.Value /= No_String then
- declare
- Source_Directory : String
- (1 .. Integer (String_Length (Element.Value)));
- begin
- String_To_Name_Buffer (Element.Value);
- Source_Directory := Name_Buffer (1 .. Name_Len);
- if Current_Verbosity = High then
- Write_Str ("Source_Dir = ");
- Write_Line (Source_Directory);
- end if;
-
- -- We look to every entry in the source directory
-
- Open (Dir, Source_Directory);
-
- loop
- Read (Dir, Name_Buffer, Name_Len);
-
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name_Buffer (1 .. Name_Len));
- end if;
-
- exit when Name_Len = 0;
-
- declare
- Path_Access : constant GNAT.OS_Lib.String_Access :=
- Locate_Regular_File
- (Name_Buffer (1 .. Name_Len),
- Source_Directory);
-
- File_Name : Name_Id;
- Path_Name : Name_Id;
+ File_Name : Name_Id;
+ Path_Name : Name_Id;
begin
-- If it is a regular file
Path_Name => Path_Name,
Project => Project,
Data => Data,
- Error_If_Invalid => False,
Location => No_Location,
Current_Source => Current_Source);
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
Path_Name => Name_Find,
Project => Project,
Data => Data,
- Error_If_Invalid => True,
Location => Location,
Current_Source => Current_Source);
Found := True;
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;
---------------------------
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;
+ Data := Projects.Table (Project);
+ Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
- -- Let's check the object directory
+ Data.Naming.Current_Language := Name_Ada;
+ Data.Sources_Present := Data.Source_Dirs /= Nil_String;
- declare
- Object_Dir : Variable_Value :=
- Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
+ if not Languages.Default then
+ declare
+ Current : String_List_Id := Languages.Values;
+ Element : String_Element;
+ Ada_Found : Boolean := False;
- begin
- pragma Assert (Object_Dir.Kind = Single,
- "Object_Dir is not a single string");
+ begin
+ Look_For_Ada : while Current /= Nil_String loop
+ Element := String_Elements.Table (Current);
+ String_To_Name_Buffer (Element.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
- -- We set the object directory to its default
+ if Name_Buffer (1 .. Name_Len) = "ada" then
+ Ada_Found := True;
+ exit Look_For_Ada;
+ end if;
- Data.Object_Directory := Data.Directory;
+ Current := Element.Next;
+ end loop Look_For_Ada;
- if not String_Equal (Object_Dir.Value, Empty_String) then
+ if not Ada_Found then
- String_To_Name_Buffer (Object_Dir.Value);
+ -- Mark the project file as having no sources for Ada
- if Name_Len = 0 then
- Error_Msg ("Object_Dir cannot be empty",
- Object_Dir.Location);
+ Data.Sources_Present := False;
+ end if;
+ end;
+ end if;
- else
- -- We check that the specified object directory
- -- does exist.
+ declare
+ Naming_Id : constant Package_Id :=
+ Util.Value_Of (Name_Naming, Data.Decl.Packages);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Naming : Package_Element;
- declare
- Dir_Id : constant Name_Id := Name_Find;
+ begin
+ -- If there is a package Naming, we will put in Data.Naming
+ -- what is in this package Naming.
- begin
- Data.Object_Directory :=
- Locate_Directory (Dir_Id, Data.Directory);
+ if Naming_Id /= No_Package then
+ Naming := Packages.Table (Naming_Id);
- 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;
+ if Current_Verbosity = High then
+ Write_Line ("Checking ""Naming"" for Ada.");
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;
+ declare
+ Bodies : constant Array_Element_Id :=
+ Util.Value_Of
+ (Name_Implementation, Naming.Decl.Arrays);
- -- Let's check the source directories
+ Specifications : constant Array_Element_Id :=
+ Util.Value_Of
+ (Name_Specification, Naming.Decl.Arrays);
- declare
- Source_Dirs : Variable_Value :=
- Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
+ begin
+ if Bodies /= No_Array_Element then
- begin
+ -- We have elements in the array Body_Part
- if Current_Verbosity = High then
- Write_Line ("Starting to look for source directories");
- end if;
+ if Current_Verbosity = High then
+ Write_Line ("Found Bodies.");
+ end if;
- pragma Assert (Source_Dirs.Kind = List,
- "Source_Dirs is not a list");
+ Data.Naming.Bodies := Bodies;
+ Check_Unit_Names (Bodies);
- if Source_Dirs.Default then
+ else
+ if Current_Verbosity = High then
+ Write_Line ("No Bodies.");
+ end if;
+ end if;
- -- No Source_Dirs specified: the single source directory
- -- is the one containing the project file
+ if Specifications /= No_Array_Element then
- 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);
+ -- We have elements in the array Specification
- if Current_Verbosity = High then
- Write_Line ("(Undefined) Single object directory:");
- Write_Str (" """);
- Write_Str (Get_Name_String (Data.Directory));
- Write_Line ("""");
- end if;
+ if Current_Verbosity = High then
+ Write_Line ("Found Specifications.");
+ end if;
- elsif Source_Dirs.Values = Nil_String then
+ Data.Naming.Specifications := Specifications;
+ Check_Unit_Names (Specifications);
- -- If Source_Dirs is an empty string list, this means
- -- that this project contains no source.
+ else
+ if Current_Verbosity = High then
+ Write_Line ("No Specifications.");
+ end if;
+ end if;
+ end;
- if Data.Object_Directory = Data.Directory then
- Data.Object_Directory := No_Name;
- end if;
+ -- 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.
- Data.Source_Dirs := Nil_String;
+ -- Check Dot_Replacement
- else
declare
- Source_Dir : String_List_Id := Source_Dirs.Values;
- Element : String_Element;
+ Dot_Replacement : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Dot_Replacement,
+ Naming.Decl.Attributes);
begin
- -- We will find the source directories for each
- -- element of the list
+ pragma Assert (Dot_Replacement.Kind = Single,
+ "Dot_Replacement is not a single string");
- 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 not Dot_Replacement.Default then
- if Current_Verbosity = High then
- Write_Line ("Puting source directories in canonical cases");
- end if;
+ String_To_Name_Buffer (Dot_Replacement.Value);
- declare
- Current : String_List_Id := Data.Source_Dirs;
- Element : String_Element;
+ if Name_Len = 0 then
+ Error_Msg ("Dot_Replacement cannot be empty",
+ Dot_Replacement.Location);
+
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Data.Naming.Dot_Replacement := Name_Find;
+ Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
+ end if;
- 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;
+ end;
- -- Library Dir, Name, Version and Kind
+ if Current_Verbosity = High then
+ Write_Str (" Dot_Replacement = """);
+ Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
- declare
- Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
+ -- Check Casing
- Lib_Dir : Prj.Variable_Value :=
- Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
+ declare
+ Casing_String : constant Variable_Value :=
+ Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
- Lib_Name : Prj.Variable_Value :=
- Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
+ begin
+ pragma Assert (Casing_String.Kind = Single,
+ "Casing is not a single string");
- Lib_Version : Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Version, Attributes);
+ if not Casing_String.Default then
+ declare
+ Casing_Image : constant String :=
+ Get_Name_String (Casing_String.Value);
- The_Lib_Kind : Prj.Variable_Value :=
- Prj.Util.Value_Of
- (Snames.Name_Library_Kind, Attributes);
+ begin
+ declare
+ Casing : constant Casing_Type :=
+ Value (Casing_Image);
- begin
- pragma Assert (Lib_Dir.Kind = Single);
+ begin
+ Data.Naming.Casing := Casing;
+ end;
- if Lib_Dir.Value = Empty_String then
+ exception
+ when Constraint_Error =>
+ if Casing_Image'Length = 0 then
+ Error_Msg ("Casing cannot be an empty string",
+ Casing_String.Location);
+
+ else
+ Name_Len := Casing_Image'Length;
+ Name_Buffer (1 .. Name_Len) := Casing_Image;
+ Error_Msg_Name_1 := Name_Find;
+ Error_Msg
+ ("{ is not a correct Casing",
+ Casing_String.Location);
+ end if;
+ end;
+ end if;
+ end;
if Current_Verbosity = High then
- Write_Line ("No library directory");
+ Write_Str (" Casing = ");
+ Write_Str (Image (Data.Naming.Casing));
+ Write_Char ('.');
+ Write_Eol;
end if;
- else
- -- Find path name, check that it is a directory
-
- Stringt.String_To_Name_Buffer (Lib_Dir.Value);
+ -- Check Specification_Suffix
declare
- Dir_Id : constant Name_Id := Name_Find;
+ Ada_Spec_Suffix : constant Name_Id :=
+ Prj.Util.Value_Of
+ (Index => Name_Ada,
+ In_Array => Data.Naming.Specification_Suffix);
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;
+ if Ada_Spec_Suffix /= No_Name then
+ Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix;
else
- if Current_Verbosity = High then
- Write_Str ("Library directory =""");
- Write_Str (Get_Name_String (Data.Library_Dir));
- Write_Line ("""");
- end if;
+ Data.Naming.Current_Spec_Suffix := Ada_Default_Spec_Suffix;
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");
+ Write_Str (" Specification_Suffix = """);
+ Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix));
+ Write_Char ('"');
+ Write_Eol;
end if;
- else
- Stringt.String_To_Name_Buffer (Lib_Name.Value);
+ -- Check Implementation_Suffix
- if not Is_Letter (Name_Buffer (1)) then
- Error_Msg ("must start with a letter",
- Lib_Name.Location);
+ declare
+ Ada_Impl_Suffix : constant Name_Id :=
+ Prj.Util.Value_Of
+ (Index => Name_Ada,
+ In_Array => Data.Naming.Implementation_Suffix);
+
+ begin
+ if Ada_Impl_Suffix /= No_Name then
+ Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix;
+
+ else
+ Data.Naming.Current_Impl_Suffix := Ada_Default_Impl_Suffix;
+ end if;
+ end;
+
+ 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;
+
+ -- Check Separate_Suffix
+
+ 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;
+
+ 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);
+
+ 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 (" Separate_Suffix = """);
+ Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
+ Write_Char ('"');
+ Write_Eol;
+ end if;
+
+ -- 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
+ 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
+ (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;
+
+ -- Sources is a list of file names
+
+ declare
+ Current_Source : String_List_Id := Nil_String;
+ Current : String_List_Id := Sources.Values;
+ Element : String_Element;
+
+ 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_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;
+
+ -- 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
+ -- Signal a problem with No_Name
+
+ Unit := No_Name;
+ end if;
+ end Check_Ada_Name;
+
+ -------------------------
+ -- Check_Naming_Scheme --
+ -------------------------
+
+ procedure Check_Ada_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_Suffix : constant String :=
+ Get_Name_String
+ (Naming.Current_Spec_Suffix);
+
+ Implementation_Suffix : constant String :=
+ Get_Name_String
+ (Naming.Current_Impl_Suffix);
+
+ Separate_Suffix : constant String :=
+ Get_Name_String
+ (Naming.Separate_Suffix);
+
+ 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;
+
+ -- 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;
+
+ 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;
+ 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;
+
+ 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;
+
+ 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 ('"');
+
+ case Msg_Name is
+ when 1 => Add (Error_Msg_Name_1);
+
+ when 2 => Add (Error_Msg_Name_2);
+
+ when 3 => Add (Error_Msg_Name_3);
+
+ when others => null;
+ end case;
+
+ Add ('"');
+
+ else
+ Add (Msg (Index));
+ end if;
+
+ end loop;
+
+ Error_Report (Error_Buffer (1 .. Error_Last));
+ end Error_Msg;
+
+ ---------------------
+ -- Get_Name_String --
+ ---------------------
+
+ function Get_Name_String (S : String_Id) return String is
+ begin
+ if S = No_String then
+ return "";
+ else
+ String_To_Name_Buffer (S);
+ return Name_Buffer (1 .. Name_Len);
+ end if;
+ end Get_Name_String;
+
+ --------------
+ -- Get_Unit --
+ --------------
+
+ procedure Get_Unit
+ (File_Name : Name_Id;
+ Naming : Naming_Data;
+ Unit_Name : out Name_Id;
+ Unit_Kind : out Spec_Or_Body;
+ Needs_Pragma : out Boolean)
+ is
+ Canonical_Case_Name : Name_Id;
+
+ begin
+ Needs_Pragma := False;
+ Get_Name_String (File_Name);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Canonical_Case_Name := Name_Find;
+
+ if Naming.Bodies /= No_Array_Element then
+
+ -- There are some specified file names for some bodies
+ -- of this project. Find out if File_Name is one of these bodies.
+
+ declare
+ Current : Array_Element_Id := Naming.Bodies;
+ Element : Array_Element;
+
+ begin
+ while Current /= No_Array_Element loop
+ Element := Array_Elements.Table (Current);
+
+ if Element.Index /= No_Name then
+ String_To_Name_Buffer (Element.Value.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+
+ if Canonical_Case_Name = Name_Find then
+
+ -- File_Name corresponds to one body.
+ -- So, we know it is a body, and we know the unit name.
+
+ Unit_Kind := Body_Part;
+ Unit_Name := Element.Index;
+ Needs_Pragma := True;
+ return;
+ end if;
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+ end if;
+
+ if Naming.Specifications /= No_Array_Element then
+
+ -- There are some specified file names for some bodiesspecifications
+ -- of this project. Find out if File_Name is one of these
+ -- specifications.
+
+ declare
+ Current : Array_Element_Id := Naming.Specifications;
+ Element : Array_Element;
+
+ begin
+ while Current /= No_Array_Element loop
+ Element := Array_Elements.Table (Current);
+
+ if Element.Index /= No_Name then
+ String_To_Name_Buffer (Element.Value.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+
+ if Canonical_Case_Name = Name_Find then
+
+ -- File_Name corresponds to one specification.
+ -- So, we know it is a spec, and we know the unit name.
+
+ Unit_Kind := Specification;
+ Unit_Name := Element.Index;
+ Needs_Pragma := True;
+ return;
+ end if;
+
+ end if;
+
+ Current := Element.Next;
+ end loop;
+ end;
+ end if;
+
+ declare
+ File : String := Get_Name_String (Canonical_Case_Name);
+ First : Positive := File'First;
+ Last : Natural := File'Last;
+
+ begin
+ -- Check if the end of the file name is Specification_Append
+
+ Get_Name_String (Naming.Current_Spec_Suffix);
+
+ if File'Length > Name_Len
+ and then File (Last - Name_Len + 1 .. Last) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ -- We have a spec
+
+ Unit_Kind := Specification;
+ Last := Last - Name_Len;
+
+ if Current_Verbosity = High then
+ Write_Str (" Specification: ");
+ Write_Line (File (First .. Last));
+ end if;
- else
- Data.Library_Name := Name_Find;
+ else
+ Get_Name_String (Naming.Current_Impl_Suffix);
- 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;
+ -- Check if the end of the file name is Body_Append
+
+ if File'Length > Name_Len
+ and then File (Last - Name_Len + 1 .. Last) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ -- We have a body
+
+ Unit_Kind := Body_Part;
+ Last := Last - Name_Len;
+
+ if Current_Verbosity = High then
+ Write_Str (" Body: ");
+ Write_Line (File (First .. Last));
+ end if;
+
+ 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
+
+ if File'Length > Name_Len
+ and then File (Last - Name_Len + 1 .. Last) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ -- We have a separate (a body)
+
+ Unit_Kind := Body_Part;
+ Last := Last - Name_Len;
+
+ if Current_Verbosity = High then
+ Write_Str (" Separate: ");
+ Write_Line (File (First .. Last));
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 ("""");
+ else
+ Last := 0;
end if;
+
+ else
+ Last := 0;
end if;
end if;
- Data.Library :=
- Data.Library_Dir /= No_Name
- and then
- Data.Library_Name /= No_Name;
+ if Last = 0 then
+
+ -- This is not a source file
+
+ Unit_Name := No_Name;
+ Unit_Kind := Specification;
- if Data.Library then
if Current_Verbosity = High then
- Write_Line ("This is a library project file");
+ Write_Line (" Not a valid file name.");
end if;
- pragma Assert (Lib_Version.Kind = Single);
+ return;
+ end if;
- if Lib_Version.Value = Empty_String then
- if Current_Verbosity = High then
- Write_Line ("No library version specified");
- end if;
+ Get_Name_String (Naming.Dot_Replacement);
- else
- Stringt.String_To_Name_Buffer (Lib_Version.Value);
- Data.Lib_Internal_Name := Name_Find;
- end if;
+ if Name_Buffer (1 .. Name_Len) /= "." then
- pragma Assert (The_Lib_Kind.Kind = Single);
+ -- If Dot_Replacement is not a single dot,
+ -- then there should not be any dot in the name.
- if The_Lib_Kind.Value = Empty_String then
- if Current_Verbosity = High then
- Write_Line ("No library kind specified");
- end if;
+ for Index in First .. Last loop
+ if File (Index) = '.' then
+ if Current_Verbosity = High then
+ Write_Line
+ (" Not a valid file name (some dot not replaced).");
+ end if;
- else
- Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
+ Unit_Name := No_Name;
+ return;
- declare
- Kind_Name : constant String :=
- Ada.Characters.Handling.To_Lower
- (Name_Buffer (1 .. Name_Len));
+ end if;
+ end loop;
- OK : Boolean := True;
+ -- Replace the substring Dot_Replacement with dots
- begin
- if Kind_Name = "static" then
- Data.Library_Kind := Static;
+ declare
+ Index : Positive := First;
- elsif Kind_Name = "dynamic" then
- Data.Library_Kind := Dynamic;
+ begin
+ while Index <= Last - Name_Len + 1 loop
- elsif Kind_Name = "relocatable" then
- Data.Library_Kind := Relocatable;
+ if File (Index .. Index + Name_Len - 1) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ File (Index) := '.';
- else
- Error_Msg
- ("illegal value for Library_Kind",
- The_Lib_Kind.Location);
- OK := False;
- end if;
+ if Name_Len > 1 and then Index < Last then
+ File (Index + 1 .. Last - Name_Len + 1) :=
+ File (Index + Name_Len .. Last);
+ end if;
- if Current_Verbosity = High and then OK then
- Write_Str ("Library kind = ");
- Write_Line (Kind_Name);
+ Last := Last - Name_Len + 1;
end if;
- end;
- end if;
+
+ Index := Index + 1;
+ end loop;
+ end;
end if;
- end;
- if Current_Verbosity = High then
- Show_Source_Dirs (Project);
- end if;
+ -- Check if the casing is right
- declare
- Naming_Id : constant Package_Id :=
- Util.Value_Of (Name_Naming, Data.Decl.Packages);
+ declare
+ Src : String := File (First .. Last);
- Naming : Package_Element;
+ begin
+ case Naming.Casing is
+ when All_Lower_Case =>
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Lower_Case_Map);
- begin
- -- If there is a package Naming, we will put in Data.Naming
- -- what is in this package Naming.
+ when All_Upper_Case =>
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Upper_Case_Map);
- if Naming_Id /= No_Package then
- Naming := Packages.Table (Naming_Id);
+ when Mixed_Case | Unknown =>
+ null;
+ end case;
- if Current_Verbosity = High then
- Write_Line ("Checking ""Naming"".");
- end if;
+ if Src /= File (First .. Last) then
+ if Current_Verbosity = High then
+ Write_Line (" Not a valid file name (casing).");
+ end if;
- declare
- Bodies : constant Array_Element_Id :=
- Util.Value_Of (Name_Body_Part, Naming.Decl.Arrays);
+ Unit_Name := No_Name;
+ return;
+ end if;
- Specifications : constant Array_Element_Id :=
- Util.Value_Of
- (Name_Specification, Naming.Decl.Arrays);
+ -- We put the name in lower case
- begin
- if Bodies /= No_Array_Element then
+ Fixed.Translate
+ (Source => Src,
+ Mapping => Lower_Case_Map);
- -- We have elements in the array Body_Part
+ if Current_Verbosity = High then
+ Write_Str (" ");
+ Write_Line (Src);
+ end if;
- if Current_Verbosity = High then
- Write_Line ("Found Bodies.");
- end if;
+ Name_Len := Src'Length;
+ Name_Buffer (1 .. Name_Len) := Src;
- Data.Naming.Bodies := Bodies;
- Check_Unit_Names (Bodies);
+ -- Now, we check if this name is a valid unit name
- else
- if Current_Verbosity = High then
- Write_Line ("No Bodies.");
- end if;
- end if;
+ Check_Ada_Name (Name => Name_Find, Unit => Unit_Name);
+ end;
- if Specifications /= No_Array_Element then
+ end;
- -- We have elements in the array Specification
+ end Get_Unit;
- if Current_Verbosity = High then
- Write_Line ("Found Specifications.");
- end if;
+ -----------------------
+ -- Is_Illegal_Append --
+ -----------------------
- Data.Naming.Specifications := Specifications;
- Check_Unit_Names (Specifications);
+ function Is_Illegal_Append (This : String) return Boolean is
+ begin
+ return This'Length = 0
+ or else Is_Alphanumeric (This (This'First))
+ or else (This'Length >= 2
+ and then This (This'First) = '_'
+ and then Is_Alphanumeric (This (This'First + 1)));
+ end Is_Illegal_Append;
- else
- if Current_Verbosity = High then
- Write_Line ("No Specifications.");
- end if;
- end if;
- end;
+ --------------------------------
+ -- Language_Independent_Check --
+ --------------------------------
- -- 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.
+ 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);
- -- Let's check Dot_Replacement
+ 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.
- declare
- Dot_Replacement : constant Variable_Value :=
- Util.Value_Of
- (Name_Dot_Replacement,
- Naming.Decl.Attributes);
+ ----------------------
+ -- Find_Source_Dirs --
+ ----------------------
- begin
- pragma Assert (Dot_Replacement.Kind = Single,
- "Dot_Replacement is not a single string");
+ procedure Find_Source_Dirs (From : String_Id; Location : Source_Ptr) is
- if not Dot_Replacement.Default then
+ Directory : String (1 .. Integer (String_Length (From)));
+ Directory_Id : Name_Id;
+ Element : String_Element;
- String_To_Name_Buffer (Dot_Replacement.Value);
+ 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.
- if Name_Len = 0 then
- Error_Msg ("Dot_Replacement cannot be empty",
- Dot_Replacement.Location);
+ -------------------------
+ -- Recursive_Find_Dirs --
+ -------------------------
- else
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Dot_Replacement := Name_Find;
- Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
- end if;
+ 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;
- end if;
+ The_Path_Last : Positive := The_Path'Last;
- end;
+ 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 (" Dot_Replacement = """);
- Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
- Write_Char ('"');
- Write_Eol;
+ Write_Str (" ");
+ Write_Line (The_Path (The_Path'First .. The_Path_Last));
end if;
- -- Check Casing
-
- declare
- Casing_String : constant Variable_Value :=
- Util.Value_Of (Name_Casing, Naming.Decl.Attributes);
-
- begin
- pragma Assert (Casing_String.Kind = Single,
- "Dot_Replacement is not a single string");
-
- if not Casing_String.Default then
- declare
- Casing_Image : constant String :=
- Get_Name_String (Casing_String.Value);
+ String_Elements.Increment_Last;
+ Element :=
+ (Value => Path,
+ Location => No_Location,
+ Next => Nil_String);
- begin
- declare
- Casing : constant Casing_Type :=
- Value (Casing_Image);
+ -- Case of first source directory
- begin
- Data.Naming.Casing := Casing;
- end;
+ if Last_Source_Dir = Nil_String then
+ Data.Source_Dirs := String_Elements.Last;
- exception
- when Constraint_Error =>
- if Casing_Image'Length = 0 then
- Error_Msg ("Casing cannot be an empty string",
- Casing_String.Location);
+ -- Here we already have source directories.
- else
- Name_Len := Casing_Image'Length;
- Name_Buffer (1 .. Name_Len) := Casing_Image;
- Error_Msg_Name_1 := Name_Find;
- Error_Msg
- ("{ is not a correct Casing",
- Casing_String.Location);
- end if;
- end;
- end if;
- end;
+ else
+ -- Link the previous last to the new one
- if Current_Verbosity = High then
- Write_Str (" Casing = ");
- Write_Str (Image (Data.Naming.Casing));
- Write_Char ('.');
- Write_Eol;
+ String_Elements.Table (Last_Source_Dir).Next :=
+ String_Elements.Last;
end if;
- -- Let's check Specification_Append
+ -- And register this source directory as the new last
- declare
- Specification_Append : constant Variable_Value :=
- Util.Value_Of
- (Name_Specification_Append,
- Naming.Decl.Attributes);
+ Last_Source_Dir := String_Elements.Last;
+ String_Elements.Table (Last_Source_Dir) := Element;
- begin
- pragma Assert (Specification_Append.Kind = Single,
- "Specification_Append is not a single string");
+ -- Now look for subdirectories
- if not Specification_Append.Default then
- String_To_Name_Buffer (Specification_Append.Value);
+ Open (Dir, The_Path (The_Path'First .. The_Path_Last));
- if Name_Len = 0 then
- Error_Msg ("Specification_Append cannot be empty",
- Specification_Append.Location);
+ loop
+ Read (Dir, Name, Last);
+ exit when Last = 0;
- 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;
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name (1 .. Last));
end if;
- end;
-
- if Current_Verbosity = High then
- Write_Str (" Specification_Append = """);
- Write_Str (Get_Name_String (Data.Naming.Specification_Append));
- Write_Line (""".");
- end if;
- -- Check Body_Append
+ if Name (1 .. Last) /= "."
+ and then Name (1 .. Last) /= ".."
+ then
+ -- Avoid . and ..
- declare
- Body_Append : constant Variable_Value :=
- Util.Value_Of
- (Name_Body_Append, Naming.Decl.Attributes);
+ declare
+ Path_Name : constant String :=
+ The_Path (The_Path'First .. The_Path_Last) &
+ Name (1 .. Last);
- begin
- pragma Assert (Body_Append.Kind = Single,
- "Body_Append is not a single string");
+ begin
+ if Is_Directory (Path_Name) then
- if not Body_Append.Default then
+ -- We have found a new subdirectory,
+ -- register it and find its own subdirectories.
- String_To_Name_Buffer (Body_Append.Value);
+ Start_String;
+ Store_String_Chars (Path_Name);
+ Recursive_Find_Dirs (End_String);
+ end if;
+ end;
+ end if;
+ end loop;
- if Name_Len = 0 then
- Error_Msg ("Body_Append cannot be empty",
- Body_Append.Location);
+ Close (Dir);
- else
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Body_Append := Name_Find;
- Data.Naming.Body_Append_Loc := Body_Append.Location;
+ exception
+ when Directory_Error =>
+ null;
+ end Recursive_Find_Dirs;
- -- As we have a new Body_Append, we set Separate_Append
- -- to the same value.
+ -- Start of processing for Find_Source_Dirs
- Data.Naming.Separate_Append := Data.Naming.Body_Append;
- Data.Naming.Sep_Append_Loc := Data.Naming.Body_Append_Loc;
- end if;
- end if;
- end;
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("Find_Source_Dirs (""");
+ end if;
- if Current_Verbosity = High then
- Write_Str (" Body_Append = """);
- Write_Str (Get_Name_String (Data.Naming.Body_Append));
- Write_Line (""".");
- end if;
+ String_To_Name_Buffer (From);
+ Directory := Name_Buffer (1 .. Name_Len);
+ Directory_Id := Name_Find;
- -- Check Separate_Append
+ if Current_Verbosity = High then
+ Write_Str (Directory);
+ Write_Line (""")");
+ end if;
- declare
- Separate_Append : constant Variable_Value :=
- Util.Value_Of
- (Name_Separate_Append,
- Naming.Decl.Attributes);
+ -- First, check if we are looking for a directory tree,
+ -- indicated by "/**" at the end.
- begin
- pragma Assert (Separate_Append.Kind = Single,
- "Separate_Append is not a single string");
+ 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 not Separate_Append.Default then
- String_To_Name_Buffer (Separate_Append.Value);
+ if Name_Len = 0 then
+ -- This is the case of "/**": all directories
+ -- in the file system.
- if Name_Len = 0 then
- Error_Msg ("Separate_Append cannot be empty",
- Separate_Append.Location);
+ Name_Len := 1;
+ Name_Buffer (1) := Directory (Directory'First);
- 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;
- end if;
- end;
+ else
+ Name_Buffer (1 .. Name_Len) :=
+ Directory (Directory'First .. Directory'Last - 3);
+ end if;
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_Str ("Looking for all subdirectories of """);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line ("""");
end if;
- -- Now, we check if Data.Naming is valid
+ declare
+ Base_Dir : constant Name_Id := Name_Find;
+ Root : constant Name_Id :=
+ Locate_Directory (Base_Dir, Data.Directory);
- Check_Naming_Scheme (Data.Naming);
- end if;
- end;
+ 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;
- -- If we have source directories, then let's find the sources.
+ else
+ -- We have an existing directory,
+ -- we register it and all of its subdirectories.
- if Data.Source_Dirs /= Nil_String then
- declare
- Sources : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Data.Decl.Attributes);
+ if Current_Verbosity = High then
+ Write_Line ("Looking for source directories:");
+ end if;
- Source_List_File : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_List_File,
- Data.Decl.Attributes);
+ Start_String;
+ Store_String_Chars (Get_Name_String (Root));
+ Recursive_Find_Dirs (End_String);
- 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);
+ if Current_Verbosity = High then
+ Write_Line ("End of looking for source directories.");
+ end if;
end if;
+ end;
- -- Sources is a list of file names
-
- declare
- Current_Source : String_List_Id := Nil_String;
- Current : String_List_Id := Sources.Values;
- Element : String_Element;
-
- begin
- while Current /= Nil_String loop
- Element := String_Elements.Table (Current);
- String_To_Name_Buffer (Element.Value);
+ -- We have a single directory
- declare
- File_Name : constant String :=
- Name_Buffer (1 .. Name_Len);
+ else
+ declare
+ Path_Name : constant Name_Id :=
+ Locate_Directory (Directory_Id, Data.Directory);
- 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;
+ 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
- -- No source_files specified.
- -- We check Source_List_File has been specified.
+ -- As it is an existing directory, we add it to
+ -- the list of directories.
- elsif not Source_List_File.Default then
+ String_Elements.Increment_Last;
+ Start_String;
+ Store_String_Chars (Get_Name_String (Path_Name));
+ Element.Value := End_String;
- -- Source_List_File is the name of the file
- -- that contains the source file names
+ if Last_Source_Dir = Nil_String then
- declare
- Source_File_Path_Name : constant String :=
- Path_Name_Of
- (Source_List_File.Value,
- Data.Directory);
+ -- This is the first source 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);
+ Data.Source_Dirs := String_Elements.Last;
else
- Get_Sources_From_File
- (Source_File_Path_Name,
- Source_List_File.Location);
- end if;
- end;
+ -- We already have source directories,
+ -- link the previous last to the new one.
- 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.
+ String_Elements.Table (Last_Source_Dir).Next :=
+ String_Elements.Last;
+ end if;
- Find_Sources;
- end if;
- end;
- end if;
+ -- And register this source directory as the new last
- Projects.Table (Project) := Data;
- end Check_Naming_Scheme;
+ Last_Source_Dir := String_Elements.Last;
+ String_Elements.Table (Last_Source_Dir) := Element;
+ end if;
+ end;
+ end if;
+ end Find_Source_Dirs;
- ---------------
- -- Error_Msg --
- ---------------
+ -- Start of processing for Language_Independent_Check
- procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
begin
- if Error_Report = null then
- Errout.Error_Msg (Msg, Flag_Location);
- else
- declare
- Error_Buffer : String (1 .. 5_000);
- Error_Last : Natural := 0;
- Msg_Name : Natural := 0;
- First : Positive := Msg'First;
+ if Data.Language_Independent_Checked then
+ return;
+ end if;
- procedure Add (C : Character);
- -- Add a character to the buffer
+ Data.Language_Independent_Checked := True;
- procedure Add (S : String);
- -- Add a string to the buffer
+ Error_Report := Report_Error;
- procedure Add (Id : Name_Id);
- -- Add a name to the buffer
+ if Current_Verbosity = High then
+ Write_Line ("Starting to look for directories");
+ end if;
- ---------
- -- Add --
- ---------
+ -- Let's check the object directory
- procedure Add (C : Character) is
- begin
- Error_Last := Error_Last + 1;
- Error_Buffer (Error_Last) := C;
- end Add;
+ declare
+ Object_Dir : Variable_Value :=
+ Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
- procedure Add (S : String) is
- begin
- Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
- Error_Last := Error_Last + S'Length;
- end Add;
+ begin
+ pragma Assert (Object_Dir.Kind = Single,
+ "Object_Dir is not a single string");
- procedure Add (Id : Name_Id) is
- begin
- Get_Name_String (Id);
- Add (Name_Buffer (1 .. Name_Len));
- end Add;
+ -- We set the object directory to its default
- 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;
+ Data.Object_Directory := Data.Directory;
- 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 ('"');
+ if not String_Equal (Object_Dir.Value, Empty_String) then
- case Msg_Name is
- when 1 => Add (Error_Msg_Name_1);
+ String_To_Name_Buffer (Object_Dir.Value);
- when 2 => Add (Error_Msg_Name_2);
+ if Name_Len = 0 then
+ Error_Msg ("Object_Dir cannot be empty",
+ Object_Dir.Location);
- when 3 => Add (Error_Msg_Name_3);
+ else
+ -- We check that the specified object directory
+ -- does exist.
- when others => null;
- end case;
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Add ('"');
+ declare
+ Dir_Id : constant Name_Id := Name_Find;
- else
- Add (Msg (Index));
- end if;
+ begin
+ Data.Object_Directory :=
+ Locate_Directory (Dir_Id, Data.Directory);
- end loop;
+ 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;
- Error_Report (Error_Buffer (1 .. Error_Last));
- 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;
- end Error_Msg;
- ---------------------
- -- Get_Name_String --
- ---------------------
+ -- Look for the source directories
- function Get_Name_String (S : String_Id) return String is
- begin
- if S = No_String then
- return "";
- else
- String_To_Name_Buffer (S);
- return Name_Buffer (1 .. Name_Len);
- end if;
- end Get_Name_String;
+ declare
+ Source_Dirs : Variable_Value :=
+ Util.Value_Of (Name_Source_Dirs, Data.Decl.Attributes);
- --------------
- -- Get_Unit --
- --------------
+ begin
- procedure Get_Unit
- (File_Name : Name_Id;
- Naming : Naming_Data;
- Unit_Name : out Name_Id;
- Unit_Kind : out Spec_Or_Body;
- Needs_Pragma : out Boolean)
- is
- Canonical_Case_Name : Name_Id;
+ if Current_Verbosity = High then
+ Write_Line ("Starting to look for source directories");
+ end if;
- begin
- Needs_Pragma := False;
- Get_Name_String (File_Name);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Canonical_Case_Name := Name_Find;
+ pragma Assert (Source_Dirs.Kind = List,
+ "Source_Dirs is not a list");
- if Naming.Bodies /= No_Array_Element then
+ if Source_Dirs.Default then
- -- There are some specified file names for some bodies
- -- of this project. Find out if File_Name is one of these bodies.
+ -- No Source_Dirs specified: the single source directory
+ -- is the one containing the project file
- declare
- Current : Array_Element_Id := Naming.Bodies;
- Element : Array_Element;
+ 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);
- begin
- while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
+ if Current_Verbosity = High then
+ Write_Line ("(Undefined) Single object directory:");
+ Write_Str (" """);
+ Write_Str (Get_Name_String (Data.Directory));
+ Write_Line ("""");
+ end if;
- if Element.Index /= No_Name then
- String_To_Name_Buffer (Element.Value.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ elsif Source_Dirs.Values = Nil_String then
- if Canonical_Case_Name = Name_Find then
+ -- If Source_Dirs is an empty string list, this means
+ -- that this project contains no source.
- -- File_Name corresponds to one body.
- -- So, we know it is a body, and we know the unit name.
+ if Data.Object_Directory = Data.Directory then
+ Data.Object_Directory := No_Name;
+ end if;
- Unit_Kind := Body_Part;
- Unit_Name := Element.Index;
- Needs_Pragma := True;
- return;
- end if;
- end if;
+ Data.Source_Dirs := Nil_String;
+ Data.Sources_Present := False;
- Current := Element.Next;
- end loop;
- end;
- end if;
+ else
+ declare
+ Source_Dir : String_List_Id := Source_Dirs.Values;
+ Element : String_Element;
- if Naming.Specifications /= No_Array_Element then
+ begin
+ -- We will find the source directories for each
+ -- element of the list
- -- There are some specified file names for some bodiesspecifications
- -- of this project. Find out if File_Name is one of these
- -- specifications.
+ 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 : Array_Element_Id := Naming.Specifications;
- Element : Array_Element;
+ Current : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
begin
- while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
-
- if Element.Index /= No_Name then
- String_To_Name_Buffer (Element.Value.Value);
+ 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));
-
- if Canonical_Case_Name = Name_Find then
-
- -- File_Name corresponds to one specification.
- -- So, we know it is a spec, and we know the unit name.
-
- Unit_Kind := Specification;
- Unit_Name := Element.Index;
- Needs_Pragma := True;
- return;
- end if;
-
+ 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 if;
+ end;
+
+ -- Library Dir, Name, Version and Kind
declare
- File : String := Get_Name_String (Canonical_Case_Name);
- First : Positive := File'First;
- Last : Natural := File'Last;
+ Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
- begin
- -- Check if the end of the file name is Specification_Append
+ Lib_Dir : Prj.Variable_Value :=
+ Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
- Get_Name_String (Naming.Specification_Append);
+ Lib_Name : Prj.Variable_Value :=
+ Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
- then
- -- We have a spec
+ Lib_Version : Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Version, Attributes);
- Unit_Kind := Specification;
- Last := Last - Name_Len;
+ 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_Str (" Specification: ");
- Write_Line (File (First .. Last));
+ Write_Line ("No library directory");
end if;
else
- Get_Name_String (Naming.Body_Append);
+ -- Find path name, check that it is a directory
- -- Check if the end of the file name is Body_Append
+ Stringt.String_To_Name_Buffer (Lib_Dir.Value);
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
- then
- -- We have a body
+ declare
+ Dir_Id : constant Name_Id := Name_Find;
- Unit_Kind := Body_Part;
- Last := Last - Name_Len;
+ begin
+ Data.Library_Dir :=
+ Locate_Directory (Dir_Id, Data.Directory);
- if Current_Verbosity = High then
- Write_Str (" Body: ");
- Write_Line (File (First .. Last));
+ 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;
- elsif Naming.Separate_Append /= Naming.Body_Append then
- Get_Name_String (Naming.Separate_Append);
+ pragma Assert (Lib_Name.Kind = Single);
- -- Check if the end of the file name is Separate_Append
+ if Lib_Name.Value = Empty_String then
+ if Current_Verbosity = High then
+ Write_Line ("No library name");
+ end if;
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
- then
- -- We have a separate (a body)
+ else
+ Stringt.String_To_Name_Buffer (Lib_Name.Value);
- Unit_Kind := Body_Part;
- Last := Last - Name_Len;
+ if not Is_Letter (Name_Buffer (1)) then
+ Error_Msg ("must start with a letter",
+ Lib_Name.Location);
- if Current_Verbosity = High then
- Write_Str (" Separate: ");
- Write_Line (File (First .. Last));
+ 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;
- else
- Last := 0;
+ 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;
-
- else
- Last := 0;
end if;
end if;
- if Last = 0 then
-
- -- This is not a source file
-
- Unit_Name := No_Name;
- Unit_Kind := Specification;
+ 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 (" Not a valid file name.");
+ Write_Line ("This is a library project file");
end if;
- return;
- end if;
+ pragma Assert (Lib_Version.Kind = Single);
- Get_Name_String (Naming.Dot_Replacement);
+ if Lib_Version.Value = Empty_String then
+ if Current_Verbosity = High then
+ Write_Line ("No library version specified");
+ end if;
- if Name_Buffer (1 .. Name_Len) /= "." then
+ else
+ Stringt.String_To_Name_Buffer (Lib_Version.Value);
+ Data.Lib_Internal_Name := Name_Find;
+ end if;
- -- If Dot_Replacement is not a single dot,
- -- then there should not be any dot in the name.
+ pragma Assert (The_Lib_Kind.Kind = Single);
- for Index in First .. Last loop
- if File (Index) = '.' then
- if Current_Verbosity = High then
- Write_Line
- (" Not a valid file name (some dot not replaced).");
- end if;
+ if The_Lib_Kind.Value = Empty_String then
+ if Current_Verbosity = High then
+ Write_Line ("No library kind specified");
+ end if;
- Unit_Name := No_Name;
- return;
+ else
+ Stringt.String_To_Name_Buffer (The_Lib_Kind.Value);
- end if;
- end loop;
+ declare
+ Kind_Name : constant String :=
+ To_Lower (Name_Buffer (1 .. Name_Len));
- -- Replace the substring Dot_Replacement with dots
+ OK : Boolean := True;
- declare
- Index : Positive := First;
+ begin
- begin
- while Index <= Last - Name_Len + 1 loop
+ if Kind_Name = "static" then
+ Data.Library_Kind := Static;
- if File (Index .. Index + Name_Len - 1) =
- Name_Buffer (1 .. Name_Len)
- then
- File (Index) := '.';
+ elsif Kind_Name = "dynamic" then
+ Data.Library_Kind := Dynamic;
- if Name_Len > 1 and then Index < Last then
- File (Index + 1 .. Last - Name_Len + 1) :=
- File (Index + Name_Len .. Last);
- end if;
+ elsif Kind_Name = "relocatable" then
+ Data.Library_Kind := Relocatable;
- Last := Last - Name_Len + 1;
+ else
+ Error_Msg
+ ("illegal value for Library_Kind",
+ The_Lib_Kind.Location);
+ OK := False;
end if;
- Index := Index + 1;
- end loop;
- end;
+ if Current_Verbosity = High and then OK then
+ Write_Str ("Library kind = ");
+ Write_Line (Kind_Name);
+ end if;
+ end;
+ end if;
end if;
+ end;
- -- Check if the casing is right
-
- declare
- Src : String := File (First .. Last);
+ if Current_Verbosity = High then
+ Show_Source_Dirs (Project);
+ end if;
- begin
- case Naming.Casing is
- when All_Lower_Case =>
- Fixed.Translate
- (Source => Src,
- Mapping => Lower_Case_Map);
+ declare
+ Naming_Id : constant Package_Id :=
+ Util.Value_Of (Name_Naming, Data.Decl.Packages);
- when All_Upper_Case =>
- Fixed.Translate
- (Source => Src,
- Mapping => Upper_Case_Map);
+ Naming : Package_Element;
- when Mixed_Case | Unknown =>
- null;
- end case;
+ begin
+ -- If there is a package Naming, we will put in Data.Naming
+ -- what is in this package Naming.
- if Src /= File (First .. Last) then
- if Current_Verbosity = High then
- Write_Line (" Not a valid file name (casing).");
- end if;
+ if Naming_Id /= No_Package then
+ Naming := Packages.Table (Naming_Id);
- Unit_Name := No_Name;
- return;
+ if Current_Verbosity = High then
+ Write_Line ("Checking ""Naming"".");
end if;
- -- We put the name in lower case
+ -- Check Specification_Suffix
- Fixed.Translate
- (Source => Src,
- Mapping => Lower_Case_Map);
+ Data.Naming.Specification_Suffix := Util.Value_Of
+ (Name_Specification_Suffix,
+ Naming.Decl.Arrays);
- if Current_Verbosity = High then
- Write_Str (" ");
- Write_Line (Src);
- end if;
+ declare
+ Current : Array_Element_Id := Data.Naming.Specification_Suffix;
+ Element : Array_Element;
- Name_Len := Src'Length;
- Name_Buffer (1 .. Name_Len) := Src;
+ begin
+ while Current /= No_Array_Element loop
+ Element := Array_Elements.Table (Current);
+ String_To_Name_Buffer (Element.Value.Value);
- -- Now, we check if this name is a valid unit name
+ if Name_Len = 0 then
+ Error_Msg
+ ("Specification_Suffix cannot be empty",
+ Element.Value.Location);
+ end if;
- Check_Naming_Scheme (Name => Name_Find, Unit => Unit_Name);
- end;
+ Array_Elements.Table (Current) := Element;
+ Current := Element.Next;
+ end loop;
+ end;
- end;
+ -- Check Implementation_Suffix
- end Get_Unit;
+ Data.Naming.Implementation_Suffix := Util.Value_Of
+ (Name_Implementation_Suffix,
+ Naming.Decl.Arrays);
- -----------------------
- -- Is_Illegal_Append --
- -----------------------
+ declare
+ Current : Array_Element_Id := Data.Naming.Implementation_Suffix;
+ Element : Array_Element;
- function Is_Illegal_Append (This : String) return Boolean is
- begin
- return This'Length = 0
- or else Is_Alphanumeric (This (This'First))
- or else (This'Length >= 2
- and then This (This'First) = '_'
- and then Is_Alphanumeric (This (This'First + 1)));
- end Is_Illegal_Append;
+ 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 --
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 :=
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);
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
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff