aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2017-01-23 11:29:17 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2017-01-23 12:29:17 +0100
commitae33543ca51ec15393064ab2075fed28c33ce2d0 (patch)
tree0d42deb5fa5f86755159535db76effcdd549b3f5 /gcc/ada
parent13230c68da020c55d3369b489c0b49032637e242 (diff)
downloadgcc-ae33543ca51ec15393064ab2075fed28c33ce2d0.zip
gcc-ae33543ca51ec15393064ab2075fed28c33ce2d0.tar.gz
gcc-ae33543ca51ec15393064ab2075fed28c33ce2d0.tar.bz2
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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog28
-rw-r--r--gcc/ada/exp_ch5.adb122
-rw-r--r--gcc/ada/exp_util.adb1
-rw-r--r--gcc/ada/par-ch4.adb23
-rw-r--r--gcc/ada/scans.ads21
-rw-r--r--gcc/ada/scn.adb10
-rw-r--r--gcc/ada/scng.adb20
-rw-r--r--gcc/ada/scng.ads6
-rw-r--r--gcc/ada/sem.adb3
-rw-r--r--gcc/ada/sem_ch5.adb45
-rw-r--r--gcc/ada/sem_ch5.ads3
-rw-r--r--gcc/ada/sem_res.adb13
-rw-r--r--gcc/ada/sinfo.adb16
-rw-r--r--gcc/ada/sinfo.ads34
-rw-r--r--gcc/ada/sprint.adb3
15 files changed, 333 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 72ba34b..8a676d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+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.
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index c372a72..17233c2 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/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
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 1cbffd1..f181bede 100644
--- a/gcc/ada/exp_util.adb
+++ b/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
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index f52b6ad..af2ed87 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1,4 +1,4 @@
-------------------------------------------------------------------------------
+-----------------------------------------------------------------------------
-- --
-- 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.
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index afbdf96..8ff3f9d 100644
--- a/gcc/ada/scans.ads
+++ b/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???
diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb
index cc88ab9..ef03116 100644
--- a/gcc/ada/scn.adb
+++ b/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.
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 3e2d7fa..6c9cab7 100644
--- a/gcc/ada/scng.adb
+++ b/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.
diff --git a/gcc/ada/scng.ads b/gcc/ada/scng.ads
index 32ecc67..d25ed54 100644
--- a/gcc/ada/scng.ads
+++ b/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
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 18a0af7..36b561e 100644
--- a/gcc/ada/sem.adb
+++ b/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);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 6962262..6abcdb2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/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 --
------------------------
diff --git a/gcc/ada/sem_ch5.ads b/gcc/ada/sem_ch5.ads
index 9c29083..0f4ac50 100644
--- a/gcc/ada/sem_ch5.ads
+++ b/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);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e2c65f1..33d3b60 100644
--- a/gcc/ada/sem_res.adb
+++ b/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 --
-----------------------------
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index ef52116..d52c43c 100644
--- a/gcc/ada/sinfo.adb
+++ b/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
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index e63229a..56c7745 100644
--- a/gcc/ada/sinfo.ads
+++ b/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);
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index a357fb2..bed39b5 100644
--- a/gcc/ada/sprint.adb
+++ b/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));