diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test index e84ae3947..52028f219 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/ramap.test @@ -1,6 +1,6 @@ ;;;; ramap.test --- test array mapping functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -28,20 +28,147 @@ (pass-if-exception "no args" exception:wrong-num-args (array-map!)) - (pass-if-exception "one args" exception:wrong-num-args + (pass-if-exception "one arg" exception:wrong-num-args (array-map! (make-array #f 5))) - ;; in Guile 1.6.4 and earlier this resulted in a segv - (pass-if-exception "no sources" exception:wrong-num-args - (array-map! (make-array #f 5) noop)) + (with-test-prefix "no sources" - ;; in Guile 1.6.5 and 1.6.6 this was an error - (pass-if "one source" - (let ((a (make-array #f 5))) - (array-map! a 1+ (make-array 123 5)) - (equal? a (make-array 124 5)))) + (pass-if "closure 0" + (array-map! (make-array #f 5) (lambda () #f)) + #t) - (pass-if "two sources" - (let ((a (make-array #f 4))) - (array-map! a + #(1 2 3 4) #(5 6 7 8)) - (equal? a #(6 8 10 12))))) + (pass-if-exception "closure 1" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda (x) #f))) + + (pass-if-exception "closure 2" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda (x y) #f))) + + (pass-if-exception "subr_1" exception:wrong-num-args + (array-map! (make-array #f 5) length)) + + (pass-if-exception "subr_2" exception:wrong-num-args + (array-map! (make-array #f 5) logtest)) + + (pass-if-exception "subr_2o" exception:wrong-num-args + (array-map! (make-array #f 5) number->string)) + + (pass-if-exception "dsubr" exception:wrong-num-args + (array-map! (make-array #f 5) $sqrt)) + + (pass-if "rpsubr" + (let ((a (make-array 'foo 5))) + (array-map! a =) + (equal? a (make-array #t 5)))) + + (pass-if "asubr" + (let ((a (make-array 'foo 5))) + (array-map! a +) + (equal? a (make-array 0 5)))) + + ;; in Guile 1.6.4 and earlier this resulted in a segv + (pass-if "noop" + (array-map! (make-array #f 5) noop) + #t)) + + (with-test-prefix "one source" + + (pass-if-exception "closure 0" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda () #f) + (make-array #f 5))) + + (pass-if "closure 1" + (let ((a (make-array #f 5))) + (array-map! a (lambda (x) 'foo) (make-array #f 5)) + (equal? a (make-array 'foo 5)))) + + (pass-if-exception "closure 2" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda (x y) #f) + (make-array #f 5))) + + (pass-if "subr_1" + (let ((a (make-array #f 5))) + (array-map! a length (make-array '(x y z) 5)) + (equal? a (make-array 3 5)))) + + (pass-if-exception "subr_2" exception:wrong-num-args + (array-map! (make-array #f 5) logtest + (make-array 999 5))) + + (pass-if "subr_2o" + (let ((a (make-array #f 5))) + (array-map! a number->string (make-array 99 5)) + (equal? a (make-array "99" 5)))) + + (pass-if "dsubr" + (let ((a (make-array #f 5))) + (array-map! a $sqrt (make-array 16.0 5)) + (equal? a (make-array 4.0 5)))) + + (pass-if "rpsubr" + (let ((a (make-array 'foo 5))) + (array-map! a = (make-array 0 5)) + (equal? a (make-array #t 5)))) + + (pass-if "asubr" + (let ((a (make-array 'foo 5))) + (array-map! a - (make-array 99 5)) + (equal? a (make-array -99 5)))) + + ;; in Guile 1.6.5 and 1.6.6 this was an error + (pass-if "1+" + (let ((a (make-array #f 5))) + (array-map! a 1+ (make-array 123 5)) + (equal? a (make-array 124 5))))) + + (with-test-prefix "two sources" + + (pass-if-exception "closure 0" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda () #f) + (make-array #f 5) (make-array #f 5))) + + (pass-if-exception "closure 1" exception:wrong-num-args + (array-map! (make-array #f 5) (lambda (x) #f) + (make-array #f 5) (make-array #f 5))) + + (pass-if "closure 2" + (let ((a (make-array #f 5))) + (array-map! a (lambda (x y) 'foo) + (make-array #f 5) (make-array #f 5)) + (equal? a (make-array 'foo 5)))) + + (pass-if-exception "subr_1" exception:wrong-type-arg + (array-map! (make-array #f 5) length + (make-array #f 5) (make-array #f 5))) + + (pass-if "subr_2" + (let ((a (make-array 'foo 5))) + (array-map! a logtest + (make-array 999 5) (make-array 999 5)) + (equal? a (make-array #t 5)))) + + (pass-if "subr_2o" + (let ((a (make-array #f 5))) + (array-map! a number->string + (make-array 32 5) (make-array 16 5)) + (equal? a (make-array "20" 5)))) + + (pass-if "dsubr" + (let ((a (make-array #f 5))) + (array-map! a $sqrt + (make-array 16.0 5) (make-array 16.0 5)) + (equal? a (make-array 4.0 5)))) + + (pass-if "rpsubr" + (let ((a (make-array 'foo 5))) + (array-map! a = (make-array 99 5) (make-array 77 5)) + (equal? a (make-array #f 5)))) + + (pass-if "asubr" + (let ((a (make-array 'foo 5))) + (array-map! a - (make-array 99 5) (make-array 11 5)) + (equal? a (make-array 88 5)))) + + (pass-if "+" + (let ((a (make-array #f 4))) + (array-map! a + #(1 2 3 4) #(5 6 7 8)) + (equal? a #(6 8 10 12))))))