Smart pascal source code


type
 TBase = class
  class procedure MyProc;
  class function Virt: string; virtual;
end;

type
 TChild = class(TBase)
   class function Virt: string; override;
end;

implementation 

class procedure TBase.MyProc;
begin
  if Assigned(Self) then
  begin
    Writeln(Self.ClassName);
    Writeln(Self.Virt);
  end
  else
    Writeln('nil');
end;

class function TBase.Virt: string;
begin
  Result := 'base_' + Self.ClassType.ClassName;
end;

class function TChild.Virt: string;
begin
  Result := 'child_' + Self.ClassType.ClassName;
end;

{ main.pas }
var
  o: TBase;

Begin
  try
    o.MyProc;
  except on E: Exception do
    Writeln(E.Message);
  end;

  o := TBase.Create;
  o.MyProc;

  o := TChild.Create;
  o.MyProc;

  TBase.Myproc;
  TChild.Myproc;
  { ### CONSOLE OUTPUTS ###
  TypeError, Cannot read property 'ClassType' of null
  TBase
  base_TBase
  TChild
  child_TChild
  TBase
  base_TBase
  TChild
  child_TChild
}

var Exception={
	$ClassName: "Exception",
	$Parent: TObject,
	$Init: function () { FMessage="" },
	Create: function (s,Msg) { s.FMessage=Msg; return s }
}
function $W(e) { return e.ClassType?e:Exception.Create($New(Exception),e.constructor.name+", "+e.message) }
function $New(c) { var i={ClassType:c}; c.$Init(i); return i }
function $Is(o,c) {
	if (o===null) return false;
	return $Inh(o.ClassType,c);
};
function $Inh(s,c) {
	if (s===null) return false;
	while ((s)&&(s!==c)) s=s.$Parent;
	return (s)?true:false;
};

      var o = null;
      try {
         TBase.MyProc(o.ClassType);
      } catch ($e) {
         var E = $W($e);
         WriteLn(E.FMessage)      }
      o = TObject.Create($New(TBase));
      TBase.MyProc(o.ClassType);
      o = TObject.Create($New(TChild));
      TBase.MyProc(o.ClassType);
      TBase.MyProc(TBase);
      TBase.MyProc(TChild);

/// TBase = class (TObject)
///  [line: 72, column: 2, file: uMain]
var TBase = {
   $ClassName:"TBase",$Parent:TObject
   ,$Init:function ($) {
      TObject.$Init($);
   }
   /// procedure TBase.MyProc()
   ///  [line: 82, column: 23, file: uMain]
   ,MyProc:function(Self) {
      if (Self) {
         WriteLn(ClassName$1(Self));
         WriteLn(TBase.Virt$(Self));
      } else {
         WriteLn("nil");
      }
   }
   /// function TBase.Virt() : String
   ///  [line: 93, column: 22, file: uMain]
   ,Virt:function(Self) {
      return "base_"+ClassName$1(TObject.ClassType(Self));
   }
   ,Destroy:TObject.Destroy
   ,Virt$:function($){return $.Virt($)}
};
/// TChild = class (TBase)
///  [line: 78, column: 2, file: uMain]
var TChild = {
   $ClassName:"TChild",$Parent:TBase
   ,$Init:function ($) {
      TBase.$Init($);
   }
   /// function TChild.Virt() : String
   ///  [line: 98, column: 23, file: uMain]
   ,Virt:function(Self) {
      return "child_"+ClassName$1(TObject.ClassType(Self));
   }
   ,Destroy:TObject.Destroy
   ,Virt$:function($){return $.Virt($)}
};