diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2015-02-12 13:02:24 +0100 |
---|---|---|
committer | Daniel Llorens <daniel.llorens@bluewin.ch> | 2016-07-11 09:11:50 +0200 |
commit | fc0e75c50d6bced2cf86e8e6b175ec62dd40acfc (patch) | |
tree | c2326b102833fd9f0c29044104f85a855d4ecfcd | |
parent | ed6c65507ae3b93e02dbe22a2c1e31c1b8c329fb (diff) | |
download | guile-fc0e75c50d6bced2cf86e8e6b175ec62dd40acfc.tar.gz |
Fix compilation of rank 0 typed array literals
* module/system/vm/assembler.scm (simple-uniform-vector?): array-length
fails for rank 0 arrays; fix the shape condition.
* test-suite/tests/arrays.test: test reading of #0f64(x) in compilation
context.
-rw-r--r-- | module/system/vm/assembler.scm | 4 | ||||
-rw-r--r-- | test-suite/tests/arrays.test | 8 |
2 files changed, 10 insertions, 2 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 20a652c66..f6b3caac6 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -995,7 +995,9 @@ immediate, and @code{#f} otherwise." (define (simple-uniform-vector? obj) (and (array? obj) (symbol? (array-type obj)) - (equal? (array-shape obj) (list (list 0 (1- (array-length obj))))))) + (match (array-shape obj) + (((0 n)) #t) + (else #f)))) (define (statically-allocatable? x) "Return @code{#t} if a non-immediate constant can be allocated diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index c6027c2ec..9bd067688 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -217,7 +217,13 @@ (with-test-prefix/c&e "array-equal?" (pass-if "#s16(...)" - (array-equal? #s16(1 2 3) #s16(1 2 3)))) + (array-equal? #s16(1 2 3) #s16(1 2 3))) + + (pass-if "#0f64(...)" + (array-equal? #0f64(99) (make-typed-array 'f64 99))) + + (pass-if "#0(...)" + (array-equal? #0(99) (make-array 99)))) ;;; ;;; make-shared-array |