1. with Ada.Streams;                       use Ada.Streams; 
  2.  
  3. package Objects is 
  4.  
  5.     type Object is abstract tagged private; 
  6.     type A_Object is access all Object'Class; 
  7.     pragma No_Strict_Aliasing( A_Object ); 
  8.  
  9.     -- Adjusts the object's fields as part of a Copy. If this class or an 
  10.     -- ancestor class doesn't support copying then COPY_NOT_ALLOWED will be 
  11.     -- raised. A subclass should call its superclass' Adjust before doing any 
  12.     -- work. 
  13.     procedure Adjust( this : access Object ); 
  14.  
  15.     -- Constructs the object. A subclass should call its superclass' Adjust 
  16.     -- before doing any work. 
  17.     procedure Construct( this : access Object ); 
  18.  
  19.     -- Deletes the object's fields as part of object destruction. A subclass 
  20.     -- should call its superclass' Adjust before doing any work. 
  21.     procedure Delete( this : in out Object ); 
  22.  
  23.     -- Returns the name of the instance's class in lower case characters. This 
  24.     -- is defined to be the class' external tag which is not guaranteed to be 
  25.     -- unique across the entire application. If 'full' is True, the fully 
  26.     -- qualified class name which includes a package prefix will be returned. 
  27.     function Get_Class_Name( this : not null access Object'Class; 
  28.                              full : Boolean := False ) return String; 
  29.     pragma Postcondition( Get_Class_Name'Result'Length > 0 ); 
  30.  
  31.     -- Returns a string representation of the object. 
  32.     function To_String( this : access Object ) return String; 
  33.  
  34.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Object ); 
  35.  
  36.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Object ); 
  37.  
  38.     -- Returns a copy of an Object. Not all object classes can be copied. If the 
  39.     -- given object is not allowed to be copied, COPY_NOT_ALLOWED will be 
  40.     -- raised. 
  41.     function Copy( src : A_Object ) return A_Object; 
  42.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  43.  
  44.     -- Deletes an Object. 
  45.     procedure Delete( this : in out A_Object ); 
  46.     pragma Postcondition( this = null ); 
  47.  
  48.     -- Concatenates the string representation of the Object, as returned by the 
  49.     -- To_String function. 
  50.     function "&"( left : A_Object; right : String ) return String; 
  51.  
  52.     -- Concatenates the string representation of the Object, as returned by the 
  53.     -- To_String function. 
  54.     function "&"( left : String; right : A_Object ) return String; 
  55.  
  56.     ---------------------------------------------------------------------------- 
  57.  
  58.     -- Raised when attempting a copy on an Object class that doesn't support 
  59.     -- copying. 
  60.     COPY_NOT_ALLOWED : exception; 
  61.  
  62. private 
  63.  
  64.     type Object is abstract tagged null record; 
  65.  
  66.     for Object'Read use Object_Read; 
  67.     for Object'Write use Object_Write; 
  68.  
  69. end Objects;