1"======================================================================
2|
3|   Test out block operations
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright (C) 1988, 1989, 1999, 2007, 2008  Free Software Foundation.
12| Written by Steve Byrne and Paolo Bonzini
13|
14| This file is part of GNU Smalltalk.
15|
16| GNU Smalltalk is free software; you can redistribute it and/or modify it
17| under the terms of the GNU General Public License as published by the Free
18| Software Foundation; either version 2, or (at your option) any later version.
19|
20| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
21| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
22| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
23| details.
24|
25| You should have received a copy of the GNU General Public License along with
26| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
27| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
28|
29 ======================================================================"
30
31Eval [ [45] ]			"should return a block"
32
33Eval [ [^#quem] value ]		"should return #quem"
34
35Eval [ ['foo'] value ]		"should return 'foo'"
36
37Eval [ [:i | i] value: 'juma' ]	"should return 'juma'"
38
39Eval [ [:i :j| j] value: 12 value: 17 ] 	"should return 17"
40
41Object extend [
42
43    blockTest1 [
44        [#foo]
45    ]
46
47    blockTest2 [
48        [^#foo]
49    ]
50
51    blockTest3 [
52        ^[#bar]
53    ]
54
55    blockTest4 [
56        ^[^#bar]
57    ]
58
59    blockTest5: arg [
60        ^[arg]
61    ]
62
63    blockTest6: arg [
64        ^[:i | arg at: i]
65    ]
66
67    blockTest7: arg [
68        | temp |
69        temp := (arg at: 4) + 8.
70        ^[temp]
71    ]
72
73    blockTest8: which [
74        | first second |
75        first := nil blockTest7: #('one' #two 3.0 4 $5).
76        second := nil blockTest7: #("You are[,] number" 'six' #seven 8.0 9 $A).
77        which ifTrue: [ ^first value ]
78	      ifFalse: [ ^second value]
79    ]
80
81"Implements a 'closure'!!!  Smalltalk is AMAZING!!!"
82    blockTest9: initialValue [
83        | counter |
84        counter := initialValue.
85        ^[:incr | counter := counter + incr.
86                  counter]
87    ]
88
89    "Implements a REAL 'closure'!!!  GNU Smalltalk is AMAZING!!!"
90    blockTest10 [
91        | counter |
92        counter := 1.
93        "If blocks were not real closures, variable would be 1 the
94         second time the block was called and hence it would not
95         be modified.
96         Instead if blocks are closures, variable is still nil the
97         second time the block is evaluated, and is initialized to
98         two."
99        ^[   | variable |
100             variable isNil ifTrue: [ variable := counter ].
101             counter := counter + 1.
102             variable
103        ]
104    ]
105
106    blockTest11: initialValue [
107        ^[^initialValue]
108    ]
109]
110
111Eval [ nil blockTest1 ]		"should return nil"
112
113Eval [ nil blockTest2 ]		"should return nil"
114
115Eval [ nil blockTest3 ]		"should return a BlockClosure"
116Eval [ nil blockTest3 value ]		"should return #bar"
117
118Eval [ nil blockTest4 value ]		"should issue an error, we're returning to
119				 a non-existent context"
120
121Eval [ (nil blockTest5: 'Smalltalk!') value ]
122				"should return 'Smalltalk!'"
123
124Eval [ (nil blockTest6: #('one' #two 3.0 4 $5)) value: 2 ]
125				"should return #two"
126
127Eval [ (nil blockTest7: #('you' #are #number 6)) value ]
128				"should return 14"
129
130Eval [ nil blockTest8: true ]		"should return 12"
131Eval [ nil blockTest8: false ]		"should return 17"
132
133"Create a block with the initial value of 2"
134Eval [ Smalltalk at: #testBlock put: (nil blockTest9: 2) ]
135
136Eval [ testBlock value: 3 ]		"should return 5"
137Eval [ testBlock value: 6 ]		"should return 11"
138Eval [ testBlock value: 2 ]		"should return 13"
139
140Eval [ Smalltalk at: #testBlock put: (nil blockTest10) ]
141
142Eval [ testBlock value ]		"should return 1"
143Eval [ testBlock value ]		"should return 2 (1 if blocks aren't closures)"
144
145"And this is even more amazing!!!"
146Eval [
147    | array |
148    array := (1 to: 10) collect: [ :each | [each] ].
149    ^array inject: 0 into: [ :sum :each | sum + each value ]	"should get 55"
150]
151
152
153Eval [ (nil blockTest11: 3) value ]	"should be invalid; we're returning to non-
154					 existent parent"
155
156"Various tests on #cull:cull:cull: and friends."
157Eval [   [] cull: 1     ]
158Eval [   [] cull: 1 cull: 2     ]
159Eval [   [] cull: 1 cull: 2 cull: 3    ]
160
161Eval [   [:a |a] cull: 1     ]
162Eval [   [:a |a] cull: 1 cull: 2     ]
163Eval [   [:a |a] cull: 1 cull: 2 cull: 3    ]
164
165Eval [   [:a :b |a] cull: 1     ]
166Eval [   [:a :b |a] cull: 1 cull: 2   ]
167Eval [   [:a :b |a] cull: 1 cull: 2 cull: 3   ]
168Eval [   [:a :b |b] cull: 1 cull: 2    ]
169Eval [   [:a :b |b] cull: 1 cull: 2 cull: 3    ]
170
171Eval [   [:a :b :c |a] cull: 1 cull: 2    ]
172Eval [   [:a :b :c |a] cull: 1 cull: 2 cull: 3    ]
173Eval [   [:a :b :c |b] cull: 1 cull: 2 cull: 3    ]
174Eval [   [:a :b :c |c] cull: 1 cull: 2 cull: 3    ]
175