Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.2.0 / tests / test / packages / cocoaint / tobjcnh1.pp
Size: Mime:
{ %target=darwin }
{ %cpu=powerpc,i386,powerpc64,x86_64 }

{$mode objfpc}{$H+}
{$modeswitch objectivec1}
program Start;
uses
ctypes,
CFBase, CFString,
CocoaAll;

type
MyObject = objcclass(NSObject)
  function initMyObject : id; message 'initMyObject';
  function testFunction : cint; message 'testFunction';
end;

MySubobject = objcclass(MyObject)
  function initMyObject : id; message 'initMyObject'; override;
  function testFunction : cint; message 'testFunction'; override;
end;

procedure NSLog(fmt : CFStringRef); cdecl; varargs; external name 'NSLog';

function MyObject.initMyObject : id;
  var
    temp: id;
  begin
    Result:=nil;
    NSLog(CFSTR('MyObject.initMyObject entry, self = %p'), self);
    Result := inherited init;
    { default NSObject.init does not return anything different,
      so should be safe in test program }
    if result<>self then
      halt(1);
    NSLog(CFSTR('Result assigned by inherited init = %p'), Result);
    NSLog(CFSTR('self after inherited init = %p'), self);
    Result := self;
    NSLog(CFSTR('returning result = %p'), Result)
  end;

function MyObject.testFunction : cint;
  begin
    Result := 1;
    NSLog(CFSTR('MyObject.testFunction returning %d'), Result)
  end;

function MySubobject.initMyObject : id;
  begin
    Result:=nil;
    NSLog(CFSTR('MySubobject.initMyObject entry, self = %p'), self);
    Result := inherited initMyObject;
    if (result<>self) then
      halt(2);
    NSLog(CFSTR('Result assigned by inherited initMyObject = %p'), Result);
    NSLog(CFSTR('self after inherited init = %p'), self);
    Result := self;
    NSLog(CFSTR('returning result = %p'), Result)
  end;

function MySubobject.testFunction : cint;
  begin
    Result:=-1;
    writeln('MySubobject.testFunction calling inherited...');
    Result := inherited testFunction;
    if (result<>1) then
      halt(3);
    NSLog(CFSTR('Return from inherited = %d'), Result);
    Result := 2;
    NSLog(CFSTR('MySubobject.testFunction returning %d'), Result)
  end;


procedure MyTest;
  var
    ap: NSAutoreleasePool;
    o: MyObject;
    oo: MySubobject;
    n: cint;
  begin
    ap := NSAutoreleasePool.new;
    writeln('========== Initializing MyObject and MySubobject ==========');
    o := MyObject(MyObject.alloc).initMyObject;
    writeln;
    oo := MySubobject(MySubobject.alloc).initMyObject;
    writeln; writeln;
    writeln('========== Testing testFunction ==========');
    n := o.testFunction;
    writeln('MyObject.testFunction returned ', n);
    writeln;
    n := oo.testFunction;
    writeln('MySubobject.testFunction returned ', n);
    o.release;
    oo.release;
    ap.drain
  end;

begin
  MyTest;
end.