summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2015-02-12 13:02:24 +0100
committerDaniel Llorens <daniel.llorens@bluewin.ch>2016-07-11 09:11:50 +0200
commitfc0e75c50d6bced2cf86e8e6b175ec62dd40acfc (patch)
treec2326b102833fd9f0c29044104f85a855d4ecfcd
parented6c65507ae3b93e02dbe22a2c1e31c1b8c329fb (diff)
downloadguile-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.scm4
-rw-r--r--test-suite/tests/arrays.test8
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