1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Fix bug in new array reader

* module/ice-9/read.scm (read-array): Return pair for dimension when len
  is given; single number is lbnd for list->typed-array.
* test-suite/tests/arrays.test: More test cases for the reader.
This commit is contained in:
Daniel Llorens 2021-03-03 18:40:39 +01:00
parent 8edf1dc623
commit 9516a10ab3
2 changed files with 37 additions and 5 deletions

View file

@ -507,10 +507,8 @@
(error "unexpected end of input while reading array")) (error "unexpected end of input while reading array"))
(values ch (values ch
(if len (if len
(if (zero? lbnd) (list lbnd (+ lbnd (1- len)))
len lbnd))))
(list lbnd (+ lbnd (1- len))))
lbnd))))
(define (read-shape ch alt) (define (read-shape ch alt)
(if (memv ch '(#\@ #\:)) (if (memv ch '(#\@ #\:))
(let*-values (((ch head) (read-dimension ch)) (let*-values (((ch head) (read-dimension ch))

View file

@ -994,7 +994,7 @@
;;; printing arrays ;;; printing arrays
;;; ;;;
(with-test-prefix/c&e "printing and reading arrays" (with-test-prefix/c&e "printing arrays"
(pass-if-equal "writing 1D arrays that aren't vectors" (pass-if-equal "writing 1D arrays that aren't vectors"
"#1(b c)" "#1(b c)"
(format #f "~a" (make-shared-array #(a b c) (format #f "~a" (make-shared-array #(a b c)
@ -1057,3 +1057,37 @@
"#3@1@-1@1(((1)) ((1)) ((1)))" "#3@1@-1@1(((1)) ((1)) ((1)))"
(format #f "~a" (make-array 1 '(1 3) '(-1 -1) '(1 1))))) (format #f "~a" (make-array 1 '(1 3) '(-1 -1) '(1 1)))))
;;;
;;; reading arrays
;;;
(with-test-prefix/c&e "reading arrays"
(pass-if "empty 3-array with first nonempty dim I"
(array-equal? (make-array 1 1 0 0)
(call-with-input-string "#3(())" read)))
(pass-if "empty 3-array with first nonempty dim II"
(array-equal? (make-array 1 1 0 0)
#3(())))
(pass-if "empty 3-array with middle nonempty dim I"
(array-equal? (make-array 1 0 1 0)
(call-with-input-string "#3:0:1:0()" read)))
(pass-if "empty 3-array with middle nonempty dim II"
(array-equal? (make-array 1 0 1 0)
#3:0:1:0()))
(pass-if "empty typed 3-array with middle nonempty dim I"
(array-equal? (make-typed-array 'f64 1 0 1 0)
(call-with-input-string "#3f64:0:1:0()" read)))
(pass-if "empty typed 3-array with middle nonempty dim II"
(array-equal? (make-typed-array 'f64 1 0 1 0)
#3f64:0:1:0()))
(pass-if "array with specified size I"
(array-equal? #f64(1 2 3)
(call-with-input-string "#f64:3(1 2 3)" read)))
(pass-if "array with specified size II"
(array-equal? #f64(1 2 3)
#f64:3(1 2 3))))