2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>

	* gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in
	codepeer mode.

2017-04-25  Javier Miranda  <miranda@adacore.com>

	* urealp.adb (UR_Write): Fix output of constants with a base other
	that 10.

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
	* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
	Add extra parameter for Process_Interface_Name.
	(Process_Interface_Name): Add parameter for pragma to analyze
	corresponding aspect.
	* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
	from sem_ch13.adb

From-SVN: r247160

7 files changed, 198 insertions, 137 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 192e893..8748148 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>
+
+	* gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in
+	codepeer mode.
+
+2017-04-25  Javier Miranda  <miranda@adacore.com>
+
+	* urealp.adb (UR_Write): Fix output of constants with a base other
+	that 10.
+
+2017-04-25  Justin Squirek  <squirek@adacore.com>
+
+	* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
+	* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
+	Add extra parameter for Process_Interface_Name.
+	(Process_Interface_Name): Add parameter for pragma to analyze
+	corresponding aspect.
+	* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
+	from sem_ch13.adb
+
 2017-04-25  Gary Dismukes  <dismukes@adacore.com>
 
 	* exp_ch7.adb, einfo.ads, sem_prag.adb: Minor reformatting and typo
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 30ccd61..22139df 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -286,6 +286,11 @@ procedure Gnat1drv is
 
          Debug_Generated_Code := False;
 
+         --  Ditto for -gnateG which interacts badly with handling of pragma
+         --  Annotate in gnat2scil.
+
+         Generate_Processed_File := False;
+
          --  Disable Exception_Extra_Info (-gnateE) which generates more
          --  complex trees with no added value, and may confuse CodePeer.
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ce47fd8..fdc3929 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -147,27 +147,6 @@ package body Sem_Ch13 is
    --  Uint value. If the value is inappropriate, then error messages are
    --  posted as required, and a value of No_Uint is returned.
 
-   procedure Get_Interfacing_Aspects
-     (Iface_Asp : Node_Id;
-      Conv_Asp  : out Node_Id;
-      EN_Asp    : out Node_Id;
-      Expo_Asp  : out Node_Id;
-      Imp_Asp   : out Node_Id;
-      LN_Asp    : out Node_Id;
-      Do_Checks : Boolean := False);
-   --  Given a single interfacing aspect Iface_Asp, retrieve other interfacing
-   --  aspects that apply to the same related entity. The aspects considered by
-   --  this routine are as follows:
-   --
-   --    Conv_Asp - aspect Convention
-   --    EN_Asp   - aspect External_Name
-   --    Expo_Asp - aspect Export
-   --    Imp_Asp  - aspect Import
-   --    LN_Asp   - aspect Link_Name
-   --
-   --  When flag Do_Checks is set, this routine will flag duplicate uses of
-   --  aspects.
-
    function Is_Operational_Item (N : Node_Id) return Boolean;
    --  A specification for a stream attribute is allowed before the full type
    --  is declared, as explained in AI-00137 and the corrigendum. Attributes
@@ -11214,106 +11193,6 @@ package body Sem_Ch13 is
       end if;
    end Get_Alignment_Value;
 
-   -----------------------------
-   -- Get_Interfacing_Aspects --
-   -----------------------------
-
-   procedure Get_Interfacing_Aspects
-     (Iface_Asp : Node_Id;
-      Conv_Asp  : out Node_Id;
-      EN_Asp    : out Node_Id;
-      Expo_Asp  : out Node_Id;
-      Imp_Asp   : out Node_Id;
-      LN_Asp    : out Node_Id;
-      Do_Checks : Boolean := False)
-   is
-      procedure Save_Or_Duplication_Error
-        (Asp : Node_Id;
-         To  : in out Node_Id);
-      --  Save the value of aspect Asp in node To. If To already has a value,
-      --  then this is considered a duplicate use of aspect. Emit an error if
-      --  flag Do_Checks is set.
-
-      -------------------------------
-      -- Save_Or_Duplication_Error --
-      -------------------------------
-
-      procedure Save_Or_Duplication_Error
-        (Asp : Node_Id;
-         To  : in out Node_Id)
-      is
-      begin
-         --  Detect an extra aspect and issue an error
-
-         if Present (To) then
-            if Do_Checks then
-               Error_Msg_Name_1 := Chars (Identifier (Asp));
-               Error_Msg_Sloc   := Sloc (To);
-               Error_Msg_N ("aspect % previously given #", Asp);
-            end if;
-
-         --  Otherwise capture the aspect
-
-         else
-            To := Asp;
-         end if;
-      end Save_Or_Duplication_Error;
-
-      --  Local variables
-
-      Asp    : Node_Id;
-      Asp_Id : Aspect_Id;
-
-      --  The following variables capture each individual aspect
-
-      Conv : Node_Id := Empty;
-      EN   : Node_Id := Empty;
-      Expo : Node_Id := Empty;
-      Imp  : Node_Id := Empty;
-      LN   : Node_Id := Empty;
-
-   --  Start of processing for Get_Interfacing_Aspects
-
-   begin
-      --  The input interfacing aspect should reside in an aspect specification
-      --  list.
-
-      pragma Assert (Is_List_Member (Iface_Asp));
-
-      --  Examine the aspect specifications of the related entity. Find and
-      --  capture all interfacing aspects. Detect duplicates and emit errors
-      --  if applicable.
-
-      Asp := First (List_Containing (Iface_Asp));
-      while Present (Asp) loop
-         Asp_Id := Get_Aspect_Id (Asp);
-
-         if Asp_Id = Aspect_Convention then
-            Save_Or_Duplication_Error (Asp, Conv);
-
-         elsif Asp_Id = Aspect_External_Name then
-            Save_Or_Duplication_Error (Asp, EN);
-
-         elsif Asp_Id = Aspect_Export then
-            Save_Or_Duplication_Error (Asp, Expo);
-
-         elsif Asp_Id = Aspect_Import then
-            Save_Or_Duplication_Error (Asp, Imp);
-
-         elsif Asp_Id = Aspect_Link_Name then
-            Save_Or_Duplication_Error (Asp, LN);
-         end if;
-
-         Next (Asp);
-      end loop;
-
-      Conv_Asp := Conv;
-      EN_Asp   := EN;
-      Expo_Asp := Expo;
-      Imp_Asp  := Imp;
-      LN_Asp   := LN;
-   end Get_Interfacing_Aspects;
-
    -------------------------------------
    -- Inherit_Aspects_At_Freeze_Point --
    -------------------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c00e86b..4549e8a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3927,7 +3927,8 @@ package body Sem_Prag is
       procedure Process_Interface_Name
         (Subprogram_Def : Entity_Id;
          Ext_Arg        : Node_Id;
-         Link_Arg       : Node_Id);
+         Link_Arg       : Node_Id;
+         Prag           : Node_Id);
       --  Given the last two arguments of pragma Import, pragma Export, or
       --  pragma Interface_Name, performs validity checks and sets the
       --  Interface_Name field of the given subprogram entity to the
@@ -3936,7 +3937,9 @@ package body Sem_Prag is
       --  Ext_Arg may represent the Link_Name if Link_Arg is missing, and
       --  appropriate named notation is used for Ext_Arg. If neither Ext_Arg
       --  nor Link_Arg is present, the interface name is set to the default
-      --  from the subprogram name.
+      --  from the subprogram name. In addition, the pragma itself is passed
+      --  to analyze any expressions in the case the pragma came from an aspect
+      --  specification.
 
       procedure Process_Interrupt_Or_Attach_Handler;
       --  Common processing for Interrupt and Attach_Handler pragmas
@@ -8421,7 +8424,7 @@ package body Sem_Prag is
                   Set_Imported (Def_Id);
                end if;
 
-               Process_Interface_Name (Def_Id, Arg3, Arg4);
+               Process_Interface_Name (Def_Id, Arg3, Arg4, N);
 
                --  Note that we do not set Is_Public here. That's because we
                --  only want to set it if there is no address clause, and we
@@ -8583,7 +8586,7 @@ package body Sem_Prag is
                      end if;
                   end;
 
-                  Process_Interface_Name (Def_Id, Arg3, Arg4);
+                  Process_Interface_Name (Def_Id, Arg3, Arg4, N);
                end if;
 
                if Is_Compilation_Unit (Hom_Id) then
@@ -9128,7 +9131,8 @@ package body Sem_Prag is
       procedure Process_Interface_Name
         (Subprogram_Def : Entity_Id;
          Ext_Arg        : Node_Id;
-         Link_Arg       : Node_Id)
+         Link_Arg       : Node_Id;
+         Prag           : Node_Id)
       is
          Ext_Nam    : Node_Id;
          Link_Nam   : Node_Id;
@@ -9179,6 +9183,40 @@ package body Sem_Prag is
       --  Start of processing for Process_Interface_Name
 
       begin
+         --  If we are looking at a pragma that comes from an aspect then it
+         --  needs to have its corresponding aspect argument expressions
+         --  analyzed in addition to the generated pragma so that aspects
+         --  within generic units get properly resolved.
+
+         if Present (Prag) and then From_Aspect_Specification (Prag) then
+            declare
+               Asp     : constant Node_Id := Corresponding_Aspect (Prag);
+               Dummy_1 : Node_Id;
+               Dummy_2 : Node_Id;
+               Dummy_3 : Node_Id;
+               EN      : Node_Id;
+               LN      : Node_Id;
+
+            begin
+               --  Obtain all interfacing aspects used to construct the pragma
+
+               Get_Interfacing_Aspects
+                 (Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN);
+
+               --  Analyze the expression of aspect External_Name
+
+               if Present (EN) then
+                  Analyze (Expression (EN));
+               end if;
+
+               --  Analyze the expressio of aspect Link_Name
+
+               if Present (LN) then
+                  Analyze (Expression (LN));
+               end if;
+            end;
+         end if;
+
          if No (Link_Arg) then
             if No (Ext_Arg) then
                return;
@@ -13497,7 +13535,7 @@ package body Sem_Prag is
                if Arg_Count >= 2 then
                   Set_Imported (Def_Id);
                   Set_Is_Public (Def_Id);
-                  Process_Interface_Name (Def_Id, Arg2, Arg3);
+                  Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                end if;
 
                Set_Has_Completion (Def_Id);
@@ -14648,7 +14686,7 @@ package body Sem_Prag is
                     (Get_Pragma_Arg (Arg2), Sure => False);
                end if;
 
-               Process_Interface_Name (Def_Id, Arg3, Arg4);
+               Process_Interface_Name (Def_Id, Arg3, Arg4, N);
                Set_Exported (Def_Id, Arg2);
             end if;
 
@@ -15154,7 +15192,7 @@ package body Sem_Prag is
 
             Note_Possible_Modification
               (Get_Pragma_Arg (Arg2), Sure => False);
-            Process_Interface_Name (E, Arg3, Arg4);
+            Process_Interface_Name (E, Arg3, Arg4, N);
             Set_Exported (E, Arg2);
          end External;
 
@@ -16607,7 +16645,7 @@ package body Sem_Prag is
                   end if;
 
                   Set_Is_Public (Def_Id);
-                  Process_Interface_Name (Def_Id, Arg2, Arg3);
+                  Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                end if;
 
             --  Otherwise must be subprogram
@@ -16627,7 +16665,7 @@ package body Sem_Prag is
                   Def_Id := Get_Base_Subprogram (Hom_Id);
 
                   if Is_Imported (Def_Id) then
-                     Process_Interface_Name (Def_Id, Arg2, Arg3);
+                     Process_Interface_Name (Def_Id, Arg2, Arg3, N);
                      Found := True;
                   end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8b78008..ebf585a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8181,6 +8181,106 @@ package body Sem_Util is
       end if;
    end Get_Index_Bounds;
 
+   -----------------------------
+   -- Get_Interfacing_Aspects --
+   -----------------------------
+
+   procedure Get_Interfacing_Aspects
+     (Iface_Asp : Node_Id;
+      Conv_Asp  : out Node_Id;
+      EN_Asp    : out Node_Id;
+      Expo_Asp  : out Node_Id;
+      Imp_Asp   : out Node_Id;
+      LN_Asp    : out Node_Id;
+      Do_Checks : Boolean := False)
+   is
+      procedure Save_Or_Duplication_Error
+        (Asp : Node_Id;
+         To  : in out Node_Id);
+      --  Save the value of aspect Asp in node To. If To already has a value,
+      --  then this is considered a duplicate use of aspect. Emit an error if
+      --  flag Do_Checks is set.
+
+      -------------------------------
+      -- Save_Or_Duplication_Error --
+      -------------------------------
+
+      procedure Save_Or_Duplication_Error
+        (Asp : Node_Id;
+         To  : in out Node_Id)
+      is
+      begin
+         --  Detect an extra aspect and issue an error
+
+         if Present (To) then
+            if Do_Checks then
+               Error_Msg_Name_1 := Chars (Identifier (Asp));
+               Error_Msg_Sloc   := Sloc (To);
+               Error_Msg_N ("aspect % previously given #", Asp);
+            end if;
+
+         --  Otherwise capture the aspect
+
+         else
+            To := Asp;
+         end if;
+      end Save_Or_Duplication_Error;
+
+      --  Local variables
+
+      Asp    : Node_Id;
+      Asp_Id : Aspect_Id;
+
+      --  The following variables capture each individual aspect
+
+      Conv : Node_Id := Empty;
+      EN   : Node_Id := Empty;
+      Expo : Node_Id := Empty;
+      Imp  : Node_Id := Empty;
+      LN   : Node_Id := Empty;
+
+   --  Start of processing for Get_Interfacing_Aspects
+
+   begin
+      --  The input interfacing aspect should reside in an aspect specification
+      --  list.
+
+      pragma Assert (Is_List_Member (Iface_Asp));
+
+      --  Examine the aspect specifications of the related entity. Find and
+      --  capture all interfacing aspects. Detect duplicates and emit errors
+      --  if applicable.
+
+      Asp := First (List_Containing (Iface_Asp));
+      while Present (Asp) loop
+         Asp_Id := Get_Aspect_Id (Asp);
+
+         if Asp_Id = Aspect_Convention then
+            Save_Or_Duplication_Error (Asp, Conv);
+
+         elsif Asp_Id = Aspect_External_Name then
+            Save_Or_Duplication_Error (Asp, EN);
+
+         elsif Asp_Id = Aspect_Export then
+            Save_Or_Duplication_Error (Asp, Expo);
+
+         elsif Asp_Id = Aspect_Import then
+            Save_Or_Duplication_Error (Asp, Imp);
+
+         elsif Asp_Id = Aspect_Link_Name then
+            Save_Or_Duplication_Error (Asp, LN);
+         end if;
+
+         Next (Asp);
+      end loop;
+
+      Conv_Asp := Conv;
+      EN_Asp   := EN;
+      Expo_Asp := Expo;
+      Imp_Asp  := Imp;
+      LN_Asp   := LN;
+   end Get_Interfacing_Aspects;
+
    ---------------------------------
    -- Get_Iterable_Type_Primitive --
    ---------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 7c0affc..014cb63 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -923,6 +923,27 @@ package Sem_Util is
    --  the index type turns out to be a partial view; this case should not
    --  arise during normal compilation of semantically correct programs.
 
+   procedure Get_Interfacing_Aspects
+     (Iface_Asp : Node_Id;
+      Conv_Asp  : out Node_Id;
+      EN_Asp    : out Node_Id;
+      Expo_Asp  : out Node_Id;
+      Imp_Asp   : out Node_Id;
+      LN_Asp    : out Node_Id;
+      Do_Checks : Boolean := False);
+   --  Given a single interfacing aspect Iface_Asp, retrieve other interfacing
+   --  aspects that apply to the same related entity. The aspects considered by
+   --  this routine are as follows:
+   --
+   --    Conv_Asp - aspect Convention
+   --    EN_Asp   - aspect External_Name
+   --    Expo_Asp - aspect Export
+   --    Imp_Asp  - aspect Import
+   --    LN_Asp   - aspect Link_Name
+   --
+   --  When flag Do_Checks is set, this routine will flag duplicate uses of
+   --  aspects.
+
    function Get_Enum_Lit_From_Pos
      (T   : Entity_Id;
       Pos : Uint;
diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb
index f2f036b..b839933 100644
--- a/gcc/ada/urealp.adb
+++ b/gcc/ada/urealp.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -1472,8 +1472,8 @@ package body Urealp is
       --  of the following forms, depending on the sign of the number
       --  and the sign of the exponent (= minus denominator value)
 
-      --    numerator.0*base**exponent
-      --    numerator.0*base**-exponent
+      --    numerator.0/base**exponent
+      --    numerator.0/base**-exponent
 
       --  And of course an exponent of 0 can be omitted
 
@@ -1486,16 +1486,14 @@ package body Urealp is
          Write_Str (".0");
 
          if Val.Den /= 0 then
-            Write_Char ('*');
+            Write_Char ('/');
             Write_Int (Val.Rbase);
             Write_Str ("**");
 
             if Val.Den <= 0 then
                UI_Write (-Val.Den, Decimal);
             else
-               Write_Str ("(-");
                UI_Write (Val.Den, Decimal);
-               Write_Char (')');
             end if;
          end if;