diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ad33e2825096..d3635f86c1f8 100644
--- 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 21d88d7d0a35..98c057e5ef5f 100644
--- 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 8babb8ac2518..694c45f6dc10 100644
--- 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 8eacfd82ef2a..3db6782bdc6b 100644
--- 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") \