[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 19 Feb 2014 14:48:32 +0000 (15:48 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 19 Feb 2014 14:48:32 +0000 (15:48 +0100)
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

gcc/ada/ChangeLog
gcc/ada/prj-conf.adb
gcc/ada/prj-part.adb
gcc/ada/prj-tree.adb
gcc/ada/prj-tree.ads
gcc/ada/s-os_lib.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 55b0724..a97d879 100644 (file)
@@ -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
index 8d35fe2..b0dfceb 100644 (file)
@@ -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
index 771f83a..48b57aa 100644 (file)
@@ -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)));
index b831ea0..37ec38f 100644 (file)
@@ -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,
index 7859d4a..0a7da7f 100644 (file)
@@ -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);
index fa44b52..42e4c54 100644 (file)
@@ -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);
index d21d648..a53e245 100644 (file)
@@ -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 --
    -------------------------------
index c6d078c..e82d3e6 100644 (file)
@@ -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