From 5b900a4520087e5e38fe938e55932e6bd779d1e9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 25 Jun 2009 11:18:43 +0200 Subject: [PATCH] [multiple changes] 2009-06-25 Vincent Celier * 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 * prj.ads (Unit_Index): Now general access type. From-SVN: r148936 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/fmap.adb | 33 ++++++++++++++------------------- gcc/ada/fmap.ads | 11 +++-------- gcc/ada/prj-nmsc.adb | 18 ++++-------------- gcc/ada/prj.ads | 2 +- gcc/ada/s-os_lib.adb | 34 +++++++++++++++++++++++----------- 6 files changed, 59 insertions(+), 53 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e3524d5167b..63550a62b93 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-06-25 Vincent Celier + + * 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 + + * prj.ads (Unit_Index): Now general access type. 2009-06-25 Pascal Obry * 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 0d5061dd18d..8de27ec6b7e 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 fb781ce3041..f1d54db4733 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 4793ad2678b..3c2a7ebb78c 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 8c564f8de3f..ebb45782a2c 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 e24a02e8895..0f2081a0e87 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 -- 2.30.2