gnat_rm.texi: Document No_Tagged_Streams pragma and aspect.

2014-10-20  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document No_Tagged_Streams pragma and aspect.
	* snames.ads-tmpl: Add entry for pragma No_Tagged_Streams.
	* aspects.ads, aspects.adb: Add aspect No_Tagged_Streams.
	* einfo.adb (No_Tagged_Streams_Pragma): New field.
	* einfo.ads: Minor reformatting (reorder entries).
	(No_Tagged_Streams_Pragma): New field.
	* exp_ch3.adb: Minor comment update.
	* opt.ads (No_Tagged_Streams): New variable.
	* par-prag.adb: Add dummy entry for pragma No_Tagged_Streams.
	* sem.ads (Save_No_Tagged_Streams): New field in scope record.
	* sem_attr.adb (Check_Stream_Attribute): Check stream ops
	prohibited by No_Tagged_Streams.
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Set
	No_Tagged_Streams_Pragma.
	(Analyze_Subtype_Declaration): ditto.
	(Build_Derived_Record_Type): ditto.
	(Record_Type_Declaration): ditto.
	* sem_ch8.adb (Pop_Scope): Restore No_Tagged_Streams.
	(Push_Scope): Save No_Tagged_Streams.
	* sem_prag.adb (Analyze_Pragma, case No_Tagged_Streams): Implement new
	pragma.

From-SVN: r216476

15 files changed, 262 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3939baf..e1e6b13 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 2014-10-20  Robert Dewar  <dewar@adacore.com>
 
+	* gnat_rm.texi: Document No_Tagged_Streams pragma and aspect.
+	* snames.ads-tmpl: Add entry for pragma No_Tagged_Streams.
+	* aspects.ads, aspects.adb: Add aspect No_Tagged_Streams.
+	* einfo.adb (No_Tagged_Streams_Pragma): New field.
+	* einfo.ads: Minor reformatting (reorder entries).
+	(No_Tagged_Streams_Pragma): New field.
+	* exp_ch3.adb: Minor comment update.
+	* opt.ads (No_Tagged_Streams): New variable.
+	* par-prag.adb: Add dummy entry for pragma No_Tagged_Streams.
+	* sem.ads (Save_No_Tagged_Streams): New field in scope record.
+	* sem_attr.adb (Check_Stream_Attribute): Check stream ops
+	prohibited by No_Tagged_Streams.
+	* sem_ch3.adb (Analyze_Full_Type_Declaration): Set
+	No_Tagged_Streams_Pragma.
+	(Analyze_Subtype_Declaration): ditto.
+	(Build_Derived_Record_Type): ditto.
+	(Record_Type_Declaration): ditto.
+	* sem_ch8.adb (Pop_Scope): Restore No_Tagged_Streams.
+	(Push_Scope): Save No_Tagged_Streams.
+	* sem_prag.adb (Analyze_Pragma, case No_Tagged_Streams): Implement new
+	pragma.
+
+2014-10-20  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch3.adb, prj-proc.adb, sem_ch4.adb, prj-env.adb, lib.ads,
 	sem_ch13.adb: Minor reformatting.
 
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 472f957..ecac9ff 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -546,6 +546,7 @@ package body Aspects is
     Aspect_Machine_Radix                => Aspect_Machine_Radix,
     Aspect_No_Elaboration_Code_All      => Aspect_No_Elaboration_Code_All,
     Aspect_No_Return                    => Aspect_No_Return,
+    Aspect_No_Tagged_Streams            => Aspect_No_Tagged_Streams,
     Aspect_Obsolescent                  => Aspect_Obsolescent,
     Aspect_Object_Size                  => Aspect_Object_Size,
     Aspect_Output                       => Aspect_Output,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 60b6474..173c66d 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -180,6 +180,7 @@ package Aspects is
       Aspect_Interrupt_Handler,
       Aspect_Lock_Free,                     -- GNAT
       Aspect_No_Return,
+      Aspect_No_Tagged_Streams,             -- GNAT
       Aspect_Pack,
       Aspect_Persistent_BSS,                -- GNAT
       Aspect_Preelaborable_Initialization,
@@ -432,6 +433,7 @@ package Aspects is
       Aspect_Machine_Radix                => Name_Machine_Radix,
       Aspect_No_Elaboration_Code_All      => Name_No_Elaboration_Code_All,
       Aspect_No_Return                    => Name_No_Return,
+      Aspect_No_Tagged_Streams            => Name_No_Tagged_Streams,
       Aspect_Object_Size                  => Name_Object_Size,
       Aspect_Obsolescent                  => Name_Obsolescent,
       Aspect_Output                       => Name_Output,
@@ -691,6 +693,7 @@ package Aspects is
       Aspect_Initial_Condition            => Never_Delay,
       Aspect_Initializes                  => Never_Delay,
       Aspect_No_Elaboration_Code_All      => Never_Delay,
+      Aspect_No_Tagged_Streams            => Never_Delay,
       Aspect_Obsolescent                  => Never_Delay,
       Aspect_Part_Of                      => Never_Delay,
       Aspect_Refined_Depends              => Never_Delay,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 6aa7c48..18cac0f 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -251,6 +251,7 @@ package body Einfo is
    --    Thunk_Entity                    Node31
 
    --    SPARK_Pragma                    Node32
+   --    No_Tagged_Streams_Pragma        Node32
 
    --    Linker_Section_Pragma           Node33
    --    SPARK_Aux_Pragma                Node33
@@ -2594,6 +2595,12 @@ package body Einfo is
       return Flag136 (Base_Type (Id));
    end No_Strict_Aliasing;
 
+   function No_Tagged_Streams_Pragma (Id : E) return N is
+   begin
+      pragma Assert (Is_Tagged_Type (Id));
+      return Node32 (Id);
+   end No_Tagged_Streams_Pragma;
+
    function Non_Binary_Modulus (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -5419,6 +5426,12 @@ package body Einfo is
       Set_Flag136 (Id, V);
    end Set_No_Strict_Aliasing;
 
+   procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is
+   begin
+      pragma Assert (Is_Tagged_Type (Id));
+      Set_Node32 (Id, V);
+   end Set_No_Tagged_Streams_Pragma;
+
    procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
@@ -9742,6 +9755,9 @@ package body Einfo is
               E_Subprogram_Body                            =>
             Write_Str ("SPARK_Pragma");
 
+         when Type_Kind                                    =>
+            Write_Str ("No_Tagged_Streams_Pragma");
+
          when others                                       =>
             Write_Str ("Field32??");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index d680c77..9c2c53c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3361,20 +3361,6 @@ package Einfo is
 --       Empty if applied to the last literal. This is actually a synonym
 --       for Next, but its use is preferred in this context.
 
---    Non_Binary_Modulus (Flag58) [base type only]
---       Defined in all subtype and type entities. Set for modular integer
---       types if the modulus value is other than a power of 2.
-
---    Non_Limited_View (Node17)
---       Defined in abstract states and incomplete types that act as shadow
---       entities created when analysing a limited with clause (Ada 2005:
---       AI-50217). Points to the defining entity of the original declaration.
-
---    Nonzero_Is_True (Flag162) [base type only]
---       Defined in enumeration types. Set if any non-zero value is to be
---       interpreted as true. Currently this is set for derived Boolean
---       types which have a convention of C, C++ or Fortran.
-
 --    No_Dynamic_Predicate_On_Actual (Flag276)
 --       Defined in discrete types. Set for generic formal types that are used
 --       in loops and quantified expressions. The corresponing actual cannot
@@ -3396,6 +3382,35 @@ package Einfo is
 --       Defined in all entities. Always false except in the case of procedures
 --       and generic procedures for which a pragma No_Return is given.
 
+--    No_Strict_Aliasing (Flag136) [base type only]
+--       Defined in access types. Set to direct the backend to avoid any
+--       optimizations based on an assumption about the aliasing status of
+--       objects designated by the access type. For the case of the gcc
+--       backend, the effect is as though all references to objects of
+--       the type were compiled with -fno-strict-aliasing. This flag is
+--       set if an unchecked conversion with the access type as a target
+--       type occurs in the same source unit as the declaration of the
+--       access type, or if an explicit pragma No_Strict_Aliasing applies.
+
+--    No_Tagged_Streams_Pragma (Node32)
+--       Present in  all subtype and type entities. Set for tagged types and
+--       subtypes (i.e. entities with Is_Tagged_Type set True) if a valid
+--       pragma/aspect applies to the type.
+
+--    Non_Binary_Modulus (Flag58) [base type only]
+--       Defined in all subtype and type entities. Set for modular integer
+--       types if the modulus value is other than a power of 2.
+
+--    Non_Limited_View (Node17)
+--       Defined in abstract states and incomplete types that act as shadow
+--       entities created when analysing a limited with clause (Ada 2005:
+--       AI-50217). Points to the defining entity of the original declaration.
+
+--    Nonzero_Is_True (Flag162) [base type only]
+--       Defined in enumeration types. Set if any non-zero value is to be
+--       interpreted as true. Currently this is set for derived Boolean
+--       types which have a convention of C, C++ or Fortran.
+
 --    Normalized_First_Bit (Uint8)
 --       Defined in components and discriminants. Indicates the normalized
 --       value of First_Bit for the component, i.e. the offset within the
@@ -3419,16 +3434,6 @@ package Einfo is
 --       the maximum size such records (needed for allocation purposes when
 --       there are default discriminants, and also for the 'Size value).
 
---    No_Strict_Aliasing (Flag136) [base type only]
---       Defined in access types. Set to direct the backend to avoid any
---       optimizations based on an assumption about the aliasing status of
---       objects designated by the access type. For the case of the gcc
---       backend, the effect is as though all references to objects of
---       the type were compiled with -fno-strict-aliasing. This flag is
---       set if an unchecked conversion with the access type as a target
---       type occurs in the same source unit as the declaration of the
---       access type, or if an explicit pragma No_Strict_Aliasing applies.
-
 --    Number_Dimensions (synthesized)
 --       Applies to array types and subtypes. Returns the number of dimensions
 --       of the array type or subtype as a value of type Pos.
@@ -5261,6 +5266,7 @@ package Einfo is
    --    Current_Use_Clause                  (Node27)
    --    Subprograms_For_Type                (Node29)
    --    Derived_Type_Link                   (Node31)
+   --    No_Tagged_Streams_Pragma            (Node32)
    --    Linker_Section_Pragma               (Node33)
 
    --    Depends_On_Private                  (Flag14)
@@ -6814,6 +6820,7 @@ package Einfo is
    function No_Predicate_On_Actual              (Id : E) return B;
    function No_Return                           (Id : E) return B;
    function No_Strict_Aliasing                  (Id : E) return B;
+   function No_Tagged_Streams_Pragma            (Id : E) return N;
    function Non_Binary_Modulus                  (Id : E) return B;
    function Non_Limited_View                    (Id : E) return E;
    function Nonzero_Is_True                     (Id : E) return B;
@@ -7458,6 +7465,7 @@ package Einfo is
    procedure Set_No_Predicate_On_Actual          (Id : E; V : B := True);
    procedure Set_No_Return                       (Id : E; V : B := True);
    procedure Set_No_Strict_Aliasing              (Id : E; V : B := True);
+   procedure Set_No_Tagged_Streams_Pragma        (Id : E; V : N);
    procedure Set_Non_Binary_Modulus              (Id : E; V : B := True);
    procedure Set_Non_Limited_View                (Id : E; V : E);
    procedure Set_Nonzero_Is_True                 (Id : E; V : B := True);
@@ -8251,6 +8259,7 @@ package Einfo is
    pragma Inline (No_Predicate_On_Actual);
    pragma Inline (No_Return);
    pragma Inline (No_Strict_Aliasing);
+   pragma Inline (No_Tagged_Streams_Pragma);
    pragma Inline (Non_Binary_Modulus);
    pragma Inline (Non_Limited_View);
    pragma Inline (Nonzero_Is_True);
@@ -8693,6 +8702,7 @@ package Einfo is
    pragma Inline (Set_No_Predicate_On_Actual);
    pragma Inline (Set_No_Return);
    pragma Inline (Set_No_Strict_Aliasing);
+   pragma Inline (Set_No_Tagged_Streams_Pragma);
    pragma Inline (Set_Non_Binary_Modulus);
    pragma Inline (Set_Non_Limited_View);
    pragma Inline (Set_Nonzero_Is_True);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 330e168..3aecc9b 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -378,7 +378,7 @@ package body Exp_Ch3 is
    --  type. The rules for inheritance of stream attributes by type extensions
    --  are enforced by this function. Furthermore, various restrictions prevent
    --  the generation of these operations, as a useful optimization or for
-   --  certification purposes.
+   --  certification purposes and to save unnecessary generated code.
 
    --------------------------
    -- Adjust_Discriminants --
@@ -10008,7 +10008,9 @@ package body Exp_Ch3 is
 
       --  Bodies for Dispatching stream IO routines. We need these only for
       --  non-limited types (in the limited case there is no dispatching).
-      --  We also skip them if dispatching or finalization are not available.
+      --  We also skip them if dispatching or finalization are not available
+      --  or if stream operations are prohibited by restriction No_Streams or
+      --  from use of pragma/aspect No_Tagged_Streams.
 
       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Read)
         and then No (TSS (Tag_Typ, TSS_Stream_Read))
@@ -10309,6 +10311,7 @@ package body Exp_Ch3 is
                 or else Is_Synchronized_Interface (Typ)))
         and then not Restriction_Active (No_Streams)
         and then not Restriction_Active (No_Dispatch)
+        and then No (No_Tagged_Streams_Pragma (Typ))
         and then not No_Run_Time_Mode
         and then RTE_Available (RE_Tag)
         and then No (Type_Without_Stream_Operation (Typ))
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 44230c2..425791f 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -209,6 +209,7 @@ Implementation Defined Pragmas
 * Pragma No_Return::
 * Pragma No_Run_Time::
 * Pragma No_Strict_Aliasing ::
+* Pragma No_Tagged_Streams::
 * Pragma Normalize_Scalars::
 * Pragma Obsolescent::
 * Pragma Optimize_Alignment::
@@ -313,6 +314,7 @@ Implementation Defined Aspects
 * Aspect Iterable::
 * Aspect Linker_Section::
 * Aspect No_Elaboration_Code_All::
+* Aspect No_Tagged_Streams::
 * Aspect Object_Size::
 * Aspect Obsolescent::
 * Aspect Part_Of::
@@ -1081,6 +1083,7 @@ consideration, the use of these pragmas should be minimized.
 * Pragma No_Return::
 * Pragma No_Run_Time::
 * Pragma No_Strict_Aliasing::
+* Pragma No_Tagged_Streams::
 * Pragma Normalize_Scalars::
 * Pragma Obsolescent::
 * Pragma Optimize_Alignment::
@@ -4778,6 +4781,41 @@ Aliasing,,, gnat_ugn, @value{EDITION} User's Guide}.
 
 This pragma currently has no effects on access to unconstrained array types.
 
+@node Pragma No_Tagged_Streams
+@unnumberedsec Pragma No_Tagged_Streams
+@findex No_Tagged_Streams
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma No_Tagged_Streams;
+pragma No_Tagged_Streams [([Entity =>] tagged_type_LOCAL_NAME)];
+@end smallexample
+
+@noindent
+Normally when a tagged type is introduced using a full type declaration,
+part of the processing includes generating stream access routines to be
+used by stream attributes referencing the type (or one of its subtypes
+or derived types). This can involve the generation of significant amounts
+of code which is wasted space if stream routines are not needed for the
+type in question.
+
+The @code{No_Tagged_Streams} pragma causes the generation of these stream
+routines to be skipped, and any attempt to use stream operations on
+types subject to this pragma will be statically rejected as illegal.
+
+There are two forms of the pragma. The form with no arguments must appear
+in a declarative sequence or in the declarations of a package spec. This
+pragma affects all subsequent root tagged types declared in the declaration
+sequence, and specifies that no stream routines be generated. The form with
+an argument (for which there is also a corresponding aspect) specifies a
+single root tagged type for which stream routines are not to be generated.
+
+Once the pragma has been given for a particular root tagged type, all subtypes
+and derived types of this type inherit the pragma automatically, so the effect
+applies to a complete hierarchy (this is necessary to deal with the class-wide
+dispatching versions of the stream routines).
+
 @node Pragma Normalize_Scalars
 @unnumberedsec Pragma Normalize_Scalars
 @findex Normalize_Scalars
@@ -8110,6 +8148,7 @@ or attribute definition clause.
 * Aspect Linker_Section::
 * Aspect Lock_Free::
 * Aspect No_Elaboration_Code_All::
+* Aspect No_Tagged_Streams::
 * Aspect Object_Size::
 * Aspect Obsolescent::
 * Aspect Part_Of::
@@ -8388,6 +8427,14 @@ This boolean aspect is equivalent to pragma @code{Lock_Free}.
 This aspect is equivalent to a @code{pragma No_Elaboration_Code_All}
 statement for a program unit.
 
+@node Aspect No_Tagged_Streams
+@unnumberedsec Aspect No_Tagged_Streams
+@findex No_Tagged_Streams
+@noindent
+This aspect is equivalent to a @code{pragma No_Tagged_Streams} with an
+argument specifying a root tagged type (thus this aspect can only be
+applied to such a type).
+
 @node Aspect Object_Size
 @unnumberedsec Aspect Object_Size
 @findex Object_Size
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 79c4d06..7706827 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1077,6 +1077,11 @@ package Opt is
    --  GNAT
    --  Set True if pragma No_Strict_Aliasing with no parameters encountered.
 
+   No_Tagged_Streams : Node_Id := Empty;
+   --  GNAT
+   --  If a pragma No_Tagged_Streams is active for the current scope, this
+   --  points to the corresponding pragma.
+
    Normalize_Scalars : Boolean := False;
    --  GNAT, GNATBIND
    --  Set True if a pragma Normalize_Scalars applies to the current unit.
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 128ff22..a9fc33d 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1262,6 +1262,7 @@ begin
            Pragma_No_Return                      |
            Pragma_No_Run_Time                    |
            Pragma_No_Strict_Aliasing             |
+           Pragma_No_Tagged_Streams              |
            Pragma_Normalize_Scalars              |
            Pragma_Obsolescent                    |
            Pragma_Ordered                        |
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index e82905e..22da223 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -492,6 +492,9 @@ package Sem is
       Save_SPARK_Mode_Pragma : Node_Id;
       --  Setting of SPARK_Mode_Pragma on entry to restore on exit
 
+      Save_No_Tagged_Streams : Node_Id;
+      --  Setting of No_Tagged_Streams to restore on exit
+
       Save_Default_SSO : Character;
       --  Setting of Default_SSO on entry to restore on exit
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index ca1deeb..d0c3f0d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1909,6 +1909,17 @@ package body Sem_Attr is
             end if;
          end if;
 
+         --  Check for no stream operations allowed from No_Tagged_Streams
+
+         if Is_Tagged_Type (P_Type)
+           and then Present (No_Tagged_Streams_Pragma (P_Type))
+         then
+            Error_Msg_Sloc := Sloc (No_Tagged_Streams_Pragma (P_Type));
+            Error_Msg_NE
+              ("no stream operations for & (No_Tagged_Streams #)", N, P_Type);
+            return;
+         end if;
+
          --  Check restriction violations
 
          --  First check the No_Streams restriction, which prohibits the use
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 911198f..b81d363 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2554,7 +2554,8 @@ package body Sem_Ch3 is
       --  imported through a LIMITED WITH clause, it appears as incomplete
       --  but has no full view.
 
-      if Ekind (Prev) = E_Incomplete_Type and then Present (Full_View (Prev))
+      if Ekind (Prev) = E_Incomplete_Type
+        and then Present (Full_View (Prev))
       then
          T := Full_View (Prev);
          Set_Incomplete_View (N, Parent (Prev));
@@ -2847,7 +2848,8 @@ package body Sem_Ch3 is
       --  incomplete types.
 
       if Tagged_Present (N) then
-         Set_Is_Tagged_Type (T);
+         Set_Is_Tagged_Type (T, True);
+         Set_No_Tagged_Streams_Pragma (T, No_Tagged_Streams);
          Make_Class_Wide_Type (T);
          Set_Direct_Primitive_Operations (T, New_Elmt_List);
       end if;
@@ -2879,6 +2881,7 @@ package body Sem_Ch3 is
 
    begin
       Set_Is_Tagged_Type (T);
+      Set_No_Tagged_Streams_Pragma (T, No_Tagged_Streams);
 
       Set_Is_Limited_Record (T, Limited_Present (Def)
                                   or else Task_Present (Def)
@@ -4663,6 +4666,8 @@ package body Sem_Ch3 is
                Set_Is_Tagged_Type       (Id, True);
                Set_Has_Unknown_Discriminants
                                         (Id, True);
+               Set_No_Tagged_Streams_Pragma
+                                        (Id, No_Tagged_Streams_Pragma (T));
 
                if Ekind (T) = E_Class_Wide_Subtype then
                   Set_Equivalent_Type   (Id, Equivalent_Type    (T));
@@ -4699,7 +4704,9 @@ package body Sem_Ch3 is
                end if;
 
                if Is_Tagged_Type (T) then
-                  Set_Is_Tagged_Type    (Id);
+                  Set_Is_Tagged_Type    (Id, True);
+                  Set_No_Tagged_Streams_Pragma
+                                        (Id, No_Tagged_Streams_Pragma (T));
                   Set_Is_Abstract_Type  (Id, Is_Abstract_Type (T));
                   Set_Direct_Primitive_Operations
                                         (Id, Direct_Primitive_Operations (T));
@@ -4728,6 +4735,8 @@ package body Sem_Ch3 is
 
                if Is_Tagged_Type (T) then
                   Set_Is_Tagged_Type              (Id);
+                  Set_No_Tagged_Streams_Pragma    (Id,
+                    No_Tagged_Streams_Pragma (T));
                   Set_Is_Abstract_Type            (Id, Is_Abstract_Type (T));
                   Set_Class_Wide_Type             (Id, Class_Wide_Type  (T));
                   Set_Direct_Primitive_Operations (Id,
@@ -4808,6 +4817,11 @@ package body Sem_Ch3 is
                Set_Is_Tagged_Type       (Id, Is_Tagged_Type        (T));
                Set_Last_Entity          (Id, Last_Entity           (T));
 
+               if Is_Tagged_Type (T) then
+                  Set_No_Tagged_Streams_Pragma
+                    (Id, No_Tagged_Streams_Pragma (T));
+               end if;
+
                if Has_Discriminants (T) then
                   Set_Discriminant_Constraint (Id,
                                            Discriminant_Constraint (T));
@@ -4824,6 +4838,11 @@ package body Sem_Ch3 is
                   Set_Is_Tagged_Type     (Id, Is_Tagged_Type (T));
                   Set_Private_Dependents (Id, New_Elmt_List);
 
+                  if Is_Tagged_Type (Id) then
+                     Set_No_Tagged_Streams_Pragma
+                       (Id, No_Tagged_Streams_Pragma (T));
+                  end if;
+
                   --  Ada 2005 (AI-412): Decorate an incomplete subtype of an
                   --  incomplete type visible through a limited with clause.
 
@@ -8262,11 +8281,16 @@ package body Sem_Ch3 is
       --  Fields inherited from the Parent_Type
 
       Set_Has_Specified_Layout
-        (Derived_Type, Has_Specified_Layout (Parent_Type));
+        (Derived_Type, Has_Specified_Layout     (Parent_Type));
       Set_Is_Limited_Composite
-        (Derived_Type, Is_Limited_Composite (Parent_Type));
+        (Derived_Type, Is_Limited_Composite     (Parent_Type));
       Set_Is_Private_Composite
-        (Derived_Type, Is_Private_Composite (Parent_Type));
+        (Derived_Type, Is_Private_Composite     (Parent_Type));
+
+      if Is_Tagged_Type (Parent_Type) then
+         Set_No_Tagged_Streams_Pragma
+           (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type));
+      end if;
 
       --  Fields inherited from the Parent_Base
 
@@ -8287,7 +8311,6 @@ package body Sem_Ch3 is
       --  Fields inherited from the Parent_Base for record types
 
       if Is_Record_Type (Derived_Type) then
-
          declare
             Parent_Full : Entity_Id;
 
@@ -8619,6 +8642,11 @@ package body Sem_Ch3 is
       Set_Is_Controlled  (Derived_Type, Is_Controlled  (Parent_Type));
       Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
 
+      if Is_Tagged_Type (Derived_Type) then
+         Set_No_Tagged_Streams_Pragma
+           (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type));
+      end if;
+
       --  If the parent has primitive routines, set the derived type link
 
       if Has_Primitive_Operations (Parent_Type) then
@@ -8629,7 +8657,7 @@ package body Sem_Ch3 is
       --  type may be set in the private part, and not propagated to the
       --  subtype until later, so we obtain the convention from the base type.
 
-      Set_Convention     (Derived_Type, Convention     (Parent_Base));
+      Set_Convention (Derived_Type, Convention     (Parent_Base));
 
       --  Set SSO default for record or array type
 
@@ -9272,6 +9300,7 @@ package body Sem_Ch3 is
 
       if Is_Tagged_Type (T) then
          Set_Is_Tagged_Type (Def_Id);
+         Set_No_Tagged_Streams_Pragma (Def_Id, No_Tagged_Streams_Pragma (T));
          Make_Class_Wide_Type (Def_Id);
       end if;
 
@@ -11437,8 +11466,10 @@ package body Sem_Ch3 is
 
       if Is_Tagged_Type (Full_Base) then
          Set_Is_Tagged_Type (Full);
-         Set_Direct_Primitive_Operations (Full,
-           Direct_Primitive_Operations (Full_Base));
+         Set_Direct_Primitive_Operations
+           (Full, Direct_Primitive_Operations (Full_Base));
+         Set_No_Tagged_Streams_Pragma
+           (Full, No_Tagged_Streams_Pragma (Full_Base));
 
          --  Inherit class_wide type of full_base in case the partial view was
          --  not tagged. Otherwise it has already been created when the private
@@ -13265,8 +13296,10 @@ package body Sem_Ch3 is
       Conditional_Delay              (Full,                          Priv);
 
       if Is_Tagged_Type (Full) then
-         Set_Direct_Primitive_Operations (Full,
-           Direct_Primitive_Operations (Priv));
+         Set_Direct_Primitive_Operations
+           (Full, Direct_Primitive_Operations (Priv));
+         Set_No_Tagged_Streams_Pragma
+           (Full, No_Tagged_Streams_Pragma (Priv));
 
          if Is_Base_Type (Priv) then
             Set_Class_Wide_Type      (Full, Class_Wide_Type         (Priv));
@@ -17637,11 +17670,13 @@ package body Sem_Ch3 is
       Set_Default_SSO                 (CW_Type);
 
       if Ekind (T) = E_Class_Wide_Subtype then
-         Set_Etype             (CW_Type, Etype (Base_Type (T)));
+         Set_Etype (CW_Type, Etype (Base_Type (T)));
       else
-         Set_Etype             (CW_Type, T);
+         Set_Etype (CW_Type, T);
       end if;
 
+      Set_No_Tagged_Streams_Pragma (CW_Type, No_Tagged_Streams);
+
       --  If this is the class_wide type of a constrained subtype, it does
       --  not have discriminants.
 
@@ -20527,8 +20562,12 @@ package body Sem_Ch3 is
            Tagged_Present (Def)
              or else (Serious_Errors_Detected > 0 and then Is_Tagged_Type (T));
 
-         Set_Is_Tagged_Type      (T, Is_Tagged);
-         Set_Is_Limited_Record   (T, Limited_Present (Def));
+         Set_Is_Limited_Record (T, Limited_Present (Def));
+
+         if Is_Tagged then
+            Set_Is_Tagged_Type (T, True);
+            Set_No_Tagged_Streams_Pragma (T, No_Tagged_Streams);
+         end if;
 
          --  Type is abstract if full declaration carries keyword, or if
          --  previous partial view did.
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 655f38b..798564c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7851,6 +7851,7 @@ package body Sem_Ch8 is
       Local_Suppress_Stack_Top := SST.Save_Local_Suppress_Stack_Top;
       Check_Policy_List        := SST.Save_Check_Policy_List;
       Default_Pool             := SST.Save_Default_Storage_Pool;
+      No_Tagged_Streams        := SST.Save_No_Tagged_Streams;
       SPARK_Mode               := SST.Save_SPARK_Mode;
       SPARK_Mode_Pragma        := SST.Save_SPARK_Mode_Pragma;
       Default_SSO              := SST.Save_Default_SSO;
@@ -7925,6 +7926,7 @@ package body Sem_Ch8 is
          SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top;
          SST.Save_Check_Policy_List        := Check_Policy_List;
          SST.Save_Default_Storage_Pool     := Default_Pool;
+         SST.Save_No_Tagged_Streams        := No_Tagged_Streams;
          SST.Save_SPARK_Mode               := SPARK_Mode;
          SST.Save_SPARK_Mode_Pragma        := SPARK_Mode_Pragma;
          SST.Save_Default_SSO              := Default_SSO;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 32a3cf3..ea028ab 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -16542,6 +16542,58 @@ package body Sem_Prag is
             Set_Restriction (Max_Tasks, N, 0);
             Set_Restriction (No_Tasking, N);
 
+            -----------------------
+            -- No_Tagged_Streams --
+            -----------------------
+
+            --  pragma No_Tagged_Streams;
+            --  pragma No_Tagged_Streams ([Entity => ]tagged_type_local_NAME);
+
+         when Pragma_No_Tagged_Streams => No_Tagged_Strms : declare
+            E_Id : Node_Id;
+            E    : Entity_Id;
+
+         begin
+            GNAT_Pragma;
+            Check_At_Most_N_Arguments (1);
+
+            --  One argument case
+
+            if Arg_Count = 1 then
+               Check_Optional_Identifier (Arg1, Name_Entity);
+               Check_Arg_Is_Local_Name (Arg1);
+               E_Id := Get_Pragma_Arg (Arg1);
+
+               if Etype (E_Id) = Any_Type then
+                  return;
+               end if;
+
+               E := Entity (E_Id);
+
+               Check_Duplicate_Pragma (E);
+
+               if not Is_Tagged_Type (E) or else Is_Derived_Type (E) then
+                  Error_Pragma_Arg
+                    ("argument for pragma% must be root tagged type", Arg1);
+               end if;
+
+               if Rep_Item_Too_Early (E, N)
+                    or else
+                  Rep_Item_Too_Late (E, N)
+               then
+                  return;
+               else
+                  Set_No_Tagged_Streams_Pragma (E, N);
+               end if;
+
+            --  Zero argument case
+
+            else
+               Check_Is_In_Decl_Part_Or_Package_Spec;
+               No_Tagged_Streams := N;
+            end if;
+         end No_Tagged_Strms;
+
          ------------------------
          -- No_Strict_Aliasing --
          ------------------------
@@ -24906,6 +24958,7 @@ package body Sem_Prag is
       Pragma_No_Inline                      =>  0,
       Pragma_No_Run_Time                    => -1,
       Pragma_No_Strict_Aliasing             => -1,
+      Pragma_No_Tagged_Streams              =>  0,
       Pragma_Normalize_Scalars              =>  0,
       Pragma_Obsolescent                    =>  0,
       Pragma_Optimize                       =>  0,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index cdc8253..cd68f11 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -408,6 +408,7 @@ package Snames is
    Name_Loop_Optimize                  : constant Name_Id := N + $; -- GNAT
    Name_No_Run_Time                    : constant Name_Id := N + $; -- GNAT
    Name_No_Strict_Aliasing             : constant Name_Id := N + $; -- GNAT
+   Name_No_Tagged_Streams              : constant Name_Id := N + $; -- GNAT
    Name_Normalize_Scalars              : constant Name_Id := N + $;
    Name_Optimize_Alignment             : constant Name_Id := N + $; -- GNAT
    Name_Overflow_Mode                  : constant Name_Id := N + $; -- GNAT
@@ -1749,6 +1750,7 @@ package Snames is
       Pragma_Loop_Optimize,
       Pragma_No_Run_Time,
       Pragma_No_Strict_Aliasing,
+      Pragma_No_Tagged_Streams,
       Pragma_Normalize_Scalars,
       Pragma_Optimize_Alignment,
       Pragma_Overflow_Mode,