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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-05 Bob Duff <d...@adacore.com>
gcc/ada/
* exp_attr.adb (Input): Take the No_Stream_Optimizations
restriction into account.--- gcc/ada/exp_attr.adb
+++ 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)));
