diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test new file mode 100644 index 000000000..95bbe3e31 --- /dev/null +++ b/test-suite/tests/unif.test @@ -0,0 +1,67 @@ +;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- +;;;; +;;;; Copyright 2004 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 +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(define-module (test-suite test-unif) + #:use-module (test-suite lib)) + + +;;; +;;; uniform-array-set1! +;;; + +(with-test-prefix "uniform-array-set1!" + + (with-test-prefix "one dim" + (let ((a (make-uniform-array '() '(3 5)))) + (pass-if "start" + (uniform-array-set1! a 'y '(3)) + #t) + (pass-if "end" + (uniform-array-set1! a 'y '(5)) + #t) + (pass-if-exception "start-1" exception:out-of-range + (uniform-array-set1! a 'y '(2))) + (pass-if-exception "end+1" exception:out-of-range + (uniform-array-set1! a 'y '(6))) + (pass-if-exception "two indexes" exception:out-of-range + (uniform-array-set1! a 'y '(6 7))) + (pass-if-exception "two improper indexes" exception:out-of-range + (uniform-array-set1! a 'y '(6 . 7))) + (pass-if-exception "three improper indexes" exception:out-of-range + (uniform-array-set1! a 'y '(6 7 . 8))))) + + (with-test-prefix "two dim" + (let ((a (make-uniform-array '() '(3 5) '(7 9)))) + (pass-if "start" + (uniform-array-set1! a 'y '(3 7)) + #t) + (pass-if "end" + (uniform-array-set1! a 'y '(5 9)) + #t) + (pass-if-exception "start i-1" exception:out-of-range + (uniform-array-set1! a 'y '(2 7))) + (pass-if-exception "end i+1" exception:out-of-range + (uniform-array-set1! a 'y '(6 9))) + (pass-if-exception "one index" exception:wrong-num-args + (uniform-array-set1! a 'y '(4))) + (pass-if-exception "three indexes" exception:wrong-num-args + (uniform-array-set1! a 'y '(4 8 0))) + (pass-if-exception "two improper indexes" exception:wrong-num-args + (uniform-array-set1! a 'y '(4 . 8))) + (pass-if-exception "three improper indexes" exception:wrong-num-args + (uniform-array-set1! a 'y '(4 8 . 0))))))