[multiple changes]

2014-08-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Code
	reformatting. Store the generated pragma Import in the related
	subprogram as routine Wrap_Imported_Subprogram will need it later.
	* sem_prag.adb (Is_Unconstrained_Or_Tagged_Item): An item of
	a private type with discriminants is considered to fall in the
	category of unconstrained or tagged items.

2014-08-01  Arnaud charlet  <charlet@adacore.com>

	* s-os_lib.adb (Open_Append): New functions to open a file for
	appending. This binds to the already existing (but not used)
	__gnat_open_append.
	* osint.ads, osint.adb (Open_File_To_Append_And_Check): New procedure
	to open a file for appending.
	* osint-c.ads, osint-c.adb (Open_Output_Library_Info): New procedure
	to open the ALI file for appending.

From-SVN: r213470

9 files changed, 175 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4c906dd..9b58a08 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2014-08-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Code
+	reformatting. Store the generated pragma Import in the related
+	subprogram as routine Wrap_Imported_Subprogram will need it later.
+	* sem_prag.adb (Is_Unconstrained_Or_Tagged_Item): An item of
+	a private type with discriminants is considered to fall in the
+	category of unconstrained or tagged items.
+
+2014-08-01  Arnaud charlet  <charlet@adacore.com>
+
+	* s-os_lib.adb (Open_Append): New functions to open a file for
+	appending. This binds to the already existing (but not used)
+	__gnat_open_append.
+	* osint.ads, osint.adb (Open_File_To_Append_And_Check): New procedure
+	to open a file for appending.
+	* osint-c.ads, osint-c.adb (Open_Output_Library_Info): New procedure
+	to open the ALI file for appending.
+
 2014-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch8.adb: Minor reformatting.
diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb
index 536133f..f955c2f 100644
--- a/gcc/ada/osint-c.adb
+++ b/gcc/ada/osint-c.adb
@@ -197,6 +197,16 @@ package body Osint.C is
       Create_File_And_Check (Output_FD, Text);
    end Create_Output_Library_Info;
 
+   ------------------------------
+   -- Open_Output_Library_Info --
+   ------------------------------
+
+   procedure Open_Output_Library_Info is
+   begin
+      Set_Library_Info_Name;
+      Open_File_To_Append_And_Check (Output_FD, Text);
+   end Open_Output_Library_Info;
+
    -------------------------
    -- Create_Repinfo_File --
    -------------------------
diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads
index 2faef5e..0d6646e 100644
--- a/gcc/ada/osint-c.ads
+++ b/gcc/ada/osint-c.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2014, 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- --
@@ -127,6 +127,12 @@ package Osint.C is
    --  is currently being compiled (i.e. the file which was most recently
    --  returned by Next_Main_Source).
 
+   procedure Open_Output_Library_Info;
+   --  Opens the output library information file for the source file which
+   --  is currently being compiled (i.e. the file which was most recently
+   --  returned by Next_Main_Source) for appending. This is used to append
+   --  the globals computed in flow analysis in gnatprove mode.
+
    procedure Write_Library_Info (Info : String);
    --  Writes the contents of the referenced string to the library information
    --  file for the main source file currently being compiled (i.e. the file
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index 2fb1618..93e2550 100644
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -722,6 +722,23 @@ package body Osint is
       end if;
    end Create_File_And_Check;
 
+   -----------------------------------
+   -- Open_File_To_Append_And_Check --
+   -----------------------------------
+
+   procedure Open_File_To_Append_And_Check
+     (Fdesc : out File_Descriptor;
+      Fmode : Mode)
+   is
+   begin
+      Output_File_Name := Name_Enter;
+      Fdesc := Open_Append (Name_Buffer'Address, Fmode);
+
+      if Fdesc = Invalid_FD then
+         Fail ("Cannot create: " & Name_Buffer (1 .. Name_Len));
+      end if;
+   end Open_File_To_Append_And_Check;
+
    ------------------------
    -- Current_File_Index --
    ------------------------
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index 0ff6738..e281c6a 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -725,6 +725,15 @@ private
    --  parameter is set to either Text or Binary (for details see description
    --  of System.OS_Lib.Create_File).
 
+   procedure Open_File_To_Append_And_Check
+     (Fdesc : out File_Descriptor;
+      Fmode : Mode);
+   --  Opens the file whose name (NUL terminated) is in Name_Buffer (with the
+   --  length in Name_Len), and place the resulting descriptor in Fdesc. Issue
+   --  message and exit with fatal error if file cannot be opened. The Fmode
+   --  parameter is set to either Text or Binary (for details see description
+   --  of System.OS_Lib.Open_Append).
+
    type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified);
    --  Program currently running
    procedure Set_Program (P : Program_Type);
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index 8ea87f2..3fad849 100644
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -2257,6 +2257,33 @@ package body System.OS_Lib is
       return "";
    end Normalize_Pathname;
 
+   -----------------
+   -- Open_Append --
+   -----------------
+
+   function Open_Append
+     (Name  : C_File_Name;
+      Fmode : Mode) return File_Descriptor
+   is
+      function C_Open_Append
+        (Name  : C_File_Name;
+         Fmode : Mode) return File_Descriptor;
+      pragma Import (C, C_Open_Append, "__gnat_open_append");
+   begin
+      return C_Open_Append (Name, Fmode);
+   end Open_Append;
+
+   function Open_Append
+     (Name  : String;
+      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;
+      return Open_Append (C_Name (C_Name'First)'Address, Fmode);
+   end Open_Append;
+
    ---------------
    -- Open_Read --
    ---------------
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index d3ded15..2a24ca2 100644
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -208,14 +208,22 @@ package System.OS_Lib is
    function Open_Read
      (Name  : String;
       Fmode : Mode) return File_Descriptor;
-   --  Open file Name for reading, returning file descriptor File descriptor
-   --  returned is Invalid_FD if file cannot be opened.
+   --  Open file Name for reading, returning its file descriptor. File
+   --  descriptor returned is Invalid_FD if the file cannot be opened.
 
    function Open_Read_Write
      (Name  : String;
       Fmode : Mode) return File_Descriptor;
-   --  Open file Name for both reading and writing, returning file descriptor.
-   --  File descriptor returned is Invalid_FD if file cannot be opened.
+   --  Open file Name for both reading and writing, returning its file
+   --  descriptor. File descriptor returned is Invalid_FD if the file
+   --  cannot be opened.
+
+   function Open_Append
+     (Name  : String;
+      Fmode : Mode) return File_Descriptor;
+   --  Opens file Name for appending, returning its file descriptor. File
+   --  descriptor returned is Invalid_FD if the file cannot be successfully
+   --  opened.
 
    function Create_File
      (Name  : String;
@@ -642,6 +650,10 @@ package System.OS_Lib is
      (Name  : C_File_Name;
       Fmode : Mode) return File_Descriptor;
 
+   function Open_Append
+     (Name  : C_File_Name;
+      Fmode : Mode) return File_Descriptor;
+
    function Create_File
      (Name  : C_File_Name;
       Fmode : Mode) return File_Descriptor;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a741cff..f454a1e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1859,67 +1859,92 @@ package body Sem_Ch13 is
                   --  pragma is one of Convention/Import/Export.
 
                   declare
-                     P_Name   : Name_Id;
-                     A_Name   : Name_Id;
-                     A        : Node_Id;
-                     Arg_List : List_Id;
-                     Found    : Boolean;
-                     L_Assoc  : Node_Id;
-                     E_Assoc  : Node_Id;
+                     Args : constant List_Id := New_List (
+                              Make_Pragma_Argument_Association (Sloc (Expr),
+                                Expression => Relocate_Node (Expr)),
+                              Make_Pragma_Argument_Association (Sloc (Ent),
+                                Expression => Ent));
+
+                     Imp_Exp_Seen : Boolean := False;
+                     --  Flag set when aspect Import or Export has been seen
+
+                     Imp_Seen : Boolean := False;
+                     --  Flag set when aspect Import has been seen
+
+                     Asp        : Node_Id;
+                     Asp_Nam    : Name_Id;
+                     Extern_Arg : Node_Id;
+                     Link_Arg   : Node_Id;
+                     Prag_Nam   : Name_Id;
 
                   begin
-                     P_Name   := Chars (Id);
-                     Found    := False;
-                     Arg_List := New_List;
-                     L_Assoc  := Empty;
-                     E_Assoc  := Empty;
-
-                     A := First (L);
-                     while Present (A) loop
-                        A_Name := Chars (Identifier (A));
-
-                        if Nam_In (A_Name, Name_Import, Name_Export) then
-                           if Found then
-                              Error_Msg_N ("conflicting", A);
+                     Extern_Arg := Empty;
+                     Link_Arg   := Empty;
+                     Prag_Nam   := Chars (Id);
+
+                     Asp := First (L);
+                     while Present (Asp) loop
+                        Asp_Nam := Chars (Identifier (Asp));
+
+                        --  Aspects Import and Export take precedence over
+                        --  aspect Convention. As a result the generated pragma
+                        --  must carry the proper interfacing aspect's name.
+
+                        if Nam_In (Asp_Nam, Name_Import, Name_Export) then
+                           if Imp_Exp_Seen then
+                              Error_Msg_N ("conflicting", Asp);
                            else
-                              Found := True;
+                              Imp_Exp_Seen := True;
+
+                              if Asp_Nam = Name_Import then
+                                 Imp_Seen := True;
+                              end if;
                            end if;
 
-                           P_Name := A_Name;
+                           Prag_Nam := Asp_Nam;
+
+                        --  Aspect External_Name adds an extra argument to the
+                        --  generated pragma.
 
-                        elsif A_Name = Name_Link_Name then
-                           L_Assoc :=
+                        elsif Asp_Nam = Name_External_Name then
+                           Extern_Arg :=
                              Make_Pragma_Argument_Association (Loc,
-                               Chars      => A_Name,
-                               Expression => Relocate_Node (Expression (A)));
+                               Chars      => Asp_Nam,
+                               Expression => Relocate_Node (Expression (Asp)));
 
-                        elsif A_Name = Name_External_Name then
-                           E_Assoc :=
+                        --  Aspect Link_Name adds an extra argument to the
+                        --  generated pragma.
+
+                        elsif Asp_Nam = Name_Link_Name then
+                           Link_Arg :=
                              Make_Pragma_Argument_Association (Loc,
-                               Chars      => A_Name,
-                               Expression => Relocate_Node (Expression (A)));
+                               Chars      => Asp_Nam,
+                               Expression => Relocate_Node (Expression (Asp)));
                         end if;
 
-                        Next (A);
+                        Next (Asp);
                      end loop;
 
-                     Arg_List := New_List (
-                       Make_Pragma_Argument_Association (Sloc (Expr),
-                         Expression => Relocate_Node (Expr)),
-                       Make_Pragma_Argument_Association (Sloc (Ent),
-                         Expression => Ent));
+                     --  Assemble the full argument list
 
-                     if Present (L_Assoc) then
-                        Append_To (Arg_List, L_Assoc);
+                     if Present (Link_Arg) then
+                        Append_To (Args, Link_Arg);
                      end if;
 
-                     if Present (E_Assoc) then
-                        Append_To (Arg_List, E_Assoc);
+                     if Present (Extern_Arg) then
+                        Append_To (Args, Extern_Arg);
                      end if;
 
                      Make_Aitem_Pragma
-                       (Pragma_Argument_Associations => Arg_List,
-                        Pragma_Name                  => P_Name);
+                       (Pragma_Argument_Associations => Args,
+                        Pragma_Name                  => Prag_Nam);
+
+                     --  Store the generated pragma Import in the related
+                     --  subprogram.
+
+                     if Imp_Seen and then Is_Subprogram (E) then
+                        Set_Import_Pragma (E, Aitem);
+                     end if;
                   end;
 
                --  CPU, Interrupt_Priority, Priority
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 33d163b..a711f1b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -25104,6 +25104,9 @@ package body Sem_Prag is
             return Has_Unconstrained_Component (Typ);
          end if;
 
+      elsif Is_Private_Type (Typ) and then Has_Discriminants (Typ) then
+         return True;
+
       else
          return False;
       end if;