[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

6 files changed, 59 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e3524d5..63550a6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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>
 
 	* a-stwise.adb, a-stzsea.adb: Fix confusion between 'Length and 'Last.
diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
index 0d5061d..8de27ec 100644
--- a/gcc/ada/fmap.adb
+++ b/gcc/ada/fmap.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -191,16 +191,17 @@ package body Fmap is
       --  Remove all entries in case of incorrect mapping file
 
       function Find_File_Name return File_Name_Type;
-      --  Return Error_File_Name for "/", otherwise call Name_Find
-      --  What is this about, explanation required ???
+      --  Return Error_File_Name if the name buffer contains "/", otherwise
+      --  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;
-      --  Return Error_Unit_Name for "/", otherwise call Name_Find
-      --  Even more mysterious??? function appeared when Find_Name was split
-      --  for the two types, but this routine is definitely called!
+      --  Return the unit name in the name buffer. Return Error_Unit_Name if
+      --  the name buffer contains "/".
 
       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;
       --  Report a warning when the mapping file is truncated
@@ -223,12 +224,16 @@ package body Fmap is
       -- Find_File_Name --
       --------------------
 
-      --  Why is only / illegal, why not \ on windows ???
-
       function Find_File_Name return File_Name_Type is
       begin
          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;
+
          else
             return Name_Find;
          end if;
@@ -241,7 +246,6 @@ package body Fmap is
       function Find_Unit_Name return Unit_Name_Type is
       begin
          return Unit_Name_Type (Find_File_Name);
-         --  very odd ???
       end Find_Unit_Name;
 
       --------------
@@ -413,15 +417,6 @@ package body Fmap is
       end if;
    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 --
    ------------------
diff --git a/gcc/ada/fmap.ads b/gcc/ada/fmap.ads
index fb781ce..f1d54db 100644
--- a/gcc/ada/fmap.ads
+++ b/gcc/ada/fmap.ads
@@ -74,13 +74,8 @@ package Fmap is
    --  compilation.
 
    procedure Add_Forbidden_File_Name (Name : File_Name_Type);
-   --  Indicate that a source file name is forbidden.
-   --  This is used by gnatmake when there are excluded sources in projects
-   --  (attributes Excluded_Source_Files or 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.
+   --  Indicate that a source file name is forbidden. This is used when there
+   --  are excluded sources in projects (attributes Excluded_Source_Files or
+   --  Locally_Removed_Files).
 
 end Fmap;
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 4793ad2..3c2a7eb 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -28,7 +28,6 @@ with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
 with GNAT.HTable;
 
 with Err_Vars; use Err_Vars;
-with Fmap;     use Fmap;
 with Hostparm;
 with MLib.Tgt;
 with Opt;      use Opt;
@@ -4569,9 +4568,9 @@ package body Prj.Nmsc is
                              (UData.File_Names (Impl).Project,
                               Project, Extending)
                            then
-                              --  There is a body for this unit.
-                              --  If there is no spec, we need to check that it
-                              --  is not a subunit.
+                              --  There is a body for this unit. If there is
+                              --  no spec, we need to check that it is not a
+                              --  subunit.
 
                               if UData.File_Names (Spec) = null then
                                  declare
@@ -7327,7 +7326,7 @@ package body Prj.Nmsc is
       then
          --  If we had another file referencing the same unit (for instance it
          --  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
             Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
@@ -7831,8 +7830,6 @@ package body Prj.Nmsc is
                         Write_Line (Get_Name_String (Excluded.File));
                      end if;
 
-                     Add_Forbidden_File_Name (Excluded.File);
-
                   else
                      Error_Msg
                        (Project, In_Tree,
@@ -8121,13 +8118,6 @@ package body Prj.Nmsc is
               or else Is_Extending
                 (Project.Extends, UData.File_Names (Unit_Kind).Project)
             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;
 
             --  If the same file is already in the list, do not add it again
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 8c564f8..ebb4578 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -640,7 +640,7 @@ package Prj is
       Name       : Name_Id := No_Name;
       File_Names : File_Names_Data;
    end record;
-   type Unit_Index is access Unit_Data;
+   type Unit_Index is access all Unit_Data;
    No_Unit_Index : constant Unit_Index := null;
    --  Name and File and Path names of a unit, with a reference to its
    --  GNAT Project File(s).
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index e24a02e..0f2081a 100755
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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 --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1800,20 +1800,32 @@ package body System.OS_Lib is
       -------------------
 
       function Get_Directory (Dir : String) return String is
+         Result : String (1 .. Dir'Length + 1);
+         Length : constant Natural := Dir'Length;
+
       begin
          --  Directory given, add directory separator if needed
 
-         if Dir'Length > 0 then
-            if Dir (Dir'Last) = Directory_Separator then
-               return Dir;
+         if Length > 0 then
+            Result (1 .. Length) := 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
-               declare
-                  Result : String (1 .. Dir'Length + 1);
-               begin
-                  Result (1 .. Dir'Length) := Dir;
-                  Result (Result'Length) := Directory_Separator;
-                  return Result;
-               end;
+               Result (Result'Length) := Directory_Separator;
+               return Result;
             end if;
 
          --  Directory name not given, get current directory