diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-02-19 15:48:32 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-02-19 15:48:32 +0100 |
commit | 13f39091ea608a390dd56aabdec1ac6bb56846dd (patch) | |
tree | 2939b36369ceec25e8c911a56f5d25dd754b077d | |
parent | 110e2969e057932e42f7a97332b1a840959ab685 (diff) | |
download | gcc-13f39091ea608a390dd56aabdec1ac6bb56846dd.zip gcc-13f39091ea608a390dd56aabdec1ac6bb56846dd.tar.gz gcc-13f39091ea608a390dd56aabdec1ac6bb56846dd.tar.bz2 |
[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
-rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/ada/prj-conf.adb | 7 | ||||
-rw-r--r-- | gcc/ada/prj-part.adb | 34 | ||||
-rw-r--r-- | gcc/ada/prj-tree.adb | 2 | ||||
-rw-r--r-- | gcc/ada/prj-tree.ads | 4 | ||||
-rw-r--r-- | gcc/ada/s-os_lib.adb | 69 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 6 |
8 files changed, 81 insertions, 57 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 55b0724..a97d879 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +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 diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 8d35fe2..b0dfceb 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -577,9 +577,10 @@ package body Prj.Conf is OK := Target = "" - or else (Tgt_Name /= No_Name - and then (Length_Of_Name (Tgt_Name) = 0 - or else Target = Get_Name_String (Tgt_Name))); + or else + (Tgt_Name /= No_Name + and then (Length_Of_Name (Tgt_Name) = 0 + or else Target = Get_Name_String (Tgt_Name))); if not OK then if Autoconf_Specified then diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 771f83a..48b57aa 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1126,8 +1126,8 @@ package body Prj.Part is 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; @@ -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))); diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index b831ea0..37ec38f 100644 --- a/gcc/ada/prj-tree.adb +++ b/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, diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 7859d4a..0a7da7f 100644 --- a/gcc/ada/prj-tree.ads +++ b/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); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index fa44b52..42e4c54 100644 --- a/gcc/ada/s-os_lib.adb +++ b/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) @@ -773,18 +770,14 @@ package body System.OS_Lib is ------------------------------- 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 @@ -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); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d21d648..a53e245 100644 --- a/gcc/ada/sem_util.adb +++ b/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 -- ------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c6d078c..e82d3e6 100644 --- a/gcc/ada/sem_util.ads +++ b/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 |