[multiple changes]

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb: minor reformatting.

2017-04-25  Doug Rupp  <rupp@adacore.com>

	* sigtramp-vxworks-target.inc [PPC64]: Add a .localentry pseudo-op.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Assignment): Reset Full_Analysis flag on
	the first pass over an assignment statement with target names,
	to prevent the generation of subtypes (such as discriminated
	record components)that may carry the target name outside of the
	tree for the assignment. The subtypes will be generated when
	the assignment is reanalyzed in full.
	(Analyze_Target_Name): Handle properly class-wide types.

From-SVN: r247149

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ad33e2825096eb822053256ccb7fa9a6ae647849..d3635f86c1f8552526e26bcc8a4f28c7441fa009 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_attr.adb: minor reformatting.
+
+2017-04-25  Doug Rupp  <rupp@adacore.com>
+
+       * sigtramp-vxworks-target.inc [PPC64]: Add a .localentry pseudo-op.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch5.adb (Analyze_Assignment): Reset Full_Analysis flag on
+       the first pass over an assignment statement with target names,
+       to prevent the generation of subtypes (such as discriminated
+       record components)that may carry the target name outside of the
+       tree for the assignment. The subtypes will be generated when
+       the assignment is reanalyzed in full.
+       (Analyze_Target_Name): Handle properly class-wide types.
+
 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * elists.ads, elists.adb (Prepend_Unique_Elmt): New routine.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 21d88d7d0a35fd8c4b542d0b8e7de14eccae1e6c..98c057e5ef5f008ee1e4999dc8f1fc23d286d929 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10545,8 +10545,8 @@ package body Sem_Attr is
                                     Entity (Name (Parent (N)));
                         begin
                            if Convention (Subp) = Convention_Intrinsic then
-                              Error_Msg_FE ("subprogram and its formal "
-                              & "parameters have convention Intrinsic",
+                              Error_Msg_FE ("?subprogram and its formal "
+                              & "access parameters have convention Intrinsic",
                                 Parent (N), Subp);
                               Error_Msg_N
                                 ("actual cannot be access attribute", N);

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 8babb8ac25185cb54caa85e995bcea8faad250a7..694c45f6dc105e613a36dbe9c74dd5d2ebaba4c0 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -64,10 +64,12 @@ with Uintp;    use Uintp;
 
 package body Sem_Ch5 is
 
-   Current_LHS : Node_Id := Empty;
-   --  Holds the left-hand side of the assignment statement being analyzed.
-   --  Used to determine the type of a target_name appearing on the RHS, for
-   --  AI12-0125 and the use of '@' as an abbreviation for the LHS.
+   Current_Assignment : Node_Id := Empty;
+   --  This variable holds the node for an assignment that contains target
+   --  names. The corresponding flag has been set by the parser, and when
+   --  set the analysis of the RHS must be done with all expansion disabled,
+   --  because the assignment is reanalyzed after expansion has replaced all
+   --  occurrences of the target name appropriately.
 
    Unblocked_Exit_Count : Nat := 0;
    --  This variable is used when processing if statements, case statements,
@@ -98,11 +100,12 @@ package body Sem_Ch5 is
    --  Ghost mode.
 
    procedure Analyze_Assignment (N : Node_Id) is
-      Lhs  : constant Node_Id := Name (N);
-      Rhs  : constant Node_Id := Expression (N);
-      T1   : Entity_Id;
-      T2   : Entity_Id;
-      Decl : Node_Id;
+      Lhs                : constant Node_Id := Name (N);
+      Rhs                : constant Node_Id := Expression (N);
+      T1                 : Entity_Id;
+      T2                 : Entity_Id;
+      Decl               : Node_Id;
+      Save_Full_Analysis : Boolean;
 
       procedure Diagnose_Non_Variable_Lhs (N : Node_Id);
       --  N is the node for the left hand side of an assignment, and it is not
@@ -284,10 +287,6 @@ package body Sem_Ch5 is
    --  Start of processing for Analyze_Assignment
 
    begin
-      --  Save LHS for use in target names (AI12-125)
-
-      Current_LHS := Lhs;
-
       Mark_Coextensions (N, Rhs);
 
       --  Analyze the target of the assignment first in case the expression
@@ -301,7 +300,12 @@ package body Sem_Ch5 is
       --  during analysis and expansion are properly marked as Ghost.
 
       if Has_Target_Names (N) then
+         Current_Assignment := N;
          Expander_Mode_Save_And_Set (False);
+         Save_Full_Analysis := Full_Analysis;
+         Full_Analysis      := False;
+      else
+         Current_Assignment := Empty;
       end if;
 
       Mark_And_Set_Ghost_Assignment (N, Mode);
@@ -932,7 +936,6 @@ package body Sem_Ch5 is
       Analyze_Dimension (N);
 
    <<Leave>>
-      Current_LHS := Empty;
       Restore_Ghost_Mode (Mode);
 
       --  If the right-hand side contains target names, expansion has been
@@ -942,6 +945,7 @@ package body Sem_Ch5 is
 
       if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then
          Expander_Mode_Restore;
+         Full_Analysis := Save_Full_Analysis;
       end if;
    end Analyze_Assignment;
 
@@ -3543,14 +3547,10 @@ package body Sem_Ch5 is
 
    procedure Analyze_Target_Name (N : Node_Id) is
    begin
-      if No (Current_LHS) then
-         Error_Msg_N ("target name can only appear within an assignment", N);
-         Set_Etype (N, Any_Type);
+      --  A target name has the type of the left-hand side of the enclosing
+      --  assignment.
 
-      else
-         Set_Has_Target_Names (Parent (Current_LHS));
-         Set_Etype (N, Etype (Current_LHS));
-      end if;
+      Set_Etype (N, Etype (Name (Current_Assignment)));
    end Analyze_Target_Name;
 
    ------------------------

diff --git a/gcc/ada/sigtramp-vxworks-target.inc b/gcc/ada/sigtramp-vxworks-target.inc
index 8eacfd82ef2ae4408ead07e4352c0975cadb5471..3db6782bdc6b05cdc0d6d04bf20ac74146e3b827 100644 (file)
--- a/gcc/ada/sigtramp-vxworks-target.inc
+++ b/gcc/ada/sigtramp-vxworks-target.inc
@@ -305,6 +305,7 @@ CR("") \
 TCR("0:") \
 TCR("addis 2,12,.TOC.-0@ha") \
 TCR("addi 2,2,.TOC.-0@l") \
+TCR(".localentry       __gnat_sigtramp_common,.-__gnat_sigtramp_common") \
 TCR("# Allocate frame and save the non-volatile") \
 TCR("# registers we're going to modify") \
 TCR("mflr %r0")        \