if Project_Qualifier_Of (Imported, In_Tree) = Aggregate then
Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
- Error_Msg
- (Flags, "cannot import aggregate project %%", Token_Ptr);
+ Error_Msg
+ (Flags, "cannot import aggregate project %%", Token_Ptr);
exit;
end if;
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
+ Resolved_Path_Name : Path_Name_Type;
Project_Directory : Path_Name_Type;
Project_Scan_State : Saved_Project_Scan_State;
Source_Index : Source_File_Index;
Name_Len := Canonical_Path'Length;
Name_Buffer (1 .. Name_Len) := Canonical_Path;
Canonical_Path_Name := Name_Find;
+
+ if Opt.Follow_Links_For_Files then
+ Resolved_Path_Name := Canonical_Path_Name;
+
+ else
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer
+ (Normalize_Pathname
+ (Canonical_Path,
+ Resolve_Links => True,
+ Case_Sensitive => False));
+ Resolved_Path_Name := Name_Find;
+ end if;
+
end;
if Has_Circular_Dependencies
while
A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
loop
- if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
+ if A_Project_Name_And_Node.Resolved_Path = Resolved_Path_Name then
if Extended then
if A_Project_Name_And_Node.Extended then
if Present (Extended_Project) then
+ if Project_Qualifier_Of (Extended_Project, In_Tree) =
+ Aggregate
+ then
+ Error_Msg_Name_1 :=
+ Name_Id (Path_Name_Of (Extended_Project, In_Tree));
+ Error_Msg
+ (Env.Flags,
+ "cannot extend aggregate project %%",
+ Location_Of (Project, In_Tree));
+ end if;
+
-- A project that extends an extending-all project is
-- also an extending-all project.
E => (Name => Name_Of_Project,
Display_Name => Display_Name_Of_Project,
Node => Project,
- Canonical_Path => Canonical_Path_Name,
+ Resolved_Path => Resolved_Path_Name,
Extended => Extended,
From_Extended => From_Extended /= None,
Proj_Qualifier => Project_Qualifier_Of (Project, In_Tree)));
----------------------
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean) is
-
function Copy_Attributes
(From, To : System.Address;
Mode : Integer) return Integer;
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_open_create");
-
begin
return C_Create_File (Name, Fmode);
end Create_File;
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
-
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Create_New_File, "__gnat_open_new");
-
begin
return C_Create_New_File (Name, Fmode);
end Create_New_File;
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
-
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
function C_Create_File
(Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file");
-
C_Name : String (1 .. Name'Length + 1);
-
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
Create_Temp_File_Internal (FD, Name, Stdout => False);
end Create_Temp_File;
+ -----------------------------
+ -- Create_Temp_Output_File --
+ -----------------------------
+
procedure Create_Temp_Output_File
(FD : out File_Descriptor;
Name : out String_Access)
-------------------------------
procedure Create_Temp_File_Internal
- (FD : out File_Descriptor;
- Name : out String_Access;
- Stdout : Boolean)
+ (FD : out File_Descriptor;
+ Name : out String_Access;
+ Stdout : Boolean)
is
Pos : Positive;
Attempts : Natural := 0;
Current : String (Current_Temp_File_Name'Range);
- ---------------------------------
- -- Create_New_Output_Text_File --
- ---------------------------------
-
function Create_New_Output_Text_File
(Name : String) return File_Descriptor;
-- Similar to Create_Output_Text_File, except it fails if the file
-- process. There is no point exposing this function, as it's generally
-- not particularly useful.
+ ---------------------------------
+ -- Create_New_Output_Text_File --
+ ---------------------------------
+
function Create_New_Output_Text_File
- (Name : String) return File_Descriptor is
+ (Name : String) return File_Descriptor
+ is
function C_Create_File
(Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file_new");
-
C_Name : String (1 .. Name'Length + 1);
-
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
File_Loop : loop
Locked : begin
+
-- We need to protect global variable Current_Temp_File_Name
-- against concurrent access by different tasks.
when others =>
-- If it is not a digit, then there are no available
- -- temp file names. Return Invalid_FD. There is almost
- -- no chance that this code will be ever be executed,
- -- since it would mean that there are one million temp
- -- files in the same directory.
+ -- temp file names. Return Invalid_FD. There is almost no
+ -- chance that this code will be ever be executed, since
+ -- it would mean that there are one million temp files in
+ -- the same directory.
SSL.Unlock_Task.all;
FD := Invalid_FD;
Current := Current_Temp_File_Name;
- -- We can now release the lock, because we are no longer
- -- accessing Current_Temp_File_Name.
+ -- We can now release the lock, because we are no longer accessing
+ -- Current_Temp_File_Name.
SSL.Unlock_Task.all;
procedure Delete_File (Name : String; Success : out Boolean) is
C_Name : String (1 .. Name'Length + 1);
-
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
-
Delete_File (C_Name'Address, Success);
end Delete_File;
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
begin
Suffix_Length := Strlen (Target_Object_Ext_Ptr);
-
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
function GM_Day (Date : OS_Time) return Day_Type is
D : Day_Type;
- pragma Warnings (Off);
Y : Year_Type;
Mo : Month_Type;
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Y, Mo, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
function GM_Hour (Date : OS_Time) return Hour_Type is
H : Hour_Type;
- pragma Warnings (Off);
Y : Year_Type;
Mo : Month_Type;
D : Day_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Y, Mo, D, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
function GM_Minute (Date : OS_Time) return Minute_Type is
Mn : Minute_Type;
- pragma Warnings (Off);
Y : Year_Type;
Mo : Month_Type;
D : Day_Type;
H : Hour_Type;
S : Second_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Y, Mo, D, H, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
function GM_Month (Date : OS_Time) return Month_Type is
Mo : Month_Type;
- pragma Warnings (Off);
Y : Year_Type;
D : Day_Type;
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Y, D, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
function GM_Second (Date : OS_Time) return Second_Type is
S : Second_Type;
- pragma Warnings (Off);
Y : Year_Type;
Mo : Month_Type;
D : Day_Type;
H : Hour_Type;
Mn : Minute_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Y, Mo, D, H, Mn);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);
function GM_Year (Date : OS_Time) return Year_Type is
Y : Year_Type;
- pragma Warnings (Off);
Mo : Month_Type;
D : Day_Type;
H : Hour_Type;
Mn : Minute_Type;
S : Second_Type;
- pragma Warnings (On);
+ pragma Unreferenced (Mo, D, H, Mn, S);
begin
GM_Split (Date, Y, Mo, D, H, Mn, S);