scans.ads: New token At_Sign.

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* scans.ads: New token At_Sign. Remove '@' from list of illegal
	characters for future version of the language. '@' is legal name.
	* scng.ads, scng.adb (Scan):  Handle '@' appropriately.
	* scn.adb (Scan_Reserved_Identifier): An occurrence of '@'
	denotes a Target_Name.
	* par-ch4.adb (P_Name, P_Primary): Handle Target_Name.
	* sinfo.ads, sinfo.adb (N_Target_Name): New non-terminal node.
	(Has_Target_Names): New flag on N_Assignment_Statement, to
	indicate that RHS has occurrences of N_Target_Name.
	* sem.adb: Call Analyze_Target_Name.
	* sem_ch5.ads, sem_ch5.adb (Analyze_Target_Name): New subpogram.
	(urrent_LHS): Global variable that denotes LHS of assignment,
	used in the analysis of Target_Name nodes.
	* sem_res.adb (Resolve_Target_Name): New procedure.
	* exp_ch5.adb (Expand_Assign_With_Target_Names): (AI12-0125):
	N is an assignment statement whose RHS contains occurences of @
	that designate the value of the LHS of the assignment. If the
	LHS is side-effect free the target names can be replaced with
	a copy of the LHS; otherwise the semantics of the assignment
	is described in terms of a procedure with an in-out parameter,
	and expanded as such.
	(Expand_N_Assignment_Statement): Call
	Expand_Assign_With_Target_Names when needed.
	* exp_util.adb (Insert_Actions): Take into account N_Target_Name.
	* sprint.adb: Handle N_Target_Name.

From-SVN: r244783

gcc/ada/ChangeLog

+2017-01-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* scans.ads: New token At_Sign. Remove '@' from list of illegal
+	characters for future version of the language. '@' is legal name.
+	* scng.ads, scng.adb (Scan):  Handle '@' appropriately.
+	* scn.adb (Scan_Reserved_Identifier): An occurrence of '@'
+	denotes a Target_Name.
+	* par-ch4.adb (P_Name, P_Primary): Handle Target_Name.
+	* sinfo.ads, sinfo.adb (N_Target_Name): New non-terminal node.
+	(Has_Target_Names): New flag on N_Assignment_Statement, to
+	indicate that RHS has occurrences of N_Target_Name.
+	* sem.adb: Call Analyze_Target_Name.
+	* sem_ch5.ads, sem_ch5.adb (Analyze_Target_Name): New subpogram.
+	(urrent_LHS): Global variable that denotes LHS of assignment,
+	used in the analysis of Target_Name nodes.
+	* sem_res.adb (Resolve_Target_Name): New procedure.
+	* exp_ch5.adb (Expand_Assign_With_Target_Names): (AI12-0125):
+	N is an assignment statement whose RHS contains occurences of @
+	that designate the value of the LHS of the assignment. If the
+	LHS is side-effect free the target names can be replaced with
+	a copy of the LHS; otherwise the semantics of the assignment
+	is described in terms of a procedure with an in-out parameter,
+	and expanded as such.
+	(Expand_N_Assignment_Statement): Call
+	Expand_Assign_With_Target_Names when needed.
+	* exp_util.adb (Insert_Actions): Take into account N_Target_Name.
+	* sprint.adb: Handle N_Target_Name.
+
 2017-01-23  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* checks.adb: Minor fix in comment.

gcc/ada/exp_ch5.adb

@@ -115,6 +115,13 @@ package body Exp_Ch5 is
    --  clause (this last case is required because holes in the tagged type
    --  might be filled with components from child types).
 
+   procedure Expand_Assign_With_Target_Names (N : Node_Id);
+   --  (AI12-0125): N is an assignment statement whose RHS contains occurrences
+   --  of @ that designate the value of the LHS of the assignment. If the LHS
+   --  is side-effect free the target names can be replaced with a copy of the
+   --  LHS; otherwise the semantics of the assignment is described in terms of
+   --  a procedure with an in-out parameter, and expanded as such.
+
    procedure Expand_Formal_Container_Loop (N : Node_Id);
    --  Use the primitives specified in an Iterable aspect to expand a loop
    --  over a so-called formal container, primarily for SPARK usage.
@@ -1605,6 +1612,111 @@ package body Exp_Ch5 is
       end;
    end Expand_Assign_Record;
 
+   -------------------------------------
+   -- Expand_Assign_With_Target_Names --
+   -------------------------------------
+
+   procedure Expand_Assign_With_Target_Names (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+      LHS : constant Node_Id := Name (N);
+      RHS : constant Node_Id := Expression (N);
+      Ent : Entity_Id;
+
+      New_RHS : Node_Id;
+
+      function  Replace_Target (N : Node_Id) return Traverse_Result;
+      --  Replace occurrences of the target name by the proper entity: either
+      --  the entity of the LHS in simple cases, or the formal of the
+      --  constructed procedure otherwise.
+
+      --------------------
+      -- Replace_Target --
+      --------------------
+
+      function  Replace_Target (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (N) = N_Target_Name then
+            Rewrite (N, New_Occurrence_Of (Ent, Sloc (N)));
+         end if;
+
+         Set_Analyzed (N, False);
+         return OK;
+      end Replace_Target;
+
+      procedure Replace_Target_Name is new Traverse_Proc (Replace_Target);
+
+   begin
+
+      New_RHS := New_Copy_Tree (RHS);
+
+      if Is_Entity_Name (LHS)
+         and then not Is_Renaming_Of_Object (Entity (LHS))
+      then
+         Ent := Entity (LHS);
+         Replace_Target_Name (New_RHS);
+         Rewrite (N,
+           Make_Assignment_Statement (Loc,
+             Name => Relocate_Node (LHS),
+             Expression => New_RHS));
+
+      elsif Side_Effect_Free (LHS) then
+         Ent := Make_Temporary (Loc, 'T');
+         Insert_Before_And_Analyze (N,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Ent,
+             Object_Definition   => New_Occurrence_Of (Etype (LHS), Loc),
+             Expression          => New_Copy_Tree (LHS)));
+         Replace_Target_Name (New_RHS);
+         Rewrite (N,
+           Make_Assignment_Statement (Loc,
+             Name => Relocate_Node (LHS),
+             Expression => New_RHS));
+
+      else
+         Ent := Make_Temporary (Loc, 'T');
+
+         declare
+            Proc : constant Entity_Id :=
+              Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('P'));
+            Formals : constant List_Id := New_List (
+              Make_Parameter_Specification (Loc,
+                Defining_Identifier => Ent,
+                In_Present          => True,
+                Out_Present         => True,
+                Parameter_Type      => New_Occurrence_Of (Etype (LHS), Loc)));
+            Spec : constant Node_Id :=
+              Make_Procedure_Specification (Loc,
+                 Defining_Unit_Name => Proc,
+                 Parameter_Specifications => Formals);
+            Subp_Body : Node_Id;
+            Call      : Node_Id;
+         begin
+            Replace_Target_Name (New_RHS);
+
+            Subp_Body :=
+               Make_Subprogram_Body (Loc,
+                  Specification => Spec,
+                  Declarations  => Empty_List,
+                  Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => New_List (
+                      Make_Assignment_Statement (Loc,
+                         Name => New_Occurrence_Of (Ent, Loc),
+                         Expression => New_RHS))));
+
+            Insert_Before_And_Analyze (N, Subp_Body);
+            Call := Make_Procedure_Call_Statement (Loc,
+              Name => New_Occurrence_Of (Proc, Loc),
+              Parameter_Associations => New_List (Relocate_Node (LHS)));
+            Rewrite (N, Call);
+         end;
+      end if;
+
+      --  Analyze rewritten node, either as assignment or procedure call.
+
+      Analyze (N);
+   end Expand_Assign_With_Target_Names;
+
    -----------------------------------
    -- Expand_N_Assignment_Statement --
    -----------------------------------
@@ -1647,6 +1759,16 @@ package body Exp_Ch5 is
          Check_Valid_Lvalue_Subscripts (Lhs);
       end if;
 
+      --  Separate expansion if RHS contain target names. Note that assignment
+      --  may already have been expanded if RHS is aggregate.
+
+      if Nkind (N) = N_Assignment_Statement
+        and then Has_Target_Names (N)
+      then
+         Expand_Assign_With_Target_Names (N);
+         return;
+      end if;
+
       --  Ada 2005 (AI-327): Handle assignment to priority of protected object
 
       --  Rewrite an assignment to X'Priority into a run-time call

gcc/ada/exp_util.adb

@@ -5930,6 +5930,7 @@ package body Exp_Util is
                | N_String_Literal
                | N_Subtype_Indication
                | N_Subunit
+               | N_Target_Name
                | N_Task_Definition
                | N_Terminate_Alternative
                | N_Triggering_Alternative

gcc/ada/par-ch4.adb

-------------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
@@ -145,7 +145,7 @@ package body Ch4 is
    --  | INDEXED_COMPONENT  | SLICE
    --  | SELECTED_COMPONENT | ATTRIBUTE
    --  | TYPE_CONVERSION    | FUNCTION_CALL
-   --  | CHARACTER_LITERAL
+   --  | CHARACTER_LITERAL  | TARGET_NAME
 
    --  DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
 
@@ -181,6 +181,8 @@ package body Ch4 is
 
    --  EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
 
+   --  TARGET_NAME ::= @   (AI12-0125-3: abbreviation for LHS)
+
    --  Note: syntactically a procedure call looks just like a function call,
    --  so this routine is in practice used to scan out procedure calls as well.
 
@@ -229,6 +231,10 @@ package body Ch4 is
       end if;
 
       --  Loop through designators in qualified name
+      --  AI12-0125 : target_name
+      if Token = Tok_At_Sign then
+         Scan_Reserved_Identifier (Force_Msg => False);
+      end if;
 
       Name_Node := Token_Node;
 
@@ -2332,8 +2338,8 @@ package body Ch4 is
       if Token = Tok_Dot then
          Error_Msg_SC ("prefix for selection is not a name");
 
-         --  If qualified expression, comment and continue, otherwise something
-         --  is pretty nasty so do an Error_Resync call.
+         --  If qualified expression, comment and continue, otherwise
+         --  something is pretty nasty so do an Error_Resync call.
 
          if Ada_Version < Ada_2012
            and then Nkind (Node1) = N_Qualified_Expression
@@ -2791,6 +2797,15 @@ package body Ch4 is
                Error_Msg_SC ("parentheses required for unary minus");
                Scan; -- past minus
 
+            when Tok_At_Sign =>    --  AI12-0125 : target_name
+               if not Extensions_Allowed then
+                  Error_Msg_SC ("target name is an Ada 2020 extension");
+                  Error_Msg_SC ("\compile with -gnatX");
+               end if;
+
+               Node1 := P_Name;
+               return Node1;
+
             --  Anything else is illegal as the first token of a primary, but
             --  we test for some common errors, to improve error messages.
 

gcc/ada/scans.ads

@@ -61,6 +61,8 @@ package Scans is
 
       Tok_Identifier,      -- identifier   Name, Lit_Or_Name, Desig
 
+      Tok_At_Sign,         -- @  AI12-0125-3 : target name
+
       Tok_Double_Asterisk, -- **
 
       Tok_Ampersand,       -- &            Binary_Addop
@@ -213,8 +215,10 @@ package Scans is
       --  also when scanning project files (where it is needed because of ???)
 
       Tok_Special,
-      --  Used only in preprocessor scanning (to represent one of the
-      --  characters '#', '$', '?', '@', '`', '\', '^', '~', or '_'. The
+      --  AI12-0125-03 : target name as abbreviation for LHS
+
+      --  Otherwise used only in preprocessor scanning (to represent one of
+      --  the characters '#', '$', '?', '@', '`', '\', '^', '~', or '_'. The
       --  character value itself is stored in Scans.Special_Character.
 
       Tok_SPARK_Hide,
@@ -269,12 +273,13 @@ package Scans is
    --  of Pascal style not equal operator).
 
    subtype Token_Class_Name is
-     Token_Type range Tok_Char_Literal .. Tok_Identifier;
+   Token_Type range Tok_Char_Literal .. Tok_At_Sign;
    --  First token of name (4.1),
    --    (identifier, char literal, operator symbol)
+   --  Includes '@' after Ada2012 corrigendum.
 
    subtype Token_Class_Desig is
-     Token_Type range Tok_Operator_Symbol .. Tok_Identifier;
+     Token_Type range Tok_Operator_Symbol .. Tok_At_Sign;
    --  Token which can be a Designator (identifier, operator symbol)
 
    subtype Token_Class_Namext is
@@ -397,6 +402,11 @@ package Scans is
    --  file being compiled. This CRC includes only program tokens, and
    --  excludes comments.
 
+   Limited_Checksum : Word := 0;
+   --  Used to accumulate a CRC representing significant tokens in the
+   --  limited view of a package, i.e. visible type names and related
+   --  tagged indicators.
+
    First_Non_Blank_Location : Source_Ptr := No_Location; -- init for -gnatVa
    --  Location of first non-blank character on the line containing the
    --  current token (i.e. the location of the character whose column number
@@ -461,8 +471,9 @@ package Scans is
    --  Wide_Character).
 
    Special_Character : Character;
+   --  AI12-0125-03 : '@' as target name is handled elsewhere.
    --  Valid only when Token = Tok_Special. Returns one of the characters
-   --  '#', '$', '?', '@', '`', '\', '^', '~', or '_'.
+   --  '#', '$', '?', '`', '\', '^', '~', or '_'.
    --
    --  Why only this set? What about wide characters???
 

gcc/ada/scn.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, 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- --
@@ -383,6 +383,14 @@ package body Scn is
       Token_Chars : constant String := Token_Type'Image (Token);
 
    begin
+      --  AI12-0125 : '@' denotes the target_name, i.e. serves as an
+      --  abbreviation for the LHS of an assignment.
+
+      if Token = Tok_At_Sign then
+         Token_Node := New_Node (N_Target_Name, Token_Ptr);
+         return;
+      end if;
+
       --  We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
       --  This code extracts the xxx and makes an identifier out of it.
 

gcc/ada/scng.adb

@@ -158,6 +158,7 @@ package body Scng is
             | Tok_And
             | Tok_Apostrophe
             | Tok_Array
+            | Tok_At_Sign
             | Tok_Asterisk
             | Tok_At
             | Tok_Body
@@ -302,6 +303,7 @@ package body Scng is
             | Tok_Array
             | Tok_Asterisk
             | Tok_At
+            | Tok_At_Sign
             | Tok_Body
             | Tok_Box
             | Tok_Char_Literal
@@ -1609,6 +1611,19 @@ package body Scng is
                return;
             end if;
 
+         when '@' =>
+            if not Extensions_Allowed then
+               Error_Illegal_Character;
+               Scan_Ptr := Scan_Ptr + 1;
+
+            else
+               --  AI12-0125-03 : @ is target_name
+               Accumulate_Checksum ('@');
+               Scan_Ptr := Scan_Ptr + 1;
+               Token := Tok_At_Sign;
+               return;
+            end if;
+
          --  Asterisk (can be multiplication operator or double asterisk which
          --  is the exponentiation compound delimiter).
 
@@ -2421,8 +2436,9 @@ package body Scng is
             Error_Illegal_Character;
 
          --  Invalid graphic characters
-
-         when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' =>
+         --  Note that '@' is handled elsewhere, because following AI12-125
+         --  it denotes the target_name of an assignment.
+         when '#' | '$' | '?' | '`' | '\' | '^' | '~' =>
 
             --  If Set_Special_Character has been called for this character,
             --  set Scans.Special_Character and return a Special token.

gcc/ada/scng.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, 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- --
@@ -78,8 +78,10 @@ package Scng is
    --  either a keyword or an identifier. See also package Casing.
 
    procedure Set_Special_Character (C : Character);
-   --  Indicate that one of the following character '#', '$', '?', '@', '`',
+   --  Indicate that one of the following character '#', '$', '?',  '`',
    --  '\', '^', '_' or '~', when found is a Special token.
+   --  AI12-0125-03 : target name (ES) is not in this list because '@' is
+   --  handled as a special token as abbreviation of LHS of assignment.
 
    procedure Reset_Special_Characters;
    --  Indicate that there is no characters that are Special tokens., which

gcc/ada/sem.adb

@@ -563,6 +563,9 @@ package body Sem is
          when N_Subunit =>
             Analyze_Subunit (N);
 
+         when N_Target_Name =>
+            Analyze_Target_Name (N);
+
          when N_Task_Body =>
             Analyze_Task_Body (N);
 

gcc/ada/sem_ch5.adb

@@ -64,6 +64,11 @@ 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.
+
    Unblocked_Exit_Count : Nat := 0;
    --  This variable is used when processing if statements, case statements,
    --  and block statements. It counts the number of exit points that are not
@@ -279,6 +284,9 @@ 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
@@ -558,8 +566,20 @@ package body Sem_Ch5 is
       --  Now we can complete the resolution of the right hand side
 
       Set_Assignment_Type (Lhs, T1);
+
       Resolve (Rhs, T1);
 
+      --  If the right-hand side contains target names, expansion has been
+      --  disabled to prevent expansion that might move target names out of
+      --  the context of the assignment statement. Restore the expander mode
+      --  now so that assignment statement can be properly expanded.
+
+      if  Nkind (N) = N_Assignment_Statement
+        and then Has_Target_Names (N)
+      then
+         Expander_Mode_Restore;
+      end if;
+
       --  This is the point at which we check for an unset reference
 
       Check_Unset_Reference (Rhs);
@@ -918,6 +938,7 @@ package body Sem_Ch5 is
       Analyze_Dimension (N);
 
    <<Leave>>
+      Current_LHS := Empty;
       Restore_Ghost_Mode (Mode);
    end Analyze_Assignment;
 
@@ -3513,6 +3534,30 @@ package body Sem_Ch5 is
       null;
    end Analyze_Null_Statement;
 
+   -------------------------
+   -- Analyze_Target_Name --
+   -------------------------
+
+   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);
+      else
+         Set_Has_Target_Names (Parent (Current_LHS));
+         Set_Etype (N, Etype (Current_LHS));
+
+         --  Disable expansion for the rest of the analysis of the current
+         --  right-hand side. The enclosing assignment statement will be
+         --  rewritten during expansion, together with occurrences of the
+         --  target name.
+
+         if Expander_Active then
+            Expander_Mode_Save_And_Set (False);
+         end if;
+      end if;
+   end Analyze_Target_Name;
+
    ------------------------
    -- Analyze_Statements --
    ------------------------

gcc/ada/sem_ch5.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -41,6 +41,7 @@ package Sem_Ch5 is
    procedure Analyze_Loop_Parameter_Specification (N : Node_Id);
    procedure Analyze_Loop_Statement               (N : Node_Id);
    procedure Analyze_Null_Statement               (N : Node_Id);
+   procedure Analyze_Target_Name                  (N : Node_Id);
    procedure Analyze_Statements                   (L : List_Id);
 
    procedure Analyze_Label_Entity (E : Entity_Id);

gcc/ada/sem_res.adb

@@ -203,6 +203,7 @@ package body Sem_Res is
    procedure Resolve_Short_Circuit             (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Slice                     (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_String_Literal            (N : Node_Id; Typ : Entity_Id);
+   procedure Resolve_Target_Name               (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Type_Conversion           (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Unary_Op                  (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Unchecked_Expression      (N : Node_Id; Typ : Entity_Id);
@@ -2985,6 +2986,9 @@ package body Sem_Res is
             when N_String_Literal =>
                Resolve_String_Literal            (N, Ctx_Type);
 
+            when N_Target_Name =>
+               Resolve_Target_Name               (N, Ctx_Type);
+
             when N_Type_Conversion =>
                Resolve_Type_Conversion           (N, Ctx_Type);
 
@@ -10638,6 +10642,15 @@ package body Sem_Res is
       end;
    end Resolve_String_Literal;
 
+   -------------------------
+   -- Resolve_Target_Name --
+   -------------------------
+
+   procedure Resolve_Target_Name (N : Node_Id; Typ : Entity_Id) is
+   begin
+      Set_Etype (N, Typ);
+   end Resolve_Target_Name;
+
    -----------------------------
    -- Resolve_Type_Conversion --
    -----------------------------

gcc/ada/sinfo.adb

@@ -1606,6 +1606,14 @@ package body Sinfo is
       return Flag5 (N);
    end Has_Storage_Size_Pragma;
 
+   function Has_Target_Names
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Assignment_Statement);
+      return Flag8 (N);
+   end Has_Target_Names;
+
    function Has_Wide_Character
       (N : Node_Id) return Boolean is
    begin
@@ -4898,6 +4906,14 @@ package body Sinfo is
       Set_Flag5 (N, Val);
    end Set_Has_Storage_Size_Pragma;
 
+   procedure Set_Has_Target_Names
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Assignment_Statement);
+      Set_Flag8 (N, Val);
+   end Set_Has_Target_Names;
+
    procedure Set_Has_Wide_Character
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1543,6 +1543,10 @@ package Sinfo is
    --    code outside the Character range but within Wide_Character range)
    --    appears in the string. Used to implement pragma preference rules.
 
+   --  Has_Target_Names (Flag8-Sem)
+   --    Present in assignment statements. Indicates that the RHS contains
+   --    target names (see AI12-0125-3) and must be expanded accordingly.
+
    --  Has_Wide_Wide_Character (Flag13-Sem)
    --    Present in string literals, set if any wide character (i.e. character
    --    code outside the Wide_Character range) appears in the string. Used to
@@ -4794,6 +4798,7 @@ package Sinfo is
       --  Forwards_OK (Flag5-Sem)
       --  Backwards_OK (Flag6-Sem)
       --  No_Ctrl_Actions (Flag7-Sem)
+      --  Has_Target_Names (Flag8-Sem)
       --  Componentwise_Assignment (Flag14-Sem)
       --  Suppress_Assignment_Checks (Flag18-Sem)
 
@@ -4808,6 +4813,19 @@ package Sinfo is
       --  case the front end must generate an extra temporary and initialize
       --  this temporary as required (the temporary itself is not atomic).
 
+      ------------------
+      --  Target_Name --
+      ------------------
+
+      --  N_Target_Name
+      --  Sloc points to @
+      --  Etype (Node5-Sem)
+
+      --  Note (Ada 2020): node is used during analysis as a placeholder for
+      --  the value of the LHS of the enclosing assignment statement. Node is
+      --  eventually rewritten together with enclosing assignment, and backends
+      --  are not aware of it.
+
       -----------------------
       -- 5.3  If Statement --
       -----------------------
@@ -8463,6 +8481,7 @@ package Sinfo is
       N_Reference,
       N_Selected_Component,
       N_Slice,
+      N_Target_Name,
       N_Type_Conversion,
       N_Unchecked_Expression,
       N_Unchecked_Type_Conversion,
@@ -9385,6 +9404,9 @@ package Sinfo is
    function Has_Storage_Size_Pragma
      (N : Node_Id) return Boolean;    -- Flag5
 
+   function Has_Target_Names
+     (N : Node_Id) return Boolean;    -- Flag8
+
    function Has_Wide_Character
      (N : Node_Id) return Boolean;    -- Flag11
 
@@ -10438,6 +10460,9 @@ package Sinfo is
    procedure Set_Has_Storage_Size_Pragma
      (N : Node_Id; Val : Boolean := True);    -- Flag5
 
+   procedure Set_Has_Target_Names
+     (N : Node_Id; Val : Boolean := True);    -- Flag8
+
    procedure Set_Has_Wide_Character
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
@@ -11737,6 +11762,13 @@ package Sinfo is
         4 => False,   --  unused
         5 => False),  --  unused
 
+     N_Target_Name =>
+       (1 => False,   --  unused
+        2 => False,   --  unused
+        3 => False,   --  unused
+        4 => False,   --  unused
+        5 => False),  --  Etype (Node5-Sem)
+
      N_If_Statement =>
        (1 => True,    --  Condition (Node1)
         2 => True,    --  Then_Statements (List2)
@@ -12944,6 +12976,7 @@ package Sinfo is
    pragma Inline (Has_Private_View);
    pragma Inline (Has_Relative_Deadline_Pragma);
    pragma Inline (Has_Storage_Size_Pragma);
+   pragma Inline (Has_Target_Names);
    pragma Inline (Has_Wide_Character);
    pragma Inline (Has_Wide_Wide_Character);
    pragma Inline (Header_Size_Added);
@@ -13292,6 +13325,7 @@ package Sinfo is
    pragma Inline (Set_Has_Self_Reference);
    pragma Inline (Set_Has_SP_Choice);
    pragma Inline (Set_Has_Storage_Size_Pragma);
+   pragma Inline (Set_Has_Target_Names);
    pragma Inline (Set_Has_Wide_Character);
    pragma Inline (Set_Has_Wide_Wide_Character);
    pragma Inline (Set_Header_Size_Added);

gcc/ada/sprint.adb

@@ -3287,6 +3287,9 @@ package body Sprint is
             Extra_Blank_Line;
             Sprint_Node (Proper_Body (Node));
 
+         when N_Target_Name =>
+            Write_Char ('@');
+
          when N_Task_Body =>
             Write_Indent_Str_Sloc ("task body ");
             Write_Id (Defining_Identifier (Node));