OSDN Git Service

PR target/50678
[pf3gnuchains/gcc-fork.git] / gcc / ada / prj.adb
index 70a5737..2ad07b1 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2010, 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- --
@@ -23,9 +23,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Unchecked_Deallocation;
-
 with Debug;
 with Osint;    use Osint;
 with Output;   use Output;
@@ -34,10 +31,12 @@ with Prj.Err;  use Prj.Err;
 with Snames;   use Snames;
 with Uintp;    use Uintp;
 
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with Ada.Characters.Handling;    use Ada.Characters.Handling;
+with Ada.Unchecked_Deallocation;
 
-with System.Case_Util; use System.Case_Util;
-with System.HTable;
+with GNAT.Case_Util;            use GNAT.Case_Util;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.HTable;
 
 package body Prj is
 
@@ -49,8 +48,6 @@ package body Prj is
 
    The_Empty_String : Name_Id := No_Name;
 
-   subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
-
    type Cst_String_Access is access constant String;
 
    All_Lower_Case_Image : aliased constant String := "lowercase";
@@ -107,6 +104,7 @@ package body Prj is
                       Config_File_Temp               => False,
                       Config_Checked                 => False,
                       Need_To_Build_Lib              => False,
+                      Has_Multi_Unit_Sources         => False,
                       Depth                          => 0,
                       Unkept_Comments                => False);
 
@@ -249,16 +247,10 @@ package body Prj is
             return No_File;
 
          when Makefile =>
-            return
-              File_Name_Type
-                (Extend_Name
-                   (Source_File_Name, Makefile_Dependency_Suffix));
+            return Extend_Name (Source_File_Name, Makefile_Dependency_Suffix);
 
          when ALI_File =>
-            return
-              File_Name_Type
-                (Extend_Name
-                   (Source_File_Name, ALI_Dependency_Suffix));
+            return Extend_Name (Source_File_Name, ALI_Dependency_Suffix);
       end case;
    end Dependency_Name;
 
@@ -567,7 +559,7 @@ package body Prj is
    -- Hash --
    ----------
 
-   function Hash is new System.HTable.Hash (Header_Num => Header_Num);
+   function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
    --  Used in implementation of other functions Hash below
 
    function Hash (Name : File_Name_Type) return Header_Num is
@@ -628,9 +620,15 @@ package body Prj is
          The_Empty_String := Name_Find;
 
          Prj.Attr.Initialize;
-         Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
-         Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
-         Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
+
+         Set_Name_Table_Byte
+           (Name_Project,          Token_Type'Pos (Tok_Project));
+         Set_Name_Table_Byte
+           (Name_Extends,          Token_Type'Pos (Tok_Extends));
+         Set_Name_Table_Byte
+           (Name_External,         Token_Type'Pos (Tok_External));
+         Set_Name_Table_Byte
+           (Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
       end if;
 
       if Tree /= No_Project_Tree then
@@ -679,6 +677,39 @@ package body Prj is
       end if;
    end Object_Name;
 
+   function Object_Name
+     (Source_File_Name   : File_Name_Type;
+      Source_Index       : Int;
+      Index_Separator    : Character;
+      Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
+   is
+      Index_Img : constant String := Source_Index'Img;
+      Last      : Natural;
+
+   begin
+      Get_Name_String (Source_File_Name);
+
+      Last := Name_Len;
+      while Last > 1 and then Name_Buffer (Last) /= '.' loop
+         Last := Last - 1;
+      end loop;
+
+      if Last > 1 then
+         Name_Len := Last - 1;
+      end if;
+
+      Add_Char_To_Name_Buffer (Index_Separator);
+      Add_Str_To_Name_Buffer (Index_Img (2 .. Index_Img'Last));
+
+      if Object_File_Suffix = No_Name then
+         Add_Str_To_Name_Buffer (Object_Suffix);
+      else
+         Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix));
+      end if;
+
+      return Name_Find;
+   end Object_Name;
+
    ----------------------
    -- Record_Temp_File --
    ----------------------
@@ -845,6 +876,7 @@ package body Prj is
          Array_Table.Free (Tree.Arrays);
          Package_Table.Free (Tree.Packages);
          Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
+         Source_Files_Htable.Reset (Tree.Source_Files_HT);
 
          Free_List (Tree.Projects, Free_Project => True);
          Free_Units (Tree.Units_HT);
@@ -873,6 +905,10 @@ package body Prj is
       Array_Table.Init              (Tree.Arrays);
       Package_Table.Init            (Tree.Packages);
       Source_Paths_Htable.Reset     (Tree.Source_Paths_HT);
+      Source_Files_Htable.Reset     (Tree.Source_Files_HT);
+      Replaced_Source_HTable.Reset  (Tree.Replaced_Sources);
+
+      Tree.Replaced_Source_Number := 0;
 
       Free_List (Tree.Projects, Free_Project => True);
       Free_Units (Tree.Units_HT);
@@ -990,11 +1026,11 @@ package body Prj is
 
          if Project.Library then
             if Project.Object_Directory = No_Path_Information
-              or else Contains_ALI_Files (Project.Library_ALI_Dir.Name)
+              or else Contains_ALI_Files (Project.Library_ALI_Dir.Display_Name)
             then
-               return Project.Library_ALI_Dir.Name;
+               return Project.Library_ALI_Dir.Display_Name;
             else
-               return Project.Object_Directory.Name;
+               return Project.Object_Directory.Display_Name;
             end if;
 
             --  For a non-library project, add object directory if it is not a
@@ -1020,7 +1056,7 @@ package body Prj is
                end loop;
 
                if Add_Object_Dir then
-                  return Project.Object_Directory.Name;
+                  return Project.Object_Directory.Display_Name;
                end if;
             end;
          end if;
@@ -1118,9 +1154,38 @@ package body Prj is
 
    function Is_Compilable (Source : Source_Id) return Boolean is
    begin
-      return Source.Language.Config.Compiler_Driver /= No_File
-        and then Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
-        and then not Source.Locally_Removed;
+      case Source.Compilable is
+         when Unknown =>
+            if Source.Language.Config.Compiler_Driver /= No_File
+              and then
+                Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
+              and then not Source.Locally_Removed
+              and then (Source.Language.Config.Kind /= File_Based
+                         or else Source.Kind /= Spec)
+            then
+               --  Do not modify Source.Compilable before the source record
+               --  has been initialized.
+
+               if Source.Source_TS /= Empty_Time_Stamp then
+                  Source.Compilable := Yes;
+               end if;
+
+               return True;
+
+            else
+               if Source.Source_TS /= Empty_Time_Stamp then
+                  Source.Compilable := No;
+               end if;
+
+               return False;
+            end if;
+
+         when Yes =>
+            return True;
+
+         when No =>
+            return False;
+      end case;
    end Is_Compilable;
 
    ------------------------------
@@ -1192,11 +1257,13 @@ package body Prj is
    function Create_Flags
      (Report_Error               : Error_Handler;
       When_No_Sources            : Error_Warning;
-      Require_Sources_Other_Lang : Boolean := True;
-      Allow_Duplicate_Basenames  : Boolean := True;
-      Compiler_Driver_Mandatory  : Boolean := False;
-      Error_On_Unknown_Language  : Boolean := True;
-      Require_Obj_Dirs           : Error_Warning := Error)
+      Require_Sources_Other_Lang : Boolean       := True;
+      Allow_Duplicate_Basenames  : Boolean       := True;
+      Compiler_Driver_Mandatory  : Boolean       := False;
+      Error_On_Unknown_Language  : Boolean       := True;
+      Require_Obj_Dirs           : Error_Warning := Error;
+      Allow_Invalid_External     : Error_Warning := Error;
+      Missing_Source_Files       : Error_Warning := Error)
       return Processing_Flags
    is
    begin
@@ -1207,7 +1274,9 @@ package body Prj is
          Allow_Duplicate_Basenames  => Allow_Duplicate_Basenames,
          Error_On_Unknown_Language  => Error_On_Unknown_Language,
          Compiler_Driver_Mandatory  => Compiler_Driver_Mandatory,
-         Require_Obj_Dirs           => Require_Obj_Dirs);
+         Require_Obj_Dirs           => Require_Obj_Dirs,
+         Allow_Invalid_External     => Allow_Invalid_External,
+         Missing_Source_Files       => Missing_Source_Files);
    end Create_Flags;
 
    ------------