einfo.adb (Itype_Printed): New flag

2005-12-05  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Itype_Printed): New flag
	(Is_Limited_Type): Derived types do not inherit limitedness from
	interface progenitors.
	(Is_Return_By_Reference_Type): Predicate does not apply to limited
	interfaces.

	* einfo.ads (Itype_Printed): New flag
	Move Is_Wrapper_Package to proper section
	Add missing Inline for Is_Volatile

	* output.ads, output.adb (Write_Erase_Char): New procedure
	(Save/Restore_Output_Buffer): New procedures
	(Save/Restore_Output_Buffer): New procedures

	* sprint.ads, sprint.adb (Write_Itype): Handle case of record itypes
	Add missing support for anonymous access type
	(Write_Id): Insert calls to Write_Itype
	(Write_Itype): New procedure to output itypes

	* par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada 2005, handle
	use of "limited" in declaration.

	* sinfo.ads, sinfo.adb: 
	Formal derived types can carry an explicit "limited" indication.

	* sem_ch3.adb: Add with and use of Targparm.
	(Create_Component): If Frontend_Layout_On_Target is True and the
	copied component does not have a known static Esize, then reset
	the size and positional fields of the new component.
	(Analyze_Component_Declaration): A limited component is
	legal within a protected type that implements an interface.
	(Collect_Interfaces): Do not add to the list the interfaces that
	are implemented by the ancestors.
	(Derived_Type_Declaration): If the parent of the full-view is an
	interface perform a transformation of the tree to ensure that it has
	the same parent than the partial-view. This simplifies the job of the
	expander in order to generate the correct object layout, and it is
	needed because the list of interfaces of the full-view can be given in
	any order.
	(Process_Full_View): The parent of the full-view does not need to be
	a descendant of the parent of the partial view if both parents are
	interfaces.
	(Analyze_Private_Extension_Declaration): If declaration has an explicit
	"limited" the parent must be a limited type.
	(Build_Derived_Record_Type): A derived type that is explicitly limited
	must have limited ancestor and progenitors.
	(Build_Derived_Type): Ditto.
	(Process_Full_View): Verify that explicit uses of "limited" in partial
	and full declarations are consistent.
	(Find_Ancestor_Interface): Remove function.
	(Collect_Implemented_Interfaces): New procedure used to gather all
	implemented interfaces by a type.
	(Contain_Interface): New function used to check whether an interface is
	present in a list.
	(Find_Hidden_Interface): New function used to determine whether two
	lists of interfaces constitute a set equality. If not, the first
	differing interface is returned.
	(Process_Full_View): Improve the check for the "no hidden interface"
	rule as defined by AI-396.

From-SVN: r108295

gcc/ada/einfo.adb

@@ -452,8 +452,8 @@ package body Einfo is
    --    Is_Task_Interface              Flag200
 
    --    Has_Anon_Block_Suffix          Flag201
+   --    Itype_Printed                  Flag202
 
-   --    (unused)                       Flag202
    --    (unused)                       Flag203
    --    (unused)                       Flag204
    --    (unused)                       Flag205
@@ -1877,6 +1877,7 @@ package body Einfo is
    function Is_Volatile (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
+
       if Is_Type (Id) then
          return Flag16 (Base_Type (Id));
       else
@@ -1884,6 +1885,12 @@ package body Einfo is
       end if;
    end Is_Volatile;
 
+   function Itype_Printed (Id : E) return B is
+   begin
+      pragma Assert (Is_Itype (Id));
+      return Flag202 (Id);
+   end Itype_Printed;
+
    function Kill_Elaboration_Checks (Id : E) return B is
    begin
       return Flag32 (Id);
@@ -4016,6 +4023,12 @@ package body Einfo is
       Set_Flag16 (Id, V);
    end Set_Is_Volatile;
 
+   procedure Set_Itype_Printed (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Itype (Id));
+      Set_Flag202 (Id, V);
+   end Set_Itype_Printed;
+
    procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
    begin
       Set_Flag32 (Id, V);
@@ -5722,6 +5735,7 @@ package body Einfo is
 
    function Is_Limited_Type (Id : E) return B is
       Btype : constant E := Base_Type (Id);
+      Rtype : constant E := Root_Type (Btype);
 
    begin
       if not Is_Type (Id) then
@@ -5744,11 +5758,17 @@ package body Einfo is
          return False;
 
       elsif Is_Record_Type (Btype) then
-         if Is_Limited_Record (Root_Type (Btype)) then
-            return True;
+
+         --  AI-419: limitedness is not inherited from a limited interface
+
+         if Is_Limited_Record (Rtype) then
+            return not Is_Interface (Rtype)
+              or else Is_Protected_Interface (Rtype)
+              or else Is_Synchronized_Interface (Rtype)
+              or else Is_Task_Interface (Rtype);
 
          elsif Is_Class_Wide_Type (Btype) then
-            return Is_Limited_Type (Root_Type (Btype));
+            return Is_Limited_Type (Rtype);
 
          else
             declare
@@ -5813,6 +5833,8 @@ package body Einfo is
    -- Is_Return_By_Reference_Type --
    ---------------------------------
 
+   --  Note: this predicate has disappeared from Ada 2005: see AI-318-2
+
    function Is_Return_By_Reference_Type (Id : E) return B is
       Btype : constant Entity_Id := Base_Type (Id);
 
@@ -5820,7 +5842,6 @@ package body Einfo is
       if Is_Private_Type (Btype) then
          declare
             Utyp : constant Entity_Id := Underlying_Type (Btype);
-
          begin
             if No (Utyp) then
                return False;
@@ -5834,7 +5855,10 @@ package body Einfo is
 
       elsif Is_Record_Type (Btype) then
          if Is_Limited_Record (Btype) then
-            return True;
+            return not Is_Interface (Btype)
+              or else Is_Protected_Interface (Btype)
+              or else Is_Synchronized_Interface (Btype)
+              or else Is_Task_Interface (Btype);
 
          elsif Is_Class_Wide_Type (Btype) then
             return Is_Return_By_Reference_Type (Root_Type (Btype));
@@ -6700,6 +6724,7 @@ package body Einfo is
       W ("Is_Valued_Procedure",           Flag127 (Id));
       W ("Is_Visible_Child_Unit",         Flag116 (Id));
       W ("Is_Volatile",                   Flag16  (Id));
+      W ("Itype_Printed",                 Flag202 (Id));
       W ("Kill_Elaboration_Checks",       Flag32  (Id));
       W ("Kill_Range_Checks",             Flag33  (Id));
       W ("Kill_Tag_Checks",               Flag34  (Id));

gcc/ada/einfo.ads

@@ -2469,6 +2469,10 @@ package Einfo is
 --       Present in package entities. Indicates that the package has been
 --       created as a wrapper for a subprogram instantiation.
 
+--    Itype_Printed (Flag202)
+--       Set in Itypes if the Itype has been printed by Sprint. This is used to
+--       avoid printing an Itype more than once.
+
 --    Kill_Elaboration_Checks (Flag32)
 --       Present in all entities. Set by the expander to kill elaboration
 --       checks which are known not to be needed. Equivalent in effect to
@@ -4166,6 +4170,7 @@ package Einfo is
    --    Is_Tagged_Type                (Flag55)
    --    Is_Unsigned_Type              (Flag144)
    --    Is_Volatile                   (Flag16)
+   --    Itype_Printed                 (Flag202)  (itypes only)
    --    Must_Be_On_Byte_Boundary      (Flag183)
    --    Size_Depends_On_Discriminant  (Flag177)
    --    Size_Known_At_Compile_Time    (Flag92)
@@ -5363,7 +5368,6 @@ package Einfo is
    function Is_Potentially_Use_Visible         (Id : E) return B;
    function Is_Preelaborated                   (Id : E) return B;
    function Is_Primitive_Wrapper               (Id : E) return B;
-
    function Is_Private_Composite               (Id : E) return B;
    function Is_Private_Descendant              (Id : E) return B;
    function Is_Protected_Interface             (Id : E) return B;
@@ -5387,7 +5391,7 @@ package Einfo is
    function Is_Valued_Procedure                (Id : E) return B;
    function Is_Visible_Child_Unit              (Id : E) return B;
    function Is_Volatile                        (Id : E) return B;
-   function Is_Wrapper_Package                 (Id : E) return B;
+   function Itype_Printed                      (Id : E) return B;
    function Kill_Elaboration_Checks            (Id : E) return B;
    function Kill_Range_Checks                  (Id : E) return B;
    function Kill_Tag_Checks                    (Id : E) return B;
@@ -5567,6 +5571,7 @@ package Einfo is
    function Is_Return_By_Reference_Type        (Id : E) return B;
    function Is_String_Type                     (Id : E) return B;
    function Is_Task_Record_Type                (Id : E) return B;
+   function Is_Wrapper_Package                 (Id : E) return B;
    function Next_Component                     (Id : E) return E;
    function Next_Discriminant                  (Id : E) return E;
    function Next_Formal                        (Id : E) return E;
@@ -5890,6 +5895,7 @@ package Einfo is
    procedure Set_Is_Valued_Procedure           (Id : E; V : B := True);
    procedure Set_Is_Visible_Child_Unit         (Id : E; V : B := True);
    procedure Set_Is_Volatile                   (Id : E; V : B := True);
+   procedure Set_Itype_Printed                 (Id : E; V : B := True);
    procedure Set_Kill_Elaboration_Checks       (Id : E; V : B := True);
    procedure Set_Kill_Range_Checks             (Id : E; V : B := True);
    procedure Set_Kill_Tag_Checks               (Id : E; V : B := True);
@@ -6445,7 +6451,6 @@ package Einfo is
    pragma Inline (Is_Potentially_Use_Visible);
    pragma Inline (Is_Preelaborated);
    pragma Inline (Is_Primitive_Wrapper);
-
    pragma Inline (Is_Private_Composite);
    pragma Inline (Is_Private_Descendant);
    pragma Inline (Is_Private_Type);
@@ -6477,6 +6482,7 @@ package Einfo is
    pragma Inline (Is_VMS_Exception);
    pragma Inline (Is_Valued_Procedure);
    pragma Inline (Is_Visible_Child_Unit);
+   pragma Inline (Itype_Printed);
    pragma Inline (Kill_Elaboration_Checks);
    pragma Inline (Kill_Range_Checks);
    pragma Inline (Kill_Tag_Checks);
@@ -6788,7 +6794,6 @@ package Einfo is
    pragma Inline (Set_Is_Potentially_Use_Visible);
    pragma Inline (Set_Is_Preelaborated);
    pragma Inline (Set_Is_Primitive_Wrapper);
-
    pragma Inline (Set_Is_Private_Composite);
    pragma Inline (Set_Is_Private_Descendant);
    pragma Inline (Set_Is_Protected_Interface);
@@ -6812,6 +6817,7 @@ package Einfo is
    pragma Inline (Set_Is_Valued_Procedure);
    pragma Inline (Set_Is_Visible_Child_Unit);
    pragma Inline (Set_Is_Volatile);
+   pragma Inline (Set_Itype_Printed);
    pragma Inline (Set_Kill_Elaboration_Checks);
    pragma Inline (Set_Kill_Range_Checks);
    pragma Inline (Set_Kill_Tag_Checks);
@@ -6909,6 +6915,7 @@ package Einfo is
    --  access/set format that can be handled by xeinfo.
 
    pragma Inline (Is_Package_Or_Generic_Package);
+   pragma Inline (Is_Volatile);
    pragma Inline (Is_Wrapper_Package);
    pragma Inline (Known_RM_Size);
    pragma Inline (Known_Static_Component_Bit_Offset);

gcc/ada/output.adb

@@ -42,29 +42,6 @@ package body Output is
    --  Record argument to last call to Set_Special_Output. If this is
    --  non-null, then we are in special output mode.
 
-   -------------------------
-   -- Line Buffer Control --
-   -------------------------
-
-   --  Note: the following buffer and column position are maintained by
-   --  the subprograms defined in this package, and are not normally
-   --  directly modified or accessed by a client. However, a client is
-   --  permitted to modify these values, using the knowledge that only
-   --  Write_Eol actually generates any output.
-
-   Buffer_Max : constant := 8192;
-   Buffer     : String (1 .. Buffer_Max + 1);
-   --  Buffer used to build output line. We do line buffering because it
-   --  is needed for the support of the debug-generated-code option (-gnatD).
-   --  Historically it was first added because on VMS, line buffering is
-   --  needed with certain file formats. So in any case line buffering must
-   --  be retained for this purpose, even if other reasons disappear. Note
-   --  any attempt to write more output to a line than can fit in the buffer
-   --  will be silently ignored.
-
-   Next_Column : Pos range 1 .. Buffer'Length + 1 := 1;
-   --  Column about to be written
-
    -----------------------
    -- Local_Subprograms --
    -----------------------
@@ -86,7 +63,7 @@ package body Output is
    ------------------
 
    procedure Flush_Buffer is
-      Len : constant Natural := Natural (Next_Column - 1);
+      Len : constant Natural := Next_Col - 1;
 
    begin
       if Len /= 0 then
@@ -111,7 +88,7 @@ package body Output is
 
             else
                Current_FD := Standerr;
-               Next_Column := 1;
+               Next_Col := 1;
                Write_Line ("fatal error: disk full");
                OS_Exit (2);
             end if;
@@ -119,7 +96,7 @@ package body Output is
 
          --  Buffer is now empty
 
-         Next_Column := 1;
+         Next_Col := 1;
       end if;
    end Flush_Buffer;
 
@@ -127,11 +104,34 @@ package body Output is
    -- Column --
    ------------
 
-   function Column return Nat is
+   function Column return Pos is
    begin
-      return Next_Column;
+      return Pos (Next_Col);
    end Column;
 
+   ---------------------------
+   -- Restore_Output_Buffer --
+   ---------------------------
+
+   procedure Restore_Output_Buffer (S : Saved_Output_Buffer) is
+   begin
+      Next_Col := S.Next_Col;
+      Buffer (1 .. Next_Col - 1) := S.Buffer (1 .. Next_Col - 1);
+   end Restore_Output_Buffer;
+
+   ------------------------
+   -- Save_Output_Buffer --
+   ------------------------
+
+   function Save_Output_Buffer return Saved_Output_Buffer is
+      S : Saved_Output_Buffer;
+   begin
+      S.Buffer (1 .. Next_Col - 1) := Buffer (1 .. Next_Col - 1);
+      S.Next_Col := Next_Col;
+      Next_Col := 1;
+      return S;
+   end Save_Output_Buffer;
+
    ------------------------
    -- Set_Special_Output --
    ------------------------
@@ -149,7 +149,7 @@ package body Output is
    begin
       if Special_Output_Proc = null then
          Flush_Buffer;
-         Next_Column := 1;
+         Next_Col := 1;
       end if;
 
       Current_FD := Standerr;
@@ -163,7 +163,7 @@ package body Output is
    begin
       if Special_Output_Proc = null then
          Flush_Buffer;
-         Next_Column := 1;
+         Next_Col := 1;
       end if;
 
       Current_FD := Standout;
@@ -236,12 +236,12 @@ package body Output is
 
    procedure Write_Char (C : Character) is
    begin
-      if Next_Column = Buffer'Length then
+      if Next_Col = Buffer'Length then
          Write_Eol;
       end if;
 
-      Buffer (Natural (Next_Column)) := C;
-      Next_Column := Next_Column + 1;
+      Buffer (Next_Col) := C;
+      Next_Col := Next_Col + 1;
    end Write_Char;
 
    ---------------
@@ -250,11 +250,22 @@ package body Output is
 
    procedure Write_Eol is
    begin
-      Buffer (Natural (Next_Column)) := ASCII.LF;
-      Next_Column := Next_Column + 1;
+      Buffer (Next_Col) := ASCII.LF;
+      Next_Col := Next_Col + 1;
       Flush_Buffer;
    end Write_Eol;
 
+   ----------------------
+   -- Write_Erase_Char --
+   ----------------------
+
+   procedure Write_Erase_Char (C : Character) is
+   begin
+      if Next_Col /= 1 and then Buffer (Next_Col - 1) = C then
+         Next_Col := Next_Col - 1;
+      end if;
+   end Write_Erase_Char;
+
    ---------------
    -- Write_Int --
    ---------------

gcc/ada/output.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -35,7 +35,8 @@
 --  for writing error messages and informational output. It is also used
 --  by the debug source file output routines (see Sprintf.Print_Eol).
 
-with Types; use Types;
+with Hostparm; use Hostparm;
+with Types;    use Types;
 
 package Output is
    pragma Elaborate_Body;
@@ -86,6 +87,9 @@ package Output is
    --  Write one character to the standard output file. Note that the
    --  character should not be LF or CR (use Write_Eol for end of line)
 
+   procedure Write_Erase_Char (C : Character);
+   --  If last character in buffer matches C, erase it, otherwise no effect
+
    procedure Write_Eol;
    --  Write an end of line (whatever is required by the system in use,
    --  e.g. CR/LF for DOS, or LF for Unix) to the standard output file.
@@ -106,11 +110,30 @@ package Output is
    procedure Write_Line (S : String);
    --  Equivalent to Write_Str (S) followed by Write_Eol;
 
-   function Column return Nat;
+   function Column return Pos;
    pragma Inline (Column);
    --  Returns the number of the column about to be written (e.g. a value
    --  of 1 means the current line is empty).
 
+   -------------------------
+   -- Buffer Save/Restore --
+   -------------------------
+
+   --  This facility allows the current line buffer to be saved and restored
+
+   type Saved_Output_Buffer is private;
+   --  Type used for Save/Restore_Buffer
+
+   Buffer_Max : constant := Hostparm.Max_Line_Length;
+   --  Maximal size of a buffered output line
+
+   function Save_Output_Buffer return Saved_Output_Buffer;
+   --  Save current line buffer and reset line buffer to empty
+
+   procedure Restore_Output_Buffer (S : Saved_Output_Buffer);
+   --  Restore previously saved output buffer. The value in S is not affected
+   --  so it is legtimate to restore a buffer more than once.
+
    --------------------------
    -- Debugging Procedures --
    --------------------------
@@ -144,4 +167,28 @@ package Output is
    procedure w (L : String; B : Boolean);
    --  Dump contents of string followed by blank, Boolean, line return
 
+private
+   --  Note: the following buffer and column position are maintained by the
+   --  subprograms defined in this package, and cannot be directly modified or
+   --  accessed by a client.
+
+   Buffer : String (1 .. Buffer_Max + 1);
+   for Buffer'Alignment use 4;
+   --  Buffer used to build output line. We do line buffering because it
+   --  is needed for the support of the debug-generated-code option (-gnatD).
+   --  Historically it was first added because on VMS, line buffering is
+   --  needed with certain file formats. So in any case line buffering must
+   --  be retained for this purpose, even if other reasons disappear. Note
+   --  any attempt to write more output to a line than can fit in the buffer
+   --  will be silently ignored. The alignment clause improves the efficiency
+   --  of the save/restore procedures.
+
+   Next_Col : Positive range 1 .. Buffer'Length + 1 := 1;
+   --  Column about to be written
+
+   type Saved_Output_Buffer is record
+      Buffer   : String (1 .. Buffer_Max + 1);
+      Next_Col : Positive;
+   end record;
+
 end Output;

gcc/ada/par-ch12.adb

@@ -519,6 +519,9 @@ package body Ch12 is
          --  exception is ABSTRACT, where we have to scan ahead to see if we
          --  have a formal derived type or a formal private type definition.
 
+         --  In addition, in Ada 2005 LIMITED may appear after abstract, so
+         --  that the lookahead must be extended by one more token.
+
          when Tok_Abstract =>
             Save_Scan_State (Scan_State);
             Scan; -- past ABSTRACT
@@ -527,6 +530,18 @@ package body Ch12 is
                Restore_Scan_State (Scan_State); -- to ABSTRACT
                return P_Formal_Derived_Type_Definition;
 
+            elsif Token = Tok_Limited then
+               Scan;  --  past LIMITED
+
+               if Token = Tok_New then
+                  Restore_Scan_State (Scan_State); -- to ABSTRACT
+                  return P_Formal_Derived_Type_Definition;
+
+               else
+                  Restore_Scan_State (Scan_State); -- to ABSTRACT
+                  return P_Formal_Private_Type_Definition;
+               end if;
+
             else
                Restore_Scan_State (Scan_State); -- to ABSTRACT
                return P_Formal_Private_Type_Definition;
@@ -560,7 +575,25 @@ package body Ch12 is
                Set_Limited_Present (Typedef_Node);
                return Typedef_Node;
 
+            elsif Token = Tok_New then
+               Restore_Scan_State (Scan_State); -- to LIMITED
+               return P_Formal_Derived_Type_Definition;
+
             else
+               if Token = Tok_Abstract then
+                  Error_Msg_SC ("ABSTRACT must come before LIMITED");
+                  Scan;  --  past improper ABSTRACT
+
+                  if Token = Tok_New then
+                     Restore_Scan_State (Scan_State); -- to LIMITED
+                     return P_Formal_Derived_Type_Definition;
+
+                  else
+                     Restore_Scan_State (Scan_State);
+                     return P_Formal_Private_Type_Definition;
+                  end if;
+               end if;
+
                Restore_Scan_State (Scan_State);
                return P_Formal_Private_Type_Definition;
             end if;
@@ -666,6 +699,20 @@ package body Ch12 is
          Scan; -- past LIMITED
       end if;
 
+      if Token = Tok_Abstract then
+         if Prev_Token = Tok_Tagged then
+            Error_Msg_SC ("ABSTRACT must come before TAGGED");
+         elsif Prev_Token = Tok_Limited then
+            Error_Msg_SC ("ABSTRACT must come before LIMITED");
+         end if;
+
+         Resync_Past_Semicolon;
+
+      elsif Token = Tok_Tagged then
+         Error_Msg_SC ("TAGGED must come before LIMITED");
+         Resync_Past_Semicolon;
+      end if;
+
       Set_Sloc (Def_Node, Token_Ptr);
       T_Private;
       return Def_Node;
@@ -676,9 +723,11 @@ package body Ch12 is
    --------------------------------------------
 
    --  FORMAL_DERIVED_TYPE_DEFINITION ::=
-   --    [abstract] new SUBTYPE_MARK [[AND interface_list] with private]
+   --    [abstract] [limited]
+   --         new SUBTYPE_MARK [[AND interface_list] with private]
 
-   --  The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
+   --  The caller has checked the initial token(s) is/are NEW, ASTRACT NEW
+   --  LIMITED NEW, or ABSTRACT LIMITED NEW
 
    --  Error recovery: cannot raise Error_Resync
 
@@ -693,6 +742,22 @@ package body Ch12 is
          Scan; -- past ABSTRACT
       end if;
 
+      if Token = Tok_Limited then
+         Set_Limited_Present (Def_Node);
+         Scan;  --  past Limited
+
+         if Ada_Version < Ada_05 then
+            Error_Msg_SP
+              ("LIMITED in derived type is an Ada 2005 extension");
+            Error_Msg_SP
+              ("\unit must be compiled with -gnat05 switch");
+         end if;
+
+         if Token = Tok_Abstract then
+            Scan;  --  past ABSTRACT. diagnosed already in caller.
+         end if;
+      end if;
+
       Scan; -- past NEW;
       Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
       No_Constraint;

gcc/ada/sinfo.adb

@@ -1692,6 +1692,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
@@ -4278,6 +4279,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Formal_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration

gcc/ada/sprint.ads

@@ -58,6 +58,7 @@ package Sprint is
    --    Freeze entity with freeze actions   freeze entityname [ actions ]
    --    Interpretation                      interpretation type [, entity]
    --    Intrinsic calls                     function-name!(arg, arg, arg)
+   --    Itype declaration                   [(sub)type declaration without ;]
    --    Itype reference                     reference itype
    --    Label declaration                   labelname : label
    --    Mod wi Treat_Fixed_As_Integer       x #mod y