Commit 5b900a45 by Arnaud Charlet

[multiple changes]

2009-06-25  Vincent Celier  <celier@adacore.com>

	* s-os_lib.adb (Normalize_Pathname.Get_Directory): If directory
	provided, on Windows change all '/' to '\'.

	* fmap.ads, fmap.adb (Remove_Forbidden_File_Name): Remove, no longer
	used. Minor comment changes

	* prj-nmsc.adb: Do not call Fmap.Add_Forbidden_File_Name or
	Remove_Forbidden_File_Name.

2009-06-25  Quentin Ochem  <ochem@adacore.com>

	* prj.ads (Unit_Index): Now general access type.

From-SVN: r148936
parent a2b62f99
2009-06-25 Vincent Celier <celier@adacore.com>
* s-os_lib.adb (Normalize_Pathname.Get_Directory): If directory
provided, on Windows change all '/' to '\'.
* fmap.ads, fmap.adb (Remove_Forbidden_File_Name): Remove, no longer
used. Minor comment changes
* prj-nmsc.adb: Do not call Fmap.Add_Forbidden_File_Name or
Remove_Forbidden_File_Name.
2009-06-25 Quentin Ochem <ochem@adacore.com>
* prj.ads (Unit_Index): Now general access type.
2009-06-25 Pascal Obry <obry@adacore.com> 2009-06-25 Pascal Obry <obry@adacore.com>
* a-stwise.adb, a-stzsea.adb: Fix confusion between 'Length and 'Last. * a-stwise.adb, a-stzsea.adb: Fix confusion between 'Length and 'Last.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -191,16 +191,17 @@ package body Fmap is ...@@ -191,16 +191,17 @@ package body Fmap is
-- Remove all entries in case of incorrect mapping file -- Remove all entries in case of incorrect mapping file
function Find_File_Name return File_Name_Type; function Find_File_Name return File_Name_Type;
-- Return Error_File_Name for "/", otherwise call Name_Find -- Return Error_File_Name if the name buffer contains "/", otherwise
-- What is this about, explanation required ??? -- call Name_Find. "/" is the path name in the mapping file to indicate
-- that a source has been suppressed, and thus should not be found by
-- the compiler.
function Find_Unit_Name return Unit_Name_Type; function Find_Unit_Name return Unit_Name_Type;
-- Return Error_Unit_Name for "/", otherwise call Name_Find -- Return the unit name in the name buffer. Return Error_Unit_Name if
-- Even more mysterious??? function appeared when Find_Name was split -- the name buffer contains "/".
-- for the two types, but this routine is definitely called!
procedure Get_Line; procedure Get_Line;
-- Get a line from the mapping file -- Get a line from the mapping file, where a line is SP (First .. Last)
procedure Report_Truncated; procedure Report_Truncated;
-- Report a warning when the mapping file is truncated -- Report a warning when the mapping file is truncated
...@@ -223,12 +224,16 @@ package body Fmap is ...@@ -223,12 +224,16 @@ package body Fmap is
-- Find_File_Name -- -- Find_File_Name --
-------------------- --------------------
-- Why is only / illegal, why not \ on windows ???
function Find_File_Name return File_Name_Type is function Find_File_Name return File_Name_Type is
begin begin
if Name_Buffer (1 .. Name_Len) = "/" then if Name_Buffer (1 .. Name_Len) = "/" then
-- A path name of "/" is the indication that the source has been
-- "suppressed". Return Error_File_Name so that the compiler does
-- not find the source, even if it is in the include path.
return Error_File_Name; return Error_File_Name;
else else
return Name_Find; return Name_Find;
end if; end if;
...@@ -241,7 +246,6 @@ package body Fmap is ...@@ -241,7 +246,6 @@ package body Fmap is
function Find_Unit_Name return Unit_Name_Type is function Find_Unit_Name return Unit_Name_Type is
begin begin
return Unit_Name_Type (Find_File_Name); return Unit_Name_Type (Find_File_Name);
-- very odd ???
end Find_Unit_Name; end Find_Unit_Name;
-------------- --------------
...@@ -413,15 +417,6 @@ package body Fmap is ...@@ -413,15 +417,6 @@ package body Fmap is
end if; end if;
end Mapped_Path_Name; end Mapped_Path_Name;
--------------------------------
-- Remove_Forbidden_File_Name --
--------------------------------
procedure Remove_Forbidden_File_Name (Name : File_Name_Type) is
begin
Forbidden_Names.Set (Name, False);
end Remove_Forbidden_File_Name;
------------------ ------------------
-- Reset_Tables -- -- Reset_Tables --
------------------ ------------------
......
...@@ -74,13 +74,8 @@ package Fmap is ...@@ -74,13 +74,8 @@ package Fmap is
-- compilation. -- compilation.
procedure Add_Forbidden_File_Name (Name : File_Name_Type); procedure Add_Forbidden_File_Name (Name : File_Name_Type);
-- Indicate that a source file name is forbidden. -- Indicate that a source file name is forbidden. This is used when there
-- This is used by gnatmake when there are excluded sources in projects -- are excluded sources in projects (attributes Excluded_Source_Files or
-- (attributes Excluded_Source_Files or Locally_Removed_Files). -- Locally_Removed_Files).
procedure Remove_Forbidden_File_Name (Name : File_Name_Type);
-- Indicate that a source file name that was forbidden is no longer
-- forbidden. Used by gnatmake when an excluded source is redefined
-- in another extending project.
end Fmap; end Fmap;
...@@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable; with GNAT.HTable;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with Fmap; use Fmap;
with Hostparm; with Hostparm;
with MLib.Tgt; with MLib.Tgt;
with Opt; use Opt; with Opt; use Opt;
...@@ -4569,9 +4568,9 @@ package body Prj.Nmsc is ...@@ -4569,9 +4568,9 @@ package body Prj.Nmsc is
(UData.File_Names (Impl).Project, (UData.File_Names (Impl).Project,
Project, Extending) Project, Extending)
then then
-- There is a body for this unit. -- There is a body for this unit. If there is
-- If there is no spec, we need to check that it -- no spec, we need to check that it is not a
-- is not a subunit. -- subunit.
if UData.File_Names (Spec) = null then if UData.File_Names (Spec) = null then
declare declare
...@@ -7327,7 +7326,7 @@ package body Prj.Nmsc is ...@@ -7327,7 +7326,7 @@ package body Prj.Nmsc is
then then
-- If we had another file referencing the same unit (for instance it -- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible -- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit -- from now on, and in particular doesn't belong to the same unit.
if Source.Unit.File_Names (Source.Kind) /= Source then if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index; Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
...@@ -7831,8 +7830,6 @@ package body Prj.Nmsc is ...@@ -7831,8 +7830,6 @@ package body Prj.Nmsc is
Write_Line (Get_Name_String (Excluded.File)); Write_Line (Get_Name_String (Excluded.File));
end if; end if;
Add_Forbidden_File_Name (Excluded.File);
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -8121,13 +8118,6 @@ package body Prj.Nmsc is ...@@ -8121,13 +8118,6 @@ package body Prj.Nmsc is
or else Is_Extending or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project) (Project.Extends, UData.File_Names (Unit_Kind).Project)
then then
if UData.File_Names (Unit_Kind) /= null
and then UData.File_Names (Unit_Kind).Locally_Removed
then
Remove_Forbidden_File_Name
(UData.File_Names (Unit_Kind).File);
end if;
To_Record := True; To_Record := True;
-- If the same file is already in the list, do not add it again -- If the same file is already in the list, do not add it again
......
...@@ -640,7 +640,7 @@ package Prj is ...@@ -640,7 +640,7 @@ package Prj is
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
File_Names : File_Names_Data; File_Names : File_Names_Data;
end record; end record;
type Unit_Index is access Unit_Data; type Unit_Index is access all Unit_Data;
No_Unit_Index : constant Unit_Index := null; No_Unit_Index : constant Unit_Index := null;
-- Name and File and Path names of a unit, with a reference to its -- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s). -- GNAT Project File(s).
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1995-2008, AdaCore -- -- Copyright (C) 1995-2009, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1800,20 +1800,32 @@ package body System.OS_Lib is ...@@ -1800,20 +1800,32 @@ package body System.OS_Lib is
------------------- -------------------
function Get_Directory (Dir : String) return String is function Get_Directory (Dir : String) return String is
Result : String (1 .. Dir'Length + 1);
Length : constant Natural := Dir'Length;
begin begin
-- Directory given, add directory separator if needed -- Directory given, add directory separator if needed
if Dir'Length > 0 then if Length > 0 then
if Dir (Dir'Last) = Directory_Separator then Result (1 .. Length) := Dir;
return Dir;
-- On Windows, change all '/' to '\'
if On_Windows then
for J in 1 .. Length loop
if Result (J) = '/' then
Result (J) := Directory_Separator;
end if;
end loop;
end if;
-- Add directory separator, if needed
if Result (Length) = Directory_Separator then
return Result (1 .. Length);
else else
declare Result (Result'Length) := Directory_Separator;
Result : String (1 .. Dir'Length + 1); return Result;
begin
Result (1 .. Dir'Length) := Dir;
Result (Result'Length) := Directory_Separator;
return Result;
end;
end if; end if;
-- Directory name not given, get current directory -- Directory name not given, get current directory
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment