diff options
author | Bob Duff <duff@adacore.com> | 2019-07-05 07:01:49 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-05 07:01:49 +0000 |
commit | 8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e (patch) | |
tree | fe3d084efb7bf0506c2d5933089dcd5c46538828 | |
parent | 584b52902b4b1bbcabc0e5bdd4196bd223d2f5a8 (diff) | |
download | gcc-8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e.zip gcc-8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e.tar.gz gcc-8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e.tar.bz2 |
[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 <duff@adacore.com>
gcc/ada/
* exp_attr.adb (Input): Take the No_Stream_Optimizations
restriction into account.
From-SVN: r273103
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 37 |
2 files changed, 33 insertions, 9 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 42fa71b..9f7ee9d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-05 Bob Duff <duff@adacore.com> + + * exp_attr.adb (Input): Take the No_Stream_Optimizations + restriction into account. + 2019-07-05 Claire Dross <dross@adacore.com> * 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 1e1b2f9..a4350ca 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))); |