aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2019-07-05 07:01:49 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-05 07:01:49 +0000
commit8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e (patch)
treefe3d084efb7bf0506c2d5933089dcd5c46538828
parent584b52902b4b1bbcabc0e5bdd4196bd223d2f5a8 (diff)
downloadgcc-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/ChangeLog5
-rw-r--r--gcc/ada/exp_attr.adb37
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)));