-
Notifications
You must be signed in to change notification settings - Fork 214
Expand file tree
/
Copy pathcodebl.prg
More file actions
185 lines (124 loc) · 3.54 KB
/
codebl.prg
File metadata and controls
185 lines (124 loc) · 3.54 KB
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
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
//
STATIC 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
STATIC 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
//
STATIC FUNCTION DetachWithRefer()
LOCAL nTest
LOCAL bBlock1 := MakeBlock()
LOCAL bBlock2 := {|| DoThing( @nTest ), QOut( nTest ) }
Eval( bBlock1 )
Eval( bBlock2 )
RETURN NIL
STATIC FUNCTION MakeBlock()
LOCAL nTest
RETURN {|| DoThing( @nTest ), QOut( nTest ) }
STATIC FUNCTION DoThing( n )
n := 42
RETURN NIL
//
STATIC FUNCTION DetachToStatic( n )
s_cbStatic := {| x | n + x }
RETURN NIL
//
STATIC 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 }