-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathZUSR_LISP_TESTS.abap
352 lines (299 loc) · 12.8 KB
/
ZUSR_LISP_TESTS.abap
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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
*&---------------------------------------------------------------------*
*& Report ZUSR_LISP_TESTS
*& https://github.com/mydoghasworms/abap-lisp
*& Tests for the Lisp interpreter written in ABAP
*& Copy and paste this code into a type 1 (report) program, making sure
*& the necessary dependencies are met
*&---------------------------------------------------------------------*
*& Martin Ceronio, [email protected]
*& June 2015
*& MIT License (see below)
*&---------------------------------------------------------------------*
* The MIT License (MIT)
*
* Copyright (c) 2015 Martin Ceronio
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to deal
* in the Software without restriction, including without limitation the rights
* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
* copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
* THE SOFTWARE.
report zusr_lisp_tests line-size 999.
include zlib_lisp.
data: lr_int type ref to lcl_lisp_interpreter.
data: print_offset type i.
parameter: p_parse as checkbox default space. "Parse tests
parameter: p_basic as checkbox default space. "Basic tests
parameter: p_maths as checkbox default space. "Math tests
parameter: p_compa as checkbox default space. "Comparison tests
parameter: p_listp as checkbox default space. "List tests
parameter: p_func1 as checkbox default space. "Basic functions
parameter: p_funct as checkbox default space. "Functional tests
parameter: p_hasht as checkbox default space. "Hash element
parameter: p_abapi as checkbox default space. "ABAP Integration
parameter: p_abapf as checkbox default space. "ABAP function module integration tests
*&---------------------------------------------------------------------*
*& Form code_test
*& Conduct a test with given code
*&---------------------------------------------------------------------*
form code_test using code type string.
data: lv_result type string.
write: / '<-', code.
lv_result = lr_int->eval_source( code ).
write: / '->', lv_result.
uline.
endform. "code_test
*&---------------------------------------------------------------------*
*& Form print_element
*& Write out a given element
*----------------------------------------------------------------------*
form print_element using element type ref to lcl_lisp_element.
data: lr_elem type ref to lcl_lisp_element.
case element->type.
when lcl_lisp_element=>type_conscell.
new-line.
write: at print_offset '('.
lr_elem = element.
do.
add 2 to print_offset.
perform print_element using lr_elem->car.
subtract 2 from print_offset.
if lr_elem->cdr = lr_int->nil.
exit.
endif.
lr_elem = lr_elem->cdr.
enddo.
write: ')'.
when lcl_lisp_element=>type_number or lcl_lisp_element=>type_symbol.
write element->value.
endcase.
endform. "print_element
*&---------------------------------------------------------------------*
*& Form parse_test
*& Test parsing of a given piece of code and write out result
*----------------------------------------------------------------------*
form parse_test using code type string.
write: / '<-', code.
write: / '>-'.
data: element type ref to lcl_lisp_element.
data: elements type lcl_lisp_interpreter=>tt_element.
elements = lr_int->parse( code ).
read table elements into element index 1.
if sy-subrc ne 0.
write: / 'No evaluated element from first expression'.
return.
endif.
print_offset = 1.
perform print_element using element.
uline.
endform. "parse_test
start-of-selection.
data: code type string.
* Initialze Lisp interpreter
create object lr_int.
*--------------------------------------------------------------------*
* BASIC TESTS
if p_parse = abap_true.
perform parse_test using '(define a(lambda()20))'.
code =
'(define riff-shuffle ' &&
' ( lambda (deck) (begin ' &&
' (define take ' &&
' (lambda (n seq) (if (<= n 0) (quote ()) (cons (car seq) (take (- n 1) (cdr seq)))))) ' &&
' (define drop ' &&
' (lambda (n seq) (if (<= n 0) seq (drop (- n 1) (cdr seq)))))' &&
' (define mid ' &&
' (lambda (seq) (/ (length seq) 2)))' &&
' ((combine append) (take (mid deck) deck) (drop (mid deck) deck))' &&
' )))' .
perform parse_test using code.
endif.
if p_basic = abap_true.
* Test quote
perform code_test using '(quote 19)'.
perform code_test using '(quote a)'.
perform code_test using '''19'.
perform code_test using '''a'.
perform code_test using '''(list 1 2 3)'.
* Test DEFINE
perform code_test using '(define 22 23)'. "Err
perform code_test using '(define a 23)'.
perform code_test using 'a'. "Err
* Test strings
perform code_test using '"string value"'.
perform code_test using '"string value with \" escaped double quote"'.
perform code_test using '(quote "string value with \" escaped double quote")'.
* Evaluating multiple expressions
perform code_test using '(define a (list 1 2 3 4)) (define b (cdr a)) a b'.
endif.
if p_maths = abap_true.
* Test addition
perform code_test using '(+ 22 24 25)'.
* Test multiplication
perform code_test using '(* 22)'.
perform code_test using '(* 11 12)'.
perform code_test using '(* 11 12 13)'.
* Test subtraction
perform code_test using '(- 22)'.
perform code_test using '(- 22 23 24)'.
perform code_test using '(- (- (- (- (- 5 1) 1) 1) 1) 1)'.
* Test division
perform code_test using '(/ 2)'.
perform code_test using '(/ 10)'.
perform code_test using '(/ 5 10)'.
perform code_test using '(/ 11 12 13)'.
endif.
if p_listp = abap_true.
* Test list
perform code_test using '(list ())'.
perform code_test using '(list nil)'.
perform code_test using '(list 22 23 24)'.
perform code_test using '(list 22 (list 23 24))'.
* Test append
perform code_test using '(append (list 22 (list 23 24)) 23)'.
perform code_test using '(append (append (list 22 (list 23 24)) 23) 28)'. "Should give an error
perform code_test using '(append (list 1) (list 2))'.
* Test length
perform code_test using '(length (list 21 22 23 24))'.
perform code_test using '(length (list 22 (list 23 24)))'.
* CAR & CDR test
perform code_test using '(car (list 22 (list 23 24)))'.
perform code_test using '(cdr (list 22 (list 23 24)))'.
perform code_test using '(car (car (cdr (list 22 (list 23 24)))))'.
perform code_test using '(car nil)'.
perform code_test using '(car (list 1))'.
* Test CONS
perform code_test using '(cons (list 1 2) (list 3 4))'.
perform code_test using '(cons 1 nil)'.
perform code_test using '(cons 2 (list 3 4))'.
perform code_test using '(cons 2 3)'.
endif.
if p_compa = abap_true.
* Test GT
perform code_test using '(> 1 2)'.
perform code_test using '(> 2 1)'.
perform code_test using '(> 4 3 2 1)'.
perform code_test using '(> 4 3 2 2)'.
* Test GTE
perform code_test using '(>= 2 2)'.
perform code_test using '(>= 4 3 3 2)'.
perform code_test using '(>= 1 4)'.
* Test LT
perform code_test using '(< 1 2 3)'.
perform code_test using '(< 1 2 2)'.
perform code_test using '(< 3 1)'.
* Test equal?
perform code_test using '(equal? 22 23)'.
perform code_test using '(equal? 22 22)'.
perform code_test using '(equal? (list 21) (list 21))'.
* Test IF
perform code_test using '(if 22 23)'.
perform code_test using '(if (< 2 1) 23)'.
perform code_test using '(if (< 2 1) 23 24)'.
* Test =
perform code_test using '(= 2 3)'.
perform code_test using '(= 3 3)'.
* Test nil?
perform code_test using '(nil? ())'.
perform code_test using '(nil? nil)'.
perform code_test using '(nil? (cdr (list 1)))'.
perform code_test using '(nil? (cdr (list 1 2)))'.
endif.
*--------------------------------------------------------------------*
* BASIC FUNCTIONS
if p_func1 = abap_true.
* Test LAMBDA
perform code_test using '(define b (lambda (b) (* 10 b)))'.
perform code_test using 'b'.
perform code_test using '(b 20)'.
perform code_test using '((lambda (a) (+ a 20)) 10 )'.
* Function shorthand
perform code_test using '(define (fact x) (if (= x 0) 1 (* x (fact (- x 1)))))'.
perform code_test using '(fact 8)'.
endif.
*--------------------------------------------------------------------*
* FUNCTIONAL TESTS
if p_funct = abap_true.
* COMBINE + ZIP
perform code_test using '(define combine (lambda (f) (lambda (x y) (if (nil? x) (quote ()) (f (list (car x) (car y)) ((combine f) (cdr x) (cdr y)))))))'.
perform code_test using '(define zip (combine cons))'.
perform code_test using 'zip'.
perform code_test using '(zip (list 1 2 3 4) (list 5 6 7 8))'.
perform code_test using '(define compose (lambda (f g) (lambda (x) (f (g x)))))'.
perform code_test using '(define repeat (lambda (f) (compose f f)))'.
* Riffle-shuffle
code =
'(define riff-shuffle' &&
'(lambda (deck) (begin ' &&
'(define take ' &&
'(lambda (n seq) (if (<= n 0) (quote ()) (cons (car seq) (take (- n 1) (cdr seq)))))) ' &&
'(define drop ' &&
'(lambda (n seq) (if (<= n 0) seq (drop (- n 1) (cdr seq)))))' &&
'(define mid ' &&
'(lambda (seq) (/ (length seq) 2)))' &&
'((combine append) (take (mid deck) deck) (drop (mid deck) deck))' &&
')))' .
perform code_test using code.
perform code_test using '(riff-shuffle (list 1 2 3 4 5 6 7 8))'.
perform code_test using '((repeat riff-shuffle) (list 1 2 3 4 5 6 7 8))'.
perform code_test using '(riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8))))'.
perform code_test using '(define (fact x) (define (fact-tail x accum) (if (= x 0) accum (fact-tail (- x 1) (* x accum)))) (fact-tail x 1))'.
perform code_test using '(fact 8)'. "FIXME: returns fact-tail
endif.
*--------------------------------------------------------------------*
* HASH IMPLEMENTATION
if p_hasht = abap_true.
perform code_test using '(define h1 (make-hash ''(dog "bow-wow" cat "meow" kennel (dog cat hedgehog))))'.
perform code_test using 'h1'.
perform code_test using '(hash-keys h1)'.
perform code_test using '(hash-get h1 ''kennel)'.
perform code_test using '(hash-remove h1 ''kennel)'.
perform code_test using '(hash-get h1 ''sparrow)'.
perform code_test using '(hash-insert h1 ''sparrow "whoosh")'.
perform code_test using '(hash-get h1 ''sparrow)'.
perform code_test using '(hash-keys h1)'.
endif.
*--------------------------------------------------------------------*
* ABAP INTEGRATION
if p_abapi = abap_true.
perform code_test using '(define mandt (ab-data "MANDT"))'.
perform code_test using '(ab-set-value mandt "000")'.
perform code_test using 'mandt'.
* Empty structure
perform code_test using '(define t005g (ab-data "T005G"))'.
perform code_test using '(ab-set-value t005g ''("000" "ZA" "ABC" "JHB"))'.
perform code_test using '(ab-get-value t005g)'.
perform code_test using '(ab-get t005g "LAND1")'.
perform code_test using '(ab-get ab-sy "UNAME")'.
endif.
*--------------------------------------------------------------------*
* ABAP FUNCTION MODULE INTEGRATION
if p_abapf = abap_true.
perform code_test using '(ab-function "TH_USER_INFO")'.
perform code_test using '(define f1 (ab-function "TH_USER_INFO"))'.
perform code_test using '(f1)'.
perform code_test using '(ab-get f1 "ADDRSTR")'.
perform code_test using '(define f2 (ab-function "TH_TEST_RFC"))'.
perform code_test using '(ab-set f2 "TEXT_IN" "Calling from ABAP Lisp")'.
perform code_test using '(f2)'.
perform code_test using '(ab-get f2 "TEXT_OUT")'.
perform code_test using '(define f3 (ab-function "BAPI_USER_GET_DETAIL"))'.
perform code_test using '(ab-set f3 "USERNAME" (ab-get ab-sy "UNAME"))'.
perform code_test using '(f3)'.
perform code_test using '(define profiles (ab-get f3 "PROFILES"))'.
perform code_test using 'profiles'.
perform code_test using '(define profile (ab-get profiles 1))'.
perform code_test using '(ab-get profile "BAPIPROF")'.
endif.