prj-nmsc.adb (Expand_Subdirectory_Pattern): Check that the prefix in a "**" pattern properly exists...

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Expand_Subdirectory_Pattern): Check that the prefix in
	a "**" pattern properly exists, and report an error otherwise.

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* prj-env.ads: Use GNAT.OS_Lib rather than System.OS_Lib.

From-SVN: r164971
This commit is contained in:
Emmanuel Briot 2010-10-05 09:32:05 +00:00 committed by Arnaud Charlet
parent c5be6c3a9d
commit eada5fd1cf
3 changed files with 87 additions and 99 deletions

View File

@ -1,3 +1,12 @@
2010-10-05 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Expand_Subdirectory_Pattern): Check that the prefix in
a "**" pattern properly exists, and report an error otherwise.
2010-10-05 Emmanuel Briot <briot@adacore.com>
* prj-env.ads: Use GNAT.OS_Lib rather than System.OS_Lib.
2010-10-05 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb, prj-err.adb (Expand_Subdirectory_Pattern): New

View File

@ -27,7 +27,7 @@
-- to the environment (configuration pragma files, path files, mapping files).
with GNAT.Dynamic_HTables;
with System.OS_Lib;
with GNAT.OS_Lib;
package Prj.Env is
@ -216,7 +216,7 @@ private
Equal => "=");
type Project_Search_Path is record
Path : System.OS_Lib.String_Access;
Path : GNAT.OS_Lib.String_Access;
-- As a special case, if the first character is '#:" or this variable is
-- unset, this means that the PATH has not been fully initialized yet
-- (although subprograms above will properly take care of that).

View File

@ -6692,9 +6692,6 @@ package body Prj.Nmsc is
Resolve_Links : Boolean)
is
pragma Unreferenced (Search_For);
Project_Dir : constant String :=
Get_Name_String (Project.Directory.Display_Name);
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
@ -6715,6 +6712,16 @@ package body Prj.Nmsc is
procedure Recursive_Find_Dirs (Normalized_Path : String; Rank : Natural);
-- Search all the subdirectories (recursively) of Path
procedure Check_Directory_And_Subdirs
(Directory : String;
Include_Subdirs : Boolean;
Rank : Natural;
Location : Source_Ptr);
-- Make sur that Directory exists (and if not report an error/warning
-- message depending on the flags.
-- Calls Callback for Directory itself and all its subdirectories if
-- Include_Subdirs is True).
-------------------------
-- Recursive_Find_Dirs --
-------------------------
@ -6788,6 +6795,64 @@ package body Prj.Nmsc is
null;
end Recursive_Find_Dirs;
---------------------------------
-- Check_Directory_And_Subdirs --
---------------------------------
procedure Check_Directory_And_Subdirs
(Directory : String;
Include_Subdirs : Boolean;
Rank : Natural;
Location : Source_Ptr)
is
Dir : File_Name_Type;
Path_Name : Path_Information;
Dir_Exists : Boolean;
Has_Error : Boolean := False;
begin
Name_Len := Directory'Length;
Name_Buffer (1 .. Name_Len) := Directory;
Dir := Name_Find;
Locate_Directory
(Project => Project,
Name => Dir,
Path => Path_Name,
Dir_Exists => Dir_Exists,
Data => Data,
Must_Exist => False);
if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := Dir;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"{ is not a valid directory", Location, Project);
Has_Error := Data.Flags.Missing_Source_Files = Error;
end if;
if not Has_Error then
-- Links have been resolved if necessary, and Path_Name
-- always ends with a directory separator.
if Include_Subdirs then
if Current_Verbosity = High then
Write_Str ("Looking for all subdirectories of """);
Write_Str (Directory);
Write_Line ("""");
end if;
Recursive_Find_Dirs (Get_Name_String (Path_Name.Name), Rank);
if Current_Verbosity = High then
Write_Line ("End of looking for source directories.");
end if;
else
Callback (Path_Name.Name, Path_Name.Display_Name, Rank);
end if;
end if;
end Check_Directory_And_Subdirs;
------------------
-- Find_Pattern --
------------------
@ -6809,104 +6874,18 @@ package body Prj.Nmsc is
and then (Pattern (Pattern'Last - 2) = '/'
or else Pattern (Pattern'Last - 2) = Directory_Separator)
then
Name_Len := Pattern'Length - 3;
if Name_Len = 0 then
if Pattern'Length = 3 then
-- Case of "/**": all directories in file system
Name_Len := 1;
Name_Buffer (1) := Pattern (Pattern'First);
Check_Directory_And_Subdirs
(Pattern (Pattern'First .. Pattern'First),
True, Rank, Location);
else
Name_Buffer (1 .. Name_Len) :=
Pattern (Pattern'First .. Pattern'Last - 3);
Check_Directory_And_Subdirs
(Pattern (Pattern'First .. Pattern'Last - 3),
True, Rank, Location);
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 File_Name_Type := Name_Find;
Root_Dir : constant String :=
Normalize_Pathname
(Name => Name_Buffer (1 .. Name_Len),
Directory => Project_Dir,
Resolve_Links => Resolve_Links);
Has_Error : Boolean := False;
begin
if Root_Dir'Length = 0 then
Err_Vars.Error_Msg_File_1 := Base_Dir;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"{ is not a valid directory.", Location, Project);
Has_Error := Data.Flags.Missing_Source_Files = Error;
end if;
if not Has_Error then
-- 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;
if Root_Dir (Root_Dir'Last) /= Directory_Separator then
Recursive_Find_Dirs
(Root_Dir & Directory_Separator, Rank);
else
Recursive_Find_Dirs (Root_Dir, Rank);
end if;
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
Directory : File_Name_Type;
Path_Name : Path_Information;
Dir_Exists : Boolean;
Has_Error : Boolean := False;
begin
Name_Len := Pattern'Length;
Name_Buffer (1 .. Name_Len) := Pattern;
Directory := Name_Find;
Locate_Directory
(Project => Project,
Name => Directory,
Path => Path_Name,
Dir_Exists => Dir_Exists,
Data => Data,
Must_Exist => False);
if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := Directory;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"{ is not a valid directory", Location, Project);
Has_Error := Data.Flags.Missing_Source_Files = Error;
end if;
if not Has_Error then
-- Links have been resolved if necessary, and Path_Name
-- always ends with a directory separator.
Callback (Path_Name.Name, Path_Name.Display_Name, Rank);
end if;
end;
Check_Directory_And_Subdirs (Pattern, False, Rank, Location);
end if;
end Find_Pattern;