31a85b650e
* utils/hbmk2/hbmk2.*.po
* utils/hbmk2/hbmk2.prg
% minor optimization to recent patch
+ cleanups in some help items
+ '-?' and '-h' options are now accepted as '-help'
+ '-??' and '-hh' options are now accepted as '-longhelp'
- deleted '-license' option, it's now part of '-longhelp'
! hbshell_gtSelect() parameter fixed to be case insentitive
in an internal check
+ tests/clipper.ch
+ added header file that translates certain Harbour
specific functions to ones understood by Clipper.
Useful to compile lightly Harbour specific code
in Clipper (or other Clipper compatible language),
for comparison.
* tests/*.prg
- tests/exthrb.prg
+ tests/hrbext.prg
* website/samples/*.prg.html
! various cleanups, minor fixes, formatting
+ #included "clipper.ch" to enable running what's
possible to run with Clipper
* src/rtl/gtwin/gtwin.c
* src/rtl/gtwvt/gtwvt.c
! return string type for hb_gtInfo( HB_GTI_FONTSEL )
in sync with GTXWC
* contrib/xhb/xhbfunc.c
* include/hbdefs.h
* HB_FUNC_EXEC() macro value to not end with ';',
now it should be added on usage (almost all usages
were such already). To be code formatter friendly.
* contrib/xhb/xhb.hbp
+ contrib/xhb/xhbdepr.prg
+ added compatiblity stubs for functions deprecated from
Harbour core, but still available in xHarbour. (xHarbour
has yet to deprecate anything)
So here we can gather stuff that's deprecated from Harbour
core (except internal functions - most of them named '__*' -,
and the "evil" ones)
; NOTE: Runtime efficiency is not a goal with these stubs,
only "cheap" long term maintainability.
- contrib/hbblat/tests/blattest.prg
+ contrib/hbblat/tests/test.prg
* extras/guestbk/guestbk.hbp
- extras/guestbk/testcgi.prg
+ extras/guestbk/cgi.prg
* renames
* src/vm/dynsym.c
* contrib/hbfbird/tests/testapi.c
* contrib/xhb/thtm.prg
* minor
191 lines
3.5 KiB
Plaintext
191 lines
3.5 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
STATIC s_cbStatic
|
|
|
|
PROCEDURE Main()
|
|
|
|
LOCAL a := TestBlocks()
|
|
LOCAL cb
|
|
|
|
? Eval( a[ 1 ] ) // 23
|
|
? Eval( a[ 2 ], 42 ) // 42
|
|
? Eval( a[ 1 ] ) // 42
|
|
? Eval( a[ 2 ], 15 ) // 15
|
|
|
|
myout( 15, Eval( a[ 1 ] ) ) // 15 15
|
|
myout( 14, Eval( a[ 1 ] ) ) // 14 15
|
|
myout( 42, Eval( a[ 2 ], 42 ) ) // 42 42
|
|
myout( 14, Eval( a[ 2 ], 42 ) ) // 14 42
|
|
myout( 42, Eval( a[ 1 ] ) ) // 42 42
|
|
myout( 14, Eval( a[ 1 ] ) ) // 14 42
|
|
|
|
GetArray( @a )
|
|
PrintArray( @a )
|
|
|
|
? "Test for variables passed by reference in a codeblock"
|
|
DetachWithRefer()
|
|
|
|
? "Test for indirect detaching of local variables"
|
|
DetachToStatic( 1 )
|
|
myout( 2, Eval( s_cbStatic, 1 ) )
|
|
myout( 3, Eval( s_cbStatic, 2 ) )
|
|
cb := s_cbStatic
|
|
DetachToStatic( 100 )
|
|
myout( 200, Eval( s_cbStatic, 100 ) )
|
|
myout( 300, Eval( s_cbStatic, 200 ) )
|
|
myout( 4, Eval( cb, 3 ) )
|
|
|
|
ReferParam()
|
|
|
|
RETURN
|
|
|
|
STATIC FUNCTION TestBlocks()
|
|
|
|
LOCAL nFoo := 23
|
|
|
|
RETURN { {|| nFoo }, {| n | nFoo := n } }
|
|
|
|
STATIC FUNCTION myout( nExpected, nGot )
|
|
|
|
? nExpected, nGot
|
|
|
|
RETURN NIL
|
|
|
|
//
|
|
|
|
PROCEDURE GetArray( a )
|
|
|
|
LOCAL i
|
|
|
|
a := Array( 100 )
|
|
FOR i := 1 TO 100
|
|
IF ( i % 6 ) == 0
|
|
a[ i - 2 ] := NIL
|
|
a[ i - 4 ] := NIL
|
|
ENDIF
|
|
a[ i ] := TestBlocks()
|
|
NEXT
|
|
|
|
RETURN
|
|
|
|
PROCEDURE PrintArray( a )
|
|
|
|
LOCAL i
|
|
|
|
FOR i := 1 TO 100
|
|
IF a[ i ] != NIL
|
|
Eval( a[ i ][ 2 ], i )
|
|
myout( i, Eval( a[ i ][ 1 ] ) )
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN
|
|
|
|
//
|
|
|
|
FUNCTION DetachWithRefer()
|
|
|
|
LOCAL nTest
|
|
LOCAL bBlock1 := MakeBlock()
|
|
LOCAL bBlock2 := {|| DoThing( @nTest ), QOut( nTest ) }
|
|
|
|
Eval( bBlock1 )
|
|
Eval( bBlock2 )
|
|
|
|
RETURN NIL
|
|
|
|
FUNCTION MakeBlock()
|
|
|
|
LOCAL nTest
|
|
|
|
RETURN {|| DoThing( @nTest ), QOut( nTest ) }
|
|
|
|
FUNCTION DoThing( n )
|
|
|
|
n := 42
|
|
|
|
RETURN NIL
|
|
|
|
//
|
|
|
|
FUNCTION DetachToStatic( n )
|
|
|
|
s_cbStatic := {| x | n + x }
|
|
|
|
RETURN NIL
|
|
|
|
//
|
|
|
|
FUNCTION ReferParam()
|
|
|
|
LOCAL bResult
|
|
|
|
? "Test for codeblock parameter passed by reference"
|
|
|
|
PassByValue( {| lEnd | ;
|
|
bResult := GetBlock( @lEnd ), ;
|
|
SetByRef( @lEnd ) } )
|
|
// Clipper & xHarbour it's .T.
|
|
// In Harbour it is .F.
|
|
? "Printed value in Clipper .T. =", Eval( bResult )
|
|
?
|
|
// Notice the Clipper bug: GetBlock is receiving the reference to
|
|
// the codeblock parameter than the value of Eval( bResult ) shouldn't
|
|
// depend on the order of block creation/value changing (GetBlock/SetRef).
|
|
|
|
PassByRef( {| lEnd | ;
|
|
bResult := GetBlock( @lEnd ), ;
|
|
SetByRef( @lEnd ) } )
|
|
// Clipper & xHarbour it's .T.
|
|
// In Harbour it is .F.
|
|
? "Printed value in Clipper .T. =", Eval( bResult )
|
|
?
|
|
|
|
? "2nd test for codeblock parameter passed by reference"
|
|
|
|
PassByValue( {| lEnd | ;
|
|
SetByRef( @lEnd ), ;
|
|
bResult := GetBlock( @lEnd ) } )
|
|
// Clipper & Harbour it's .F.
|
|
? "Printed value in Clipper .F. =", Eval( bResult )
|
|
?
|
|
|
|
PassByRef( {| lEnd | ;
|
|
SetByRef( @lEnd ), ;
|
|
bResult := GetBlock( @lEnd ) } )
|
|
// Clipper & Harbour it's .F.
|
|
? "Printed value in Clipper .F. =", Eval( bResult )
|
|
?
|
|
|
|
RETURN NIL
|
|
|
|
STATIC FUNCTION PassByValue( bBlock )
|
|
|
|
LOCAL lSomeVar := .T.
|
|
|
|
Eval( bBlock, lSomeVar )
|
|
? "lSomeVar value in Clipper .T. =", lSomeVar
|
|
|
|
RETURN .T.
|
|
|
|
STATIC FUNCTION PassByRef( bBlock )
|
|
|
|
LOCAL lSomeVar := .T.
|
|
|
|
Eval( bBlock, @lSomeVar )
|
|
? "lSomeVar value in Clipper .F. =", lSomeVar
|
|
|
|
RETURN .T.
|
|
|
|
STATIC FUNCTION SetByRef( lVar )
|
|
|
|
lVar := .F.
|
|
|
|
RETURN NIL
|
|
|
|
STATIC FUNCTION GetBlock( lVar )
|
|
|
|
RETURN {|| lVar }
|