OSDN Git Service

2008-04-08 Hristian Kirtchev <kirtchev@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / prj-ext.adb
index 4ab0a90..5a7e9b9 100644 (file)
@@ -6,18 +6,17 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2008, 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
 -- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
@@ -29,14 +28,14 @@ with Makeutl;  use Makeutl;
 with Output;   use Output;
 with Osint;    use Osint;
 with Sdefault;
+with Table;
 
 with GNAT.HTable;
 
 package body Prj.Ext is
 
-   Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
    Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
-   --  Name of the env. variables that contain path name(s) of directories
+   --  Name of alternate env. variable that contain path name(s) of directories
    --  where project files may reside. GPR_PROJECT_PATH has precedence over
    --  ADA_PROJECT_PATH.
 
@@ -97,6 +96,7 @@ package body Prj.Ext is
       Htable.Set (The_Key, The_Value);
    end Add;
 
+   -----------
    ----------------------------------
    -- Add_Search_Project_Directory --
    ----------------------------------
@@ -108,7 +108,6 @@ package body Prj.Ext is
       Search_Directories.Append (Name_Find);
    end Add_Search_Project_Directory;
 
-   -----------
    -- Check --
    -----------
 
@@ -140,29 +139,21 @@ package body Prj.Ext is
       Last            : Positive;
       New_Len         : Positive;
       New_Last        : Positive;
-      Prj_Path        : String_Access := null;
+      Prj_Path        : String_Access := Gpr_Prj_Path;
 
    begin
       if Gpr_Prj_Path.all /= "" then
-         if Hostparm.OpenVMS then
-            Prj_Path := To_Canonical_Path_Spec ("GPR_PROJECT_PATH:");
-         else
-            Prj_Path := To_Canonical_Path_Spec (Gpr_Prj_Path.all);
-         end if;
 
-         --  Warn if both environment variables are defined
+         --  In Ada only mode, warn if both environment variables are defined
 
-         if Ada_Prj_Path.all /= "" then
-            Write_Line ("Warning: ADA_PROJECT_PATH is not taken into account");
+         if Get_Mode = Ada_Only and then Ada_Prj_Path.all /= "" then
+            Write_Line
+              ("Warning: ADA_PROJECT_PATH is not taken into account");
             Write_Line ("         when GPR_PROJECT_PATH is defined");
          end if;
 
-      elsif Ada_Prj_Path.all /= "" then
-         if Hostparm.OpenVMS then
-            Prj_Path := To_Canonical_Path_Spec ("ADA_PROJECT_PATH:");
-         else
-            Prj_Path := To_Canonical_Path_Spec (Ada_Prj_Path.all);
-         end if;
+      else
+         Prj_Path := Ada_Prj_Path;
       end if;
 
       --  The current directory is always first
@@ -179,9 +170,9 @@ package body Prj.Ext is
            (Get_Name_String (Search_Directories.Table (J)));
       end loop;
 
-      --  If environment variable is defined, add its content
+      --  If environment variable is defined and not empty, add its content
 
-      if Prj_Path /= null then
+      if Prj_Path.all /= "" then
          Name_Len := Name_Len + 1;
          Name_Buffer (Name_Len) := Path_Separator;
 
@@ -189,7 +180,7 @@ package body Prj.Ext is
       end if;
 
       --  Scan the directory path to see if "-" is one of the directories.
-      --  Remove each occurence of "-" and set Add_Default_Dir to False.
+      --  Remove each occurrence of "-" and set Add_Default_Dir to False.
       --  Also resolve relative paths and symbolic links.
 
       First := 3;
@@ -223,6 +214,11 @@ package body Prj.Ext is
 
             Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
 
+            --  After removing the '-', go back one character to get the next
+            --  directory correctly.
+
+            Last := Last - 1;
+
          elsif not Hostparm.OpenVMS
            or else not Is_Absolute_Path (Name_Buffer (First .. Last))
          then
@@ -264,9 +260,17 @@ package body Prj.Ext is
                Prefix := new String'(Executable_Prefix_Path);
 
                if Prefix.all /= "" then
-                  Current_Project_Path :=
-                    new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
-                                Prefix.all & Directory_Separator & "gnat");
+                  if Get_Mode = Multi_Language then
+                     Add_Str_To_Name_Buffer
+                       (Path_Separator & Prefix.all &
+                        Directory_Separator & "share" &
+                        Directory_Separator & "gpr");
+                  end if;
+
+                  Add_Str_To_Name_Buffer
+                    (Path_Separator & Prefix.all &
+                     Directory_Separator & "lib" &
+                     Directory_Separator & "gnat");
                end if;
 
             else
@@ -278,7 +282,9 @@ package body Prj.Ext is
                              ".." & Directory_Separator & "gnat");
             end if;
          end;
-      else
+      end if;
+
+      if Current_Project_Path = null then
          Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
       end if;
    end Initialize_Project_Path;