Key => Name_Id,
Hash => Hash,
Equal => "=");
- -- Hash table to store recursive source directories, to avoid looking
- -- several times, and to avoid cycles that may be introduced by symbolic
- -- links.
+ -- Hash table stores recursive source directories, to avoid looking several
+ -- times, and to avoid cycles that may be introduced by symbolic links.
type Ada_Naming_Exception_Id is new Nat;
No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
Unit : out Name_Id;
Lang_Kind : out Language_Kind;
Kind : out Source_Kind);
- -- Check if the file name File_Name conforms to one of the naming
- -- schemes of the project.
- --
- -- If the file does not match one of the naming schemes, set Language
- -- to No_Language_Index.
- --
- -- Filename is the name of the file being investigated. It has been
- -- normalized (case-folded). File_Name is the same value.
+ -- Check if the file name File_Name conforms to one of the naming schemes
+ -- of the project. If the file does not match one of the naming schemes,
+ -- set Language to No_Language_Index. Filename is the name of the file
+ -- being investigated. It has been normalized (case-folded). File_Name is
+ -- the same value.
procedure Free_Ada_Naming_Exceptions;
-- Free the internal hash tables used for checking naming exceptions
In_Tree : Project_Tree_Ref;
Current_Dir : String);
-- Get the object directory, the exec directory and the source directories
- -- of a project.
- --
- -- Current_Dir should represent the current directory, and is passed for
- -- efficiency to avoid system calls to recompute it.
+ -- of a project. Current_Dir should represent the current directory, and is
+ -- passed for efficiency to avoid system calls to recompute it.
procedure Get_Mains
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean);
- -- Process the Source_Files and Source_List_File attributes, and store
- -- the list of source files into the Source_Names htable.
- -- When these attributes are not defined, find all files matching the
- -- naming schemes in the source directories.
- -- If Allow_Duplicate_Basenames, then files with the same base names are
- -- authorized within a project for source-based languages (never for unit
- -- based languages)
+ -- Process the Source_Files and Source_List_File attributes, and store the
+ -- list of source files into the Source_Names htable. When these attributes
+ -- are not defined, find all files matching the naming schemes in the
+ -- source directories. If Allow_Duplicate_Basenames, then files with the
+ -- same base names are authorized within a project for source-based
+ -- languages (never for unit based languages)
procedure Compute_Unit_Name
(File_Name : File_Name_Type;
Location : Source_Ptr := No_Location;
Must_Exist : Boolean := True;
Externally_Built : Boolean := False);
- -- Locate a directory. Name is the directory name.
- -- Relative paths are resolved relative to the project's directory.
- -- If the directory does not exist and Setup_Projects
- -- is True and Create is a non null string, an attempt is made to create
- -- the directory.
- -- If the directory does not exist, it is either created if Setup_Projects
- -- is False (and then returned), or simply returned without checking for
- -- its existence (if Must_Exist is False) or No_Path_Information is
- -- returned. In all cases, Dir_Exists indicates whether the directory now
- -- exists.
- --
- -- Create is also used for debugging traces to show which path we are
+ -- Locate a directory. Name is the directory name. Relative paths are
+ -- resolved relative to the project's directory. If the directory does not
+ -- exist and Setup_Projects is True and Create is a non null string, an
+ -- attempt is made to create the directory. If the directory does not
+ -- exist, it is either created if Setup_Projects is False (and then
+ -- returned), or simply returned without checking for its existence (if
+ -- Must_Exist is False) or No_Path_Information is returned. In all cases,
+ -- Dir_Exists indicates whether the directory now exists. Create is also
+ -- used for debugging traces to show which path we are
-- computing
procedure Look_For_Sources
Suffix : File_Name_Type) return Boolean
is
Min_Prefix_Length : Natural := 0;
+
begin
if Suffix = No_File or else Suffix = Empty_File then
return False;
declare
Suf : constant String := Get_Name_String (Suffix);
- begin
+ begin
-- The file name must end with the suffix (which is not an extension)
-- For instance a suffix "configure.in" must match a file with the
-- same name. To avoid dummy cases, though, a suffix starting with
Index : Int := 0;
Source_To_Replace : Source_Id := No_Source)
is
- Config : constant Language_Config := Lang_Id.Config;
- UData : Unit_Index;
+ Config : constant Language_Config := Lang_Id.Config;
+ UData : Unit_Index;
begin
Id := new Source_Data;
if Lang_Id.Config.Kind = Unit_Based then
Write_Str (" Unit: ");
+
-- ??? in gprclean, it seems we sometimes pass an empty Unit name
- -- (see test extended_projects)
+ -- (see test extended_projects).
+
if Unit /= No_Name then
Write_Str (Get_Name_String (Unit));
end if;
+
Write_Str (" Kind: ");
Write_Str (Source_Kind'Image (Kind));
end if;
UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
if UData = No_Unit_Index then
- UData := new Unit_Data;
+ UData := new Unit_Data;
UData.Name := Unit;
Units_Htable.Set (In_Tree.Units_HT, Unit, UData);
end if;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean)
is
- Specs : Array_Element_Id;
- Bodies : Array_Element_Id;
+ Specs : Array_Element_Id;
+ Bodies : Array_Element_Id;
Extending : Boolean := False;
begin
else
Error_Msg
(Project, In_Tree,
- "at least one of Source_Files, Source_Dirs or Languages " &
- "must be declared empty for an abstract project",
+ "at least one of Source_Files, Source_Dirs or Languages "
+ & "must be declared empty for an abstract project",
Project.Location);
end if;
end;
(not Extending)
then
declare
- Language : Language_Ptr;
- Source : Source_Id;
- Alt_Lang : Language_List;
- Continuation : Boolean := False;
- Iter : Source_Iterator;
+ Language : Language_Ptr;
+ Source : Source_Id;
+ Alt_Lang : Language_List;
+ Continuation : Boolean := False;
+ Iter : Source_Iterator;
begin
Language := Project.Languages;
while Language /= No_Language_Index loop
- -- If there are no sources for this language, check whether
- -- there are sources for which this is an alternate
- -- language.
+ -- If there are no sources for this language, check if there
+ -- are sources for which this is an alternate language.
if Language.First_Source = No_Source then
Iter := For_Each_Source (In_Tree => In_Tree,
elsif The_Name (Index) = '.' then
-- First, check if the name before the dot is not a reserved word
+
if Is_Reserved (The_Name (First .. Index - 1)) then
return;
end if;
Current_Array : Array_Data;
Element_Id : Array_Element_Id;
Element : Array_Element;
+
begin
-- Process the associative array attribute of package Naming
end loop;
end Process_Project_Level_Array_Attributes;
+ -- Start of processing for Check_Configuration
+
begin
Process_Project_Level_Simple_Attributes;
Process_Project_Level_Array_Attributes;
Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
+
-- For all languages, Compiler_Driver needs to be specified. This is
-- only needed if we do intend to compile (not in GPS for instance).
Project_2 := Project;
while Project_2 /= No_Project loop
Iter := For_Each_Source (In_Tree, Project_2);
-
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
declare
Casing_Image : constant String :=
Get_Name_String (Casing_String.Value);
+
begin
if Casing_Image'Length = 0 then
Error_Msg
procedure Check_Naming_Ada_Only is
Ada : constant Language_Ptr :=
- Get_Language_From_Name (Project, "ada");
+ Get_Language_From_Name (Project, "ada");
Casing_Defined : Boolean;
Sep_Suffix_Loc : Source_Ptr;
-- For all unit based languages, if any, set the specified value
-- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
-- systematically overwrite, since the defaults come from the
- -- configuration file
+ -- configuration file.
if Dot_Replacement /= No_File
or else Casing_Defined
end if;
end if;
- -- If the language was not found in project or the projects it
- -- extends
+ -- If language was not found in project or the projects it extends
if Lang = null then
if Current_Verbosity = High then
end if;
if not Dir_Exists then
+
-- Get the absolute name of the library directory that
-- does not exist, to report an error.
Externally_Built => Project.Externally_Built);
if not Dir_Exists then
+
-- Get the absolute name of the library ALI directory that
-- does not exist, to report an error.
elsif Current_Verbosity = High then
- -- Display the Library ALI directory in high
- -- verbosity.
+ -- Display Library ALI directory in high verbosity
Write_Attr
("Library ALI dir",
-- Add a new language to the list of languages for the project.
-- Nothing is done if the language has already been defined
+ ------------------
+ -- Add_Language --
+ ------------------
+
procedure Add_Language (Name, Display_Name : Name_Id) is
- Lang : Language_Ptr := Project.Languages;
+ Lang : Language_Ptr;
+
begin
+ Lang := Project.Languages;
while Lang /= No_Language_Index loop
if Name = Lang.Name then
return;
Lang.Config.Dependency_Kind := ALI_File;
if Get_Mode = Ada_Only then
+
-- Create a default config for Ada (since there is no
- -- configuration file to create it for us)
- -- ??? We should do as GPS does and create a dummy config
- -- file
+ -- configuration file to create it for us).
+
+ -- ??? We should do as GPS does and create a dummy config file
Lang.Config.Naming_Data :=
(Dot_Replacement => File_Name_Type
if Source /= No_Source then
if Source.Kind = Sep then
Source := No_Source;
+
elsif Source.Kind = Spec
and then Other_Part (Source) /= No_Source
then
if Lib_Src_Dir.Value /= Empty_String then
declare
- Dir_Id : constant File_Name_Type :=
- File_Name_Type (Lib_Src_Dir.Value);
+ Dir_Id : constant File_Name_Type :=
+ File_Name_Type (Lib_Src_Dir.Value);
Dir_Exists : Boolean;
begin
-- If directory does not exist, report an error
if not Dir_Exists then
+
-- Get the absolute name of the library directory that does
-- not exist, to report an error.
begin
if Dir'Length > 1
and then (Dir (Dir'Last - 1) = Directory_Separator
- or else Dir (Dir'Last - 1) = '/')
+ or else Dir (Dir'Last - 1) = '/')
then
return Dir'Last - 1;
else
Write_Line (The_Path (The_Path'First .. The_Path_Last));
end if;
- String_Element_Table.Increment_Last
- (In_Tree.String_Elements);
+ String_Element_Table.Increment_Last (In_Tree.String_Elements);
Element :=
(Value => Canonical_Path,
Display_Value => Non_Canonical_Path,
-- Case of first source directory
if Last_Source_Dir = Nil_String then
- Project.Source_Dirs := String_Element_Table.Last
- (In_Tree.String_Elements);
+ Project.Source_Dirs :=
+ String_Element_Table.Last (In_Tree.String_Elements);
-- Here we already have source directories
In_Tree.String_Elements.Table
(Last_Source_Dir).Next :=
- String_Element_Table.Last
- (In_Tree.String_Elements);
+ String_Element_Table.Last (In_Tree.String_Elements);
end if;
-- And register this source directory as the new last
- Last_Source_Dir := String_Element_Table.Last
- (In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Last_Source_Dir) :=
- Element;
+ Last_Source_Dir :=
+ String_Element_Table.Last (In_Tree.String_Elements);
+ In_Tree.String_Elements.Table (Last_Source_Dir) := Element;
elsif Removed and Found then
if Prev = Nil_String then
else
declare
- Path_Name : Path_Information;
- List : String_List_Id;
- Prev : String_List_Id;
- Dir_Exists : Boolean;
+ Path_Name : Path_Information;
+ List : String_List_Id;
+ Prev : String_List_Id;
+ Dir_Exists : Boolean;
begin
Locate_Directory
-- However, even when it doesn't exist, we set it to a default
-- value. This is for the benefit of tools that recover from
-- errors; for example, these tools could create the non existent
- -- directory.
- -- We always return an absolute directory name though
+ -- directory. We always return an absolute directory name though.
Locate_Directory
(Project,
pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
- if (not Source_Files.Default) and then
- Source_Files.Values = Nil_String
+ if (not Source_Files.Default)
+ and then Source_Files.Values = Nil_String
then
Project.Source_Dirs := Nil_String;
elsif Source_Dirs.Default then
-- No Source_Dirs specified: the single source directory is the one
- -- containing the project file
+ -- containing the project file.
String_Element_Table.Append (In_Tree.String_Elements,
(Value => Name_Id (Project.Directory.Name),
Flag => False,
Next => Nil_String,
Index => 0));
- Project.Source_Dirs := String_Element_Table.Last
- (In_Tree.String_Elements);
+ Project.Source_Dirs :=
+ String_Element_Table.Last (In_Tree.String_Elements);
if Current_Verbosity = High then
Write_Attr
Unit : out Name_Id;
In_Tree : Project_Tree_Ref)
is
- Filename : constant String := Get_Name_String (File_Name);
- Last : Integer := Filename'Last;
+ Filename : constant String := Get_Name_String (File_Name);
+ Last : Integer := Filename'Last;
Sep_Len : constant Integer :=
Integer (Length_Of_Name (Naming.Separate_Suffix));
Body_Len : constant Integer :=
Unit_Kind := Spec;
else
Compute_Unit_Name
- (File_Name => Canonical_File_Name,
- Naming => Lang.Config.Naming_Data,
- Kind => Kind,
- Unit => Unit_Name,
- In_Tree => In_Tree);
+ (File_Name => Canonical_File_Name,
+ Naming => Lang.Config.Naming_Data,
+ Kind => Kind,
+ Unit => Unit_Name,
+ In_Tree => In_Tree);
case Kind is
when Spec => Unit_Kind := Spec;
Locally_Removed : Boolean := False;
begin
- -- If Excluded_Source_Files is not declared, check
- -- Locally_Removed_Files.
+ -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
if Excluded_Sources.Default then
Locally_Removed := True;
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
-- Check that there is no directory information
Proc_Data : in out Processing_Data;
Allow_Duplicate_Basenames : Boolean)
is
- Sources : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Project.Decl.Attributes,
- In_Tree);
+ Sources : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files,
+ Project.Decl.Attributes,
+ In_Tree);
+
Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Source_List_File,
Project.Decl.Attributes,
In_Tree);
- Name_Loc : Name_Location;
+ Name_Loc : Name_Location;
Has_Explicit_Sources : Boolean;
begin
and then Source.Path = No_Path_Information
then
if Source.Unit /= No_Unit_Index then
- Error_Msg_Name_1 := Name_Id (Source.Display_File);
- Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
- Error_Msg
- (Project, In_Tree,
- "source file %% for unit %% not found",
- No_Location);
+
+ -- ??? Current limitation of gprbuild will display this
+ -- error message for multi-unit source files, because not
+ -- all instances of the file have had their path fully set.
+
+ if Source.Index = 0
+ or else Source.Index = 1
+ then
+ Error_Msg_Name_1 := Name_Id (Source.Display_File);
+ Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
+ Error_Msg
+ (Project, In_Tree,
+ "source file %% for unit %% not found",
+ No_Location);
+ end if;
end if;
Remove_Source (Source, No_Source);
-- ??? We could probably optimize the following call: we
-- need to resolve links only once for the directory itself,
-- and then do a single call to readlink() for each file.
- -- Unfortunately that would require a change in
- -- Normalize_Pathname so that it has the option of not
- -- resolving links for its Directory parameter, only for
- -- Name.
+ -- Unfortunately that would require Normalize_Pathname to
+ -- be changed so that it has the option of not resolving
+ -- links for its Directory parameter, only for Name.
Path : constant String :=
Normalize_Pathname
or else
(Unit = No_Name and then Source.File = File_Name)
then
- -- Duplication of file/unit in same project is only
- -- allowed if order of source directories is known.
+ -- Duplication of file/unit in same project is only allowed
+ -- if order of source directories is known.
if Project = Source.Project then
if Unit = No_Name then
exit when Last = 0;
- -- ??? Duplicate system call here, we just did a
- -- a similar one. Maybe Ada.Directories would be more
- -- appropriate here
+ -- ??? Duplicate system call here, we just did a a
+ -- similar one. Maybe Ada.Directories would be more
+ -- appropriate here.
if Is_Regular_File
- (Source_Directory & Name (1 .. Last))
+ (Source_Directory & Name (1 .. Last))
then
if Current_Verbosity = High then
Write_Str (" Checking ");
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (UData.File_Names (Unit_Kind).Path.Name);
Error_Msg
- (Project, In_Tree,
- "\ project file %%, {", The_Location);
+ (Project, In_Tree, "\ project file %%, {", The_Location);
Err_Vars.Error_Msg_Name_1 := Project.Name;
Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path);
if To_Record then
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
Add_Source
- (Id => Source,
- In_Tree => In_Tree,
- Project => Project,
- Lang_Id => Ada_Language,
- File_Name => Canonical_File,
- Display_File => File_Name,
- Unit => Unit_Name,
- Path => (Canonical_Path, Path_Name),
- Naming_Exception => Needs_Pragma,
- Kind => Unit_Kind,
- Index => Unit_Ind);
+ (Id => Source,
+ In_Tree => In_Tree,
+ Project => Project,
+ Lang_Id => Ada_Language,
+ File_Name => Canonical_File,
+ Display_File => File_Name,
+ Unit => Unit_Name,
+ Path => (Canonical_Path, Path_Name),
+ Naming_Exception => Needs_Pragma,
+ Kind => Unit_Kind,
+ Index => Unit_Ind);
Source_Recorded := True;
end if;
end Record_Unit;
OSDN Git Service
