Skip to content

R
riscv-gcc-1
Commit 13f39091 by Arnaud Charlet
Options

[multiple changes] 

2014-02-19  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb, sem_util.ads, prj-conf.adb, s-os_lib.adb: Minor
	reformatting.

2014-02-19  Vincent Celier  <celier@adacore.com>

	* prj-part.adb (Parse_Single_Project): Use the fully resolved
	project path, with all symbolic links resolved, to check if the
	same project is imported with a different unresolved path.
	* prj-tree.ads (Project_Name_And_Node): Component Canonical_Path
	changed to Resolved_Path to reflect that all symbolic links
	are resolved.

From-SVN: r207904
parent 110e2969
Showing with 74 additions and 50 deletions
gcc/ada/ChangeLog
2014-02-19 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_util.ads, prj-conf.adb, s-os_lib.adb: Minor
reformatting.
2014-02-19 Vincent Celier <celier@adacore.com>
* prj-part.adb (Parse_Single_Project): Use the fully resolved
project path, with all symbolic links resolved, to check if the
same project is imported with a different unresolved path.
* prj-tree.ads (Project_Name_And_Node): Component Canonical_Path
changed to Resolved_Path to reflect that all symbolic links
are resolved.
2014-02-19 Ed Schonberg <schonberg@adacore.com>
* sem_util.ads, sem_util.adb (Get_Cursor_Type): Moved to sem_util
......
gcc/ada/prj-conf.adb
......@@ -577,7 +577,8 @@ package body Prj.Conf is
OK :=
Target = ""
or else (Tgt_Name /= No_Name
or else
(Tgt_Name /= No_Name
and then (Length_Of_Name (Tgt_Name) = 0
or else Target = Get_Name_String (Tgt_Name)));
......
gcc/ada/prj-part.adb
......@@ -1280,6 +1280,7 @@ package body Prj.Part is
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;
......@@ -1329,6 +1330,20 @@ package body Prj.Part is
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
......@@ -1351,7 +1366,7 @@ package body Prj.Part is
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
......@@ -1773,6 +1788,17 @@ package body Prj.Part is
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.
......@@ -1987,7 +2013,7 @@ package body Prj.Part is
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)));
......
gcc/ada/prj-tree.adb
......@@ -2922,7 +2922,7 @@ package body Prj.Tree is
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Display_Name => Name,
Canonical_Path => No_Path,
Resolved_Path => No_Path,
Node => Project,
Extended => False,
From_Extended => False,
......
gcc/ada/prj-tree.ads
......@@ -1469,7 +1469,7 @@ package Prj.Tree is
Node : Project_Node_Id;
-- Node of the project in table Project_Nodes
Canonical_Path : Path_Name_Type;
Resolved_Path : Path_Name_Type;
-- Resolved and canonical path of a real project file.
-- No_Name in case of virtual projects.
......@@ -1488,7 +1488,7 @@ package Prj.Tree is
(Name => No_Name,
Display_Name => No_Name,
Node => Empty_Node,
Canonical_Path => No_Path,
Resolved_Path => No_Path,
Extended => True,
From_Extended => False,
Proj_Qualifier => Unspecified);
......
gcc/ada/s-os_lib.adb
......@@ -611,7 +611,6 @@ package body System.OS_Lib is
----------------------
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean) is
function Copy_Attributes
(From, To : System.Address;
Mode : Integer) return Integer;
......@@ -672,7 +671,6 @@ package body System.OS_Lib is
(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;
......@@ -682,7 +680,6 @@ package body System.OS_Lib is
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;
......@@ -701,7 +698,6 @@ package body System.OS_Lib is
(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;
......@@ -711,7 +707,6 @@ package body System.OS_Lib is
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;
......@@ -726,9 +721,7 @@ package body System.OS_Lib is
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;
......@@ -760,6 +753,10 @@ package body System.OS_Lib is
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)
......@@ -781,10 +778,6 @@ package body System.OS_Lib is
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
......@@ -793,14 +786,17 @@ package body System.OS_Lib is
-- 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;
......@@ -812,6 +808,7 @@ package body System.OS_Lib is
File_Loop : loop
Locked : begin
-- We need to protect global variable Current_Temp_File_Name
-- against concurrent access by different tasks.
......@@ -841,10 +838,10 @@ package body System.OS_Lib is
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;
......@@ -855,8 +852,8 @@ package body System.OS_Lib is
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;
......@@ -909,11 +906,9 @@ package body System.OS_Lib is
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;
......@@ -960,7 +955,6 @@ package body System.OS_Lib is
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -987,7 +981,6 @@ package body System.OS_Lib is
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -1014,7 +1007,6 @@ package body System.OS_Lib is
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -1044,7 +1036,6 @@ package body System.OS_Lib is
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -1074,7 +1065,6 @@ package body System.OS_Lib is
begin
Suffix_Length := Strlen (Target_Exec_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -1104,7 +1094,6 @@ package body System.OS_Lib is
begin
Suffix_Length := Strlen (Target_Object_Ext_Ptr);
Result := new String (1 .. Suffix_Length);
if Suffix_Length > 0 then
......@@ -1153,13 +1142,12 @@ package body System.OS_Lib is
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);
......@@ -1173,13 +1161,12 @@ package body System.OS_Lib is
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);
......@@ -1193,13 +1180,12 @@ package body System.OS_Lib is
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);
......@@ -1213,13 +1199,12 @@ package body System.OS_Lib is
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);
......@@ -1233,13 +1218,12 @@ package body System.OS_Lib is
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);
......@@ -1302,13 +1286,12 @@ package body System.OS_Lib is
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);
......
gcc/ada/sem_util.adb
......@@ -6443,7 +6443,6 @@ package body Sem_Util is
Error_Msg_N
("Operation First for iterable type must be unique", Aspect);
return Any_Type;
else
Cursor := Etype (Func);
end if;
......@@ -6461,6 +6460,7 @@ package body Sem_Util is
return Cursor;
end Get_Cursor_Type;
-------------------------------
-- Get_Default_External_Name --
-------------------------------
......
gcc/ada/sem_util.ads
......@@ -781,9 +781,9 @@ package Sem_Util is
(Aspect : Node_Id;
Typ : Entity_Id) return Entity_Id;
-- Find Cursor type in scope of formal container Typ, by locating primitive
-- operation First.
-- For use in resolving the other primitive operations of an Iterable type
-- and expanding loops and quantified expressions over formal containers.
-- operation First. For use in resolving the other primitive operations
-- of an Iterable type and expanding loops and quantified expressions
-- over formal containers.
function Get_Default_External_Name (E : Node_Or_Entity_Id) return Node_Id;
-- This is used to construct the string literal node representing a
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment