File: tobjc18.pp

package info (click to toggle)
fpc 2.6.4%2Bdfsg-4
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 178,760 kB
  • ctags: 83,946
  • sloc: pascal: 2,000,374; xml: 138,807; ansic: 9,617; asm: 7,843; yacc: 3,747; php: 3,271; sh: 2,626; makefile: 2,610; lex: 2,537; sql: 267; cpp: 145; sed: 132; perl: 126; csh: 34; tcl: 7
file content (94 lines) | stat: -rw-r--r-- 2,104 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
{ %target=darwin }
{ %cpu=powerpc,powerpc64,i386,x86_64,arm }

{ Written by Jonas Maebe in 2009, released into the public domain }

{$mode objfpc}
{$modeswitch objectivec1}

type
  MyOverride = objcclass(NSObject)
    procedure release; override;
    class procedure testClassOverride; message 'testClassOverride';
  end;

  MyOverride2 = objcclass(MyOverride)
    procedure release; override;
    class procedure testClassOverride; override;
  end;
  tmyoverrideclass = class of myoverride;

var
  selfshouldbe: tmyoverrideclass;
  selfshouldbetestinlinetypedefinition: class of myoverride2;
  overridescalled: longint;

procedure MyOverride.release;
begin
  writeln('releasing override!');
  if (overridescalled<>3) then
    halt(1);
  inc(overridescalled);
  inherited release;
end;

class procedure MyOverride.testClassOverride;
begin
  if (self<>selfshouldbe) then
    halt(20);

  writeln('MyOverride.testClassOverride');
  if (overridescalled<>1) then
    halt(3);
  inc(overridescalled);
end;

procedure MyOverride2.release;
begin
  inherited testClassOverride;
  writeln('releasing override2!');
  if (overridescalled<>2) then
    halt(2);
  inc(overridescalled);
  inherited release;
end;

class procedure MyOverride2.testClassOverride;
begin
  if (self<>selfshouldbe) then
    halt(21);

  if (overridescalled<>0) then
    halt(5);
  writeln('MyOverride2.testClassOverride');
  inc(overridescalled);
  inherited testClassOverride;
end;

var
  a: MyOverride;
  b: id;
begin
  { test type compatibility conversions between id and class ref }
  b:=MyOverride2;
  selfshouldbetestinlinetypedefinition:=b;
  b:=selfshouldbetestinlinetypedefinition;

  { tested calling class methods and inherited class methods }
  a:=MyOverride2.alloc;
  a:=a.init;
  selfshouldbe:=MyOverride2;
  MyOverride2.testClassOverride;
  if (overridescalled<>2) then
    halt(6);
  dec(overridescalled);
  selfshouldbe:=MyOverride;
  MyOverride.testClassOverride;
  if (overridescalled<>2) then
    halt(7);
  overridescalled:=0;
  selfshouldbe:=MyOverride2;
  a.testClassOverride;
  overridescalled:=1;
  a.release;
end.