-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
-with Targparm; use Targparm;
with Ada; use Ada;
with Ada.Characters.Handling; use Ada.Characters.Handling;
Canonical_Case_File_Name (Suf);
-- 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
+ -- For instance a suffix "configure.ac" must match a file with the
-- same name. To avoid dummy cases, though, a suffix starting with
-- '.' requires a file that is at least one character longer ('.cpp'
-- should not match a file with the same name).
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
- if Lang_Index /= No_Language_Index then
+ if Lang_Index /= No_Language_Index
+ and then Element.Value.Kind = Single
+ and then Element.Value.Value /= No_Name
+ then
case Current_Array.Name is
when Name_Spec_Suffix | Name_Specification_Suffix =>
if Data.Flags.Compiler_Driver_Mandatory
and then Lang_Index.Config.Compiler_Driver = No_File
+ and then not Project.Externally_Built
then
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
- "?no compiler specified for language %%" &
+ "?\no compiler specified for language %%" &
", ignoring all its sources",
No_Location, Project);
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
Error_Msg
(Data.Flags,
- "Spec_Suffix not specified for " &
+ "\Spec_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
Error_Msg
(Data.Flags,
- "Body_Suffix not specified for " &
+ "\Body_Suffix not specified for " &
Get_Name_String (Lang_Index.Name),
No_Location, Project);
end if;
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Data.Flags,
- "no suffixes specified for %%",
+ "\no suffixes specified for %%",
No_Location, Project);
end if;
end if;
-- Check if an imported or extended project if also a library project
procedure Check_Aggregate_Library_Dirs;
+ -- Check that the library directory and the library ALI directory of an
+ -- aggregate library project are not the same as the object directory or
+ -- the library directory of any of its aggregated projects.
----------------------------------
-- Check_Aggregate_Library_Dirs --
procedure Check_Aggregate_Library_Dirs is
procedure Process_Aggregate (Proj : Project_Id);
+ -- Recursive procedure to check the aggregated projects, as they may
+ -- also be aggregated library projects.
- procedure Process_Aggregate (Proj : Project_Id) is
+ -----------------------
+ -- Process_Aggregate --
+ -----------------------
- Agg : Aggregated_Project_List := Proj.Aggregated_Projects;
+ procedure Process_Aggregate (Proj : Project_Id) is
+ Agg : Aggregated_Project_List;
begin
+ Agg := Proj.Aggregated_Projects;
while Agg /= null loop
Error_Msg_Name_1 := Agg.Project.Name;
- if Agg.Project.Qualifier /= Aggregate_Library and then
- Project.Library_ALI_Dir.Name
- = Agg.Project.Object_Directory.Name
+ if Agg.Project.Qualifier /= Aggregate_Library
+ and then Project.Library_ALI_Dir.Name =
+ Agg.Project.Object_Directory.Name
then
Error_Msg
(Data.Flags,
& " object directory of aggregated project %%",
The_Lib_Kind.Location, Project);
- elsif Project.Library_ALI_Dir.Name
- = Agg.Project.Library_Dir.Name
+ elsif Project.Library_ALI_Dir.Name =
+ Agg.Project.Library_Dir.Name
then
Error_Msg
(Data.Flags,
& " library directory of aggregated project %%",
The_Lib_Kind.Location, Project);
- elsif Agg.Project.Qualifier /= Aggregate_Library and then
- Project.Library_Dir.Name
- = Agg.Project.Object_Directory.Name
+ elsif Agg.Project.Qualifier /= Aggregate_Library
+ and then Project.Library_Dir.Name =
+ Agg.Project.Object_Directory.Name
then
Error_Msg
(Data.Flags,
& " object directory of aggregated project %%",
The_Lib_Kind.Location, Project);
- elsif Project.Library_Dir.Name
- = Agg.Project.Library_Dir.Name
+ elsif Project.Library_Dir.Name =
+ Agg.Project.Library_Dir.Name
then
Error_Msg
(Data.Flags,
end loop;
end Process_Aggregate;
+ -- Start of processing for Check_Aggregate_Library_Dirs
+
begin
if Project.Qualifier = Aggregate_Library then
Process_Aggregate (Project);
if Switches /= No_Array_Element then
Error_Msg
(Data.Flags,
- "?Linker switches not taken into account in library " &
+ "?\Linker switches not taken into account in library " &
"projects",
No_Location, Project);
end if;
Shared => Shared);
end if;
- if Suffix /= Nil_Variable_Value then
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
Lang_Id.Config.Naming_Data.Spec_Suffix :=
File_Name_Type (Suffix.Value);
Shared => Shared);
end if;
- if Suffix /= Nil_Variable_Value then
+ if Suffix /= Nil_Variable_Value
+ and then Suffix.Value /= No_Name
+ then
Lang_Id.Config.Naming_Data.Body_Suffix :=
File_Name_Type (Suffix.Value);
then
Error_Msg
(Data.Flags,
- "Library_Standalone valid only if Library_Interface is set",
+ "Library_Standalone valid only if library has Ada interfaces",
Lib_Standalone.Location, Project);
end if;
if OK then
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
OK := False;
exit;
end if;
Name_Len := The_Name'Length;
Name_Buffer (1 .. Name_Len) := The_Name;
- -- Special cases of children of packages A, G, I and S on VMS
-
- if OpenVMS_On_Target
- and then Name_Len > 3
- and then Name_Buffer (2 .. 3) = "__"
- and then
- (Name_Buffer (1) = 'a' or else
- Name_Buffer (1) = 'g' or else
- Name_Buffer (1) = 'i' or else
- Name_Buffer (1) = 's')
- then
- Name_Buffer (2) := '.';
- Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
- Name_Len := Name_Len - 1;
- end if;
-
Real_Name := Name_Find;
if Is_Reserved (Real_Name) then
function Compute_Directory_Last (Dir : String) return Natural is
begin
if Dir'Length > 1
- and then (Dir (Dir'Last - 1) = Directory_Separator
- or else
- Dir (Dir'Last - 1) = '/')
+ and then Is_Directory_Separator (Dir (Dir'Last - 1))
then
return Dir'Last - 1;
else
Dir_Exists : Boolean;
No_Sources : constant Boolean :=
- ((not Source_Files.Default
- and then Source_Files.Values = Nil_String)
- or else (not Source_Dirs.Default
- and then Source_Dirs.Values = Nil_String)
- or else (not Languages.Default
- and then Languages.Values = Nil_String))
- and then Project.Extends = No_Project;
+ Project.Qualifier = Abstract_Project
+ or else (((not Source_Files.Default
+ and then Source_Files.Values = Nil_String)
+ or else
+ (not Source_Dirs.Default
+ and then Source_Dirs.Values = Nil_String)
+ or else
+ (not Languages.Default
+ and then Languages.Values = Nil_String))
+ and then Project.Extends = No_Project);
-- Start of processing for Get_Directories
end if;
end if;
- elsif not No_Sources and then Subdirs /= null then
+ elsif not No_Sources
+ and then (Subdirs /= null or else Build_Tree_Dir /= null)
+ then
Name_Len := 1;
Name_Buffer (1) := '.';
Locate_Directory
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/' or else Line (J) = Directory_Separator then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Source_Name;
Error_Msg
(Data.Flags,
The_Name : File_Name_Type;
begin
- Get_Name_String (Name);
+ -- Check if we have a root-object dir specified, if so relocate all
+ -- artefact directories to it.
+
+ if Build_Tree_Dir /= null
+ and then Create /= ""
+ and then not Is_Absolute_Path (Get_Name_String (Name))
+ then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
+
+ if The_Parent_Last - The_Parent'First + 1 < Root_Dir'Length then
+ Err_Vars.Error_Msg_File_1 := Name;
+ Error_Or_Warning
+ (Data.Flags, Error,
+ "{ cannot relocate deeper than " & Create & " directory",
+ No_Location, Project);
+ end if;
+
+ Add_Str_To_Name_Buffer
+ (Relative_Path
+ (The_Parent (The_Parent'First .. The_Parent_Last),
+ Root_Dir.all));
+ Add_Str_To_Name_Buffer (Get_Name_String (Name));
+
+ else
+ if Build_Tree_Dir /= null and then Create /= "" then
+
+ -- Issue a warning that we cannot relocate absolute obj dir
+
+ Err_Vars.Error_Msg_File_1 := Name;
+ Error_Or_Warning
+ (Data.Flags, Warning,
+ "{ cannot relocate absolute object directory",
+ No_Location, Project);
+ end if;
+
+ Get_Name_String (Name);
+ end if;
-- Add Subdirs.all if it is a directory that may be created and
-- Subdirs is not null;
Dir_Exists := Is_Directory (Full_Path_Name.all);
- if not Must_Exist or else Dir_Exists then
+ if not Must_Exist or Dir_Exists then
declare
Normed : constant String :=
Normalize_Pathname
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/'
- or else Line (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
- "file name cannot include " &
- "directory information ({)",
+ "file name cannot include "
+ & "directory information ({)",
Location, Project.Project);
exit;
end if;
-- Check that there is no directory information
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
- "source file %% for unit %% not found",
+ "\source file %% for unit %% not found",
No_Location, Project.Project);
end if;
end if;
if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
declare
Path_Name : constant String :=
- Normalize_Pathname
- (Name => Name (1 .. Last),
- Directory => Path_Str,
- Resolve_Links => Resolve_Links)
- & Directory_Separator;
+ Normalize_Pathname
+ (Name => Name (1 .. Last),
+ Directory => Path_Str,
+ Resolve_Links => Resolve_Links)
+ & Directory_Separator;
Path2 : Path_Information;
OK : Boolean := True;
if Search_For = Search_Files then
while Pattern_End >= Pattern'First
- and then Pattern (Pattern_End) /= '/'
- and then Pattern (Pattern_End) /= Directory_Separator
+ and then not Is_Directory_Separator (Pattern (Pattern_End))
loop
Pattern_End := Pattern_End - 1;
end loop;
Recursive :=
Pattern_End - 1 >= Pattern'First
and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
- and then (Pattern_End - 1 = Pattern'First
- or else Pattern (Pattern_End - 2) = '/'
- or else Pattern (Pattern_End - 2) = Directory_Separator);
+ and then
+ (Pattern_End - 1 = Pattern'First
+ or else Is_Directory_Separator (Pattern (Pattern_End - 2)));
if Recursive then
Pattern_End := Pattern_End - 2;
declare
Source_Directory : constant String :=
Get_Name_String (Element.Value)
- & Directory_Separator;
+ & Directory_Separator;
Dir_Last : constant Natural :=
Compute_Directory_Last (Source_Directory);
Error_Msg_File_1 := Source.File;
Error_Msg
(Data.Flags,
- "{ cannot be both excluded and an exception file name",
+ "\{ cannot be both excluded and an exception file name",
No_Location, Project.Project);
end if;
if Source /= No_Source
and then Source.Replaced_By = No_Source
and then Source.Path /= Src.Path
+ and then Source.Index = 0
+ and then Src.Index = 0
and then Is_Extending (Src.Project, Source.Project)
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Error_Msg
(Data.Flags,
- "{ and { have the same object file name",
+ "\{ and { have the same object file name",
No_Location, Project.Project);
else
Show_Source_Dirs (Project, Shared);
end if;
- if Project.Qualifier = Dry then
+ if Project.Qualifier = Abstract_Project then
Check_Abstract_Project (Project, Data);
end if;
end case;