-- --
-- 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- --
-- --
------------------------------------------------------------------------------
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Unchecked_Deallocation;
-
with Debug;
with Osint; use Osint;
with Output; use Output;
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
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";
Config_File_Temp => False,
Config_Checked => False,
Need_To_Build_Lib => False,
+ Has_Multi_Unit_Sources => False,
Depth => 0,
Unkept_Comments => False);
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;
-- 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
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
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 --
----------------------
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);
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);
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
end loop;
if Add_Object_Dir then
- return Project.Object_Directory.Name;
+ return Project.Object_Directory.Display_Name;
end if;
end;
end if;
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;
------------------------------
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
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;
------------