{$mode objfpc}
type
  tdeftype = (nonedef, intdef, stringdef, floatdef, recorddef);
  tstringtype = (st_none, st_shortstring, st_longstring, st_ansistring);

  tdef = class(tobject)
    typ : tdeftype;
    class var defcount : longint;
    constructor create(atyp : tdeftype);
    constructor create; virtual;
    destructor destroy; override;
  end;

  tstringdef = class(tdef)
    stringtype : tstringtype;
    class var stringcount : longint;
    constructor create(astyp : tstringtype);
    constructor create; override;
    destructor destroy; override;
  end;

const
  tagtypes : set of tdeftype = [stringdef, recorddef];

  function use_tag_prefix(def : tdef) : boolean;
    begin
      { stringdefs are not all considered as 'taggable',
        because ansi, unicode and wide strings are
        just associated to pointer types }
      use_tag_prefix:=(def.typ in tagtypes) and
                    ((def.typ<>stringdef) or
{$ifdef ERROR1}
                    (tstringdef(tdef).stringtype in [st_shortstring,st_longstring]));
{$else}
                    (tstringdef(def).stringtype in [st_shortstring,st_longstring]));
{$endif}
    end;


   constructor tdef.create(atyp : tdeftype);
     begin
       inherited create;
       typ:=atyp;
       inc(defcount);
     end;

   constructor tdef.create;
     begin
       create(intdef);
     end;

   destructor tdef.destroy;
     begin
       dec(defcount);
       inherited destroy;
     end;

   constructor tstringdef.create(astyp : tstringtype);
     begin
       inherited create(stringdef);
       stringtype:=astyp;
       inc(stringcount);
     end;

   constructor tstringdef.create;
     begin
       create(st_shortstring);
     end;

   destructor tstringdef.destroy;
     begin
       dec(stringcount);
       inherited destroy;
     end;

var
  cdef : class of tdef; 
  def, def2, def_int, def_rec, def_shortstring, def_ansistring : tdef;
  error : boolean;

begin
  error:=false;
  cdef:=tdef;
  def:=cdef.create;
  cdef:=tstringdef;
  def2:=cdef.create;
  def_int:=tdef.create(intdef);
  def_rec:=tdef.create(recorddef);
  def_shortstring:=tstringdef.create(st_shortstring);  
  def_ansistring:=tstringdef.create(st_ansistring);  
  if use_tag_prefix(def_int) then
    begin
      writeln('Wrong result for int type');
      error:=true;
    end;
  if not use_tag_prefix(def_rec) then
    begin
      writeln('Wrong result for record type');
      error:=true;
    end;
  if not use_tag_prefix(def_shortstring) then
    begin
      writeln('Wrong result for short string type');
      error:=true;
    end;
  if use_tag_prefix(def_ansistring) then
    begin
      writeln('Wrong result for ansi string type');
      error:=true;
    end;

  if not (def is tdef) or (def is tstringdef) or use_tag_prefix(def) then
    begin
      writeln('Wrong result for default int type');
      error:=true;
    end;

  if not (def2 is tstringdef) or not use_tag_prefix(def2) then
    begin
      writeln('Wrong result for default string type');
      error:=true;
    end;

  writeln('Number of def created=',tdef.defcount);
  writeln('Number of stringdef created=',tstringdef.stringcount);
  
  writeln('Number of def created (using cdef)=',cdef.defcount);
  writeln('Number of stringdef created (using cdef)=',tstringdef(cdef).stringcount);
   writeln('test stringdefcount=',tstringdef(tdef).stringcount);
{$ifdef ERROR2}
  writeln('test stringtype=',ord(tstringdef.stringtype));
{$endif}
{$ifdef ERROR3}
  writeln('test stringtype=',ord(tstringdef(tstringdef).stringtype));
{$endif}
{$ifdef ERROR4}
  writeln('test stringtype=',ord(tstringdef(tdef).stringtype));
{$endif}
  def.destroy;
  def2.destroy;
  def_int.destroy;
  def_rec.destroy;
  def_shortstring.destroy;
  def_ansistring.destroy;

  if error then
    halt(1);

  writeln('Number of def created (using cdef)=',cdef.defcount);
  writeln('Number of stringdef created (using cdef)=',tstringdef(cdef).stringcount);
  if (cdef.defcount<>0) or (tstringdef.stringcount<>0) then
    begin
      Writeln('Not all classes are freed correctly');
      halt(2);
    end;
end.