mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-02 08:40:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

scans.ads: New token At_Sign.

Browse Source 
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
This commit is contained in:
Ed Schonberg 2017-01-23 11:29:17 +00:00 committed by Arnaud Charlet
parent 13230c68da
commit ae33543ca5
15 changed files with 333 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -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.

122
gcc/ada/exp_ch5.adb
View File

@ -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

1
gcc/ada/exp_util.adb
View File

@ -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

23
gcc/ada/par-ch4.adb
View File

@ -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.

21
gcc/ada/scans.ads
View File

@ -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???

10
gcc/ada/scn.adb
View File

@ -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.

20
gcc/ada/scng.adb
View File

@ -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.

6
gcc/ada/scng.ads
View File

@ -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

3
gcc/ada/sem.adb
View File

@ -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);

45
gcc/ada/sem_ch5.adb
View File

@ -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 --
------------------------

3
gcc/ada/sem_ch5.ads
View File

@ -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);

13
gcc/ada/sem_res.adb
View File

@ -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 --
-----------------------------

16
gcc/ada/sinfo.adb
View File

@ -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

34
gcc/ada/sinfo.ads
View File

@ -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);

3
gcc/ada/sprint.adb
View File

@ -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));