From 8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 5 Jul 2019 07:01:49 +0000 Subject: [PATCH] [Ada] No_Stream_Optimizations ignored for 'Class'Input This patch fixes a bug in which if pragma Restrictions (No_Stream_Optimizations) is in effect, it is ignored for T'Class'Input. Revision 251886 was causing the compiler to bypass No_Stream_Optimizations. 2019-07-05 Bob Duff gcc/ada/ * exp_attr.adb (Input): Take the No_Stream_Optimizations restriction into account. From-SVN: r273103 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_attr.adb | 37 ++++++++++++++++++++++++++++--------- 2 files changed, 33 insertions(+), 9 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 42fa71bddd4..9f7ee9ddb6b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-05 Bob Duff + + * exp_attr.adb (Input): Take the No_Stream_Optimizations + restriction into account. + 2019-07-05 Claire Dross * libgnat/a-cofove.ads, libgnat/a-cofove.adb: Definite formal diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1e1b2f967db..a4350cafaec 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3997,11 +3997,13 @@ package body Exp_Attr is declare Rtyp : constant Entity_Id := Root_Type (P_Type); - Expr : Node_Id; + Get_Tag : Node_Id; -- expression to read the 'Tag + Expr : Node_Id; -- call to Descendant_Tag begin -- Read the internal tag (RM 13.13.2(34)) and use it to - -- initialize a dummy tag value. We used to generate: + -- initialize a dummy tag value. We used to unconditionally + -- generate: -- -- Descendant_Tag (String'Input (Strm), P_Type); -- @@ -4012,6 +4014,11 @@ package body Exp_Attr is -- String_Input_Blk_IO, except that if the String is -- absurdly long, it raises an exception. -- + -- However, if the No_Stream_Optimizations restriction + -- is active, we disable this unnecessary attempt at + -- robustness; we really need to read the string + -- character-by-character. + -- -- This value is used only to provide a controlling -- argument for the eventual _Input call. Descendant_Tag is -- called rather than Internal_Tag to ensure that we have a @@ -4026,18 +4033,30 @@ package body Exp_Attr is -- this constant in Cntrl, but this caused a secondary stack -- leak. + if Restriction_Active (No_Stream_Optimizations) then + Get_Tag := + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Standard_String, Loc), + Attribute_Name => Name_Input, + Expressions => New_List ( + Relocate_Node (Duplicate_Subexpr (Strm)))); + else + Get_Tag := + Make_Function_Call (Loc, + Name => + New_Occurrence_Of + (RTE (RE_String_Input_Tag), Loc), + Parameter_Associations => New_List ( + Relocate_Node (Duplicate_Subexpr (Strm)))); + end if; + Expr := Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc), Parameter_Associations => New_List ( - Make_Function_Call (Loc, - Name => - New_Occurrence_Of - (RTE (RE_String_Input_Tag), Loc), - Parameter_Associations => New_List ( - Relocate_Node (Duplicate_Subexpr (Strm)))), - + Get_Tag, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (P_Type, Loc), Attribute_Name => Name_Tag))); -- 2.30.2