From: Bob Duff <duff@adacore.com>
Date: Fri, 5 Jul 2019 07:01:49 +0000 (+0000)
Subject: [Ada] No_Stream_Optimizations ignored for 'Class'Input
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8e28429a9395c3c9ed58e4aaa7f6d8b32931f18e;p=gcc.git

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

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