389b9d1c4a
* contrib/gtwvg/class.prg
* contrib/gtwvg/parthdlr.prg
* contrib/gtwvg/radiobut.prg
* contrib/gtwvg/toolbar.prg
* contrib/gtwvg/wnd.prg
* contrib/hbnf/doc/en/amedian.txt
* contrib/hbnf/doc/en/ftidle.txt
* contrib/hbnf/doc/en/iamidle.txt
* contrib/hbnf/tests/datecnfg.prg
* contrib/hbsqlit3/tests/sl3_test.prg
* contrib/hbtip/tests/ftpadv.prg
* contrib/hbtip/tests/httpadv.prg
* contrib/xhb/hblog.prg
* contrib/xhb/htmutil.prg
* contrib/xhb/sprintf.prg
* doc/clipper.txt
* extras/gtwvw/tests/ebtest7.prg
* extras/gtwvw/tests/maximize.prg
* extras/gtwvw/tests/prog0.prg
* extras/gtwvw/tests/prog1.prg
* extras/gtwvw/tests/prog2.prg
* extras/gtwvw/tests/wvwmouse.prg
* extras/gtwvw/tests/wvwtest9.prg
* extras/hbdoc/hbdoc.prg
* extras/httpsrv/cookie.prg
* extras/httpsrv/session.prg
* src/rtl/tbrowse.prg
* tests/destruct.prg
* tests/switch.prg
* tests/t1.prg
* tests/testbrw.prg
* tests/tstuse.prg
* utils/hbmk2/hbmk2.prg
* utils/hbtest/rt_math.prg
* END -> END*
* other minor cleanups and formatting
133 lines
2.6 KiB
Plaintext
133 lines
2.6 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* example/test code for object destructors
|
|
*
|
|
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
|
|
* www - http://harbour-project.org
|
|
*
|
|
*/
|
|
|
|
#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
|