-- ===========================================================================
-- Copyright 1996 by WPL Laboratories, Inc.  All Rights Reserved
--
--                        WPL Laboratories, Inc.
--                        Whitehall Offices, Suite 6
--                        410 Lancaster Avenue
--                        Haverford, PA 19041
--
--
-- For Support call 610-658-2362
--
-- $Revision: 1.1 $ $Date: 1995/01/15 19:48:46 $
--  
-- ===========================================================================

with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
with Ada.Text_IO;
with Generic_Lists_Pkg;

package broken is

   -- =======================================================================
   -- PURPOSE:
   --
   --    To demonstrater a problem with Unbounded_Strings
   -- 
   -- OUTSTANDING ISSUES:
   -- =======================================================================  

   -- ====================
   -- Base
   -- ====================

   type Base_Type is abstract tagged private;

   -- ====================
   -- Text_Holder
   -- ====================

   type Text_Holder_Type is abstract new Base_Type with private;

   procedure Add (Holder  : in out Text_Holder_Type;
                  Text    : in     String);
   -- ====================================================================
   -- PURPOSE:
   --    Appends Text to already existing data in Holder.
   -- ====================================================================

   procedure Replace (Holder  : in out Text_Holder_Type;
                      Text    : in     String);
   -- ====================================================================
   -- PURPOSE:
   --    Zeros out Data of Holder and adds new Text to Holder.
   -- ====================================================================

   function Value (Holder : in Text_Holder_Type) return String;
   -- ====================================================================
   -- PURPOSE:
   --    Return Holder's text.
   -- ====================================================================


   -- ====================
   -- Object_Holder
   -- ====================

   type Object_Holder_Type is abstract new Text_Holder_Type with private;
      
   function Value (Holder : in Object_Holder_Type) return String;
   -- ====================================================================
   -- PURPOSE:
   --    Return Holder's text.
   -- ====================================================================

   
   -- ====================
   -- Broken
   -- ====================

   type Broken_Type is new Object_Holder_Type with private;

   procedure Add (Holder  : in out Object_Holder_Type'Class;
                  Item    : in     Broken_Type);
   -- ====================================================================
   -- PURPOSE:
   --    Add a Broken_Type(Item) to any Object_Holder_Type(Holder) 
   -- ====================================================================

   procedure Replace (Holder  : in out Object_Holder_Type'Class;
                      Item    : in     Broken_Type);
   -- ====================================================================
   -- PURPOSE:
   --    Zeros out Data of Holder and adds a new Item to Holder.
   -- ====================================================================

   -- ========================================================================
   -- Private Section!!!
   -- ========================================================================


   private
   
   type Base_Type is abstract tagged null record;
   
   type Text_Holder_Type is abstract new Base_Type with
      record
         Data: Unbounded_String := To_Unbounded_String ("");
      end record;

   package List_Handler is new Generic_Lists_Pkg (Element_Type => Base_Type);
   
   type Object_Holder_Type is abstract new Text_Holder_Type with 
      record
         Object_List_Ptr: List_Handler.List_Ptr_Type := null;
      end record;
      
   function Data_Value (Holder : in Object_Holder_Type) return String;
   -- ====================================================================
   -- PURPOSE:
   --    Return Holder's Objects.
   -- ====================================================================
   
   type Broken_Type is new Object_Holder_Type with null record;
end broken;