with Ada.Unchecked_Deallocation;
with Ada.Text_IO;              use Ada.Text_IO;
with GNATCOLL.Scripts;         use GNATCOLL.Scripts;
with GNATCOLL.Scripts.Python;  use GNATCOLL.Scripts.Python;
with TestConsole;              use TestConsole;

package body Support is

   type Cache_Data_PropsR is new Instance_Property_Record with record
      Val : Cache_Data_Access;
   end record;
   type Cache_Data_Props is access all Cache_Data_PropsR'Class;
   overriding procedure Destroy (Prop : in out Cache_Data_PropsR);

   Global : Cache_Data_Access;

   overriding procedure Destroy (Prop : in out Cache_Data_PropsR) is
   begin
      if Prop.Val /= null then
         Put_Line ("Destroy cache_data_props");
         Flush;
      end if;
   end Destroy;

   function Lookup return Cache_Data_Access is
   begin
      if Global = null then
         Global := new Cache_Data;
         Global.Data := Global.Data + 1;
         Global.Inst := new Instance_List;
      end if;
      return Global;
   end Lookup;

   procedure Destroy (Self : in out Cache_Data_Access) is
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
         (Cache_Data, Cache_Data_Access);
   begin
      if Self /= null then
         Free (Self.Inst);
         Unchecked_Free (Self);
      end if;
   end Destroy;

   procedure Set_Data (CI : in out Class_Instance; Data : Cache_Data_Access) is
   begin
      Set_Data (CI, "Cache", Cache_Data_PropsR'(Val => Data));
      Set (Data.Inst.all, Get_Script (CI), CI);
   end Set_Data;

   function Get_Data (CI : Class_Instance) return Cache_Data_Access is
      D : Cache_Data_Props := Cache_Data_Props (Instance_Property'
         (Get_Data (CI, "Cache")));
   begin
      if D /= null then
         return D.Val;
      else
         return null;
      end if;
   end Get_Data;
end Support;


