/
destruct.prg
126 lines (92 loc) · 2.5 KB
/
destruct.prg
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
/*
* example/test code for object destructors
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
*/
#include "hbclass.ch"
MEMVAR P
PROCEDURE Main()
LOCAL bError
PUBLIC P := NIL
bError := ErrorBlock( {| oErr | myErrorHandler( oErr ) } )
? "First simple tests when object is not destroyed by GC"
? "====================================================="
SIMPLETEST( 0 )
SIMPLETEST( 1 )
SIMPLETEST( 2 )
SIMPLETEST( 3 )
?
? "Now object will be destroyed by GC"
? "=================================="
GCFREETEST( 0 )
GCFREETEST( 1 )
GCFREETEST( 2 )
GCFREETEST( 3 )
ErrorBlock( bError )
?
? "*** END OF TEST ***"
RETURN
STATIC PROCEDURE SIMPLETEST( type )
LOCAL o
?
? "=> o := myClass():new( " + hb_ntos( type ) + " )"
o := myClass():new( type )
? "=> o:className() ->", o:className()
? "=> o := NIL"
BEGIN SEQUENCE
o := NIL
END SEQUENCE
RETURN
STATIC PROCEDURE GCFREETEST( type )
LOCAL o, a
?
? "=> o := myClass():new( " + hb_ntos( type ) + " )"
o := myClass():new( type )
? "=> o:className() ->", o:className()
? "=> create corss reference: a := { o, NIL }; a[ 2 ] := a; a := NIL"
a := { o, NIL }; a[ 2 ] := a; a := NIL
? "=> o := NIL"
BEGIN SEQUENCE
o := NIL
END SEQUENCE
? "=> hb_gcAll()"
BEGIN SEQUENCE
hb_gcAll()
END SEQUENCE
RETURN
STATIC FUNCTION myErrorHandler( oErr )
? "Error ->", hb_ntos( oErr:gencode ), ;
oErr:description + ":", oErr:operation
BREAK oErr
RETURN NIL
CREATE CLASS myClass
VAR TYPE
VAR var1
CLASS VAR var2
METHOD INIT
DESTRUCTOR dtor
END CLASS
METHOD INIT( type ) CLASS myClass
? "Hi, I'm INIT method of class:", Self:classname()
::type := type
RETURN Self
PROCEDURE DTOR CLASS myClass
? " Hi, I'm desturctor of class: ", Self:classname()
IF ::type == 1
? " I'm storing reference to Self in instance variable."
? " Bad practice but safe in Harbour because it will be destroyed."
::var1 := Self
ELSEIF ::Type == 2
? " I'm storing reference to Self in class variable."
? " It's programmer bug which should cause RT error."
::var2 := Self
ELSEIF ::Type == 3
? " I'm storing reference to Self in public variable."
? " It's programmer bug which should cause RT error."
P := Self
ELSE
? " I do not store any references to Self."
? " It's a safe destructor."
ENDIF
RETURN