tests/array.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (in-package :cl-user)
  13
  14 ;;; Array initialization has complicated defaulting for :ELEMENT-TYPE,
  15 ;;; and both compile-time and run-time logic takes a whack at it.
  16 (let ((testcases '(;; Bug 126, confusion between high-level default string
  17                    ;; initial element #\SPACE and low-level default array
  18                    ;; element #\NULL, is gone.
  19                    (#\null (make-array 11 :element-type 'character))
  20                    (#\space (make-string 11 :initial-element #\space))
  21                    (#\* (make-string 11 :initial-element #\*))
  22                    (#\null (make-string 11))
  23                    (#\null (make-string 11 :initial-element #\null))
  24                    (#\x (make-string 11 :initial-element #\x))
  25                    ;; And the other tweaks made when fixing bug 126 didn't
  26                    ;; mess things up too badly either.
  27                    (0 (make-array 11))
  28                    (nil (make-array 11 :initial-element nil))
  29                    (12 (make-array 11 :initial-element 12))
  30                    (0 (make-array 11 :element-type '(unsigned-byte 4)))
  31                    (12 (make-array 11
  32                                    :element-type '(unsigned-byte 4)
  33                                    :initial-element 12)))))
  34   (dolist (testcase testcases)
  35     (destructuring-bind (expected-result form) testcase
  36       (unless (eql expected-result (aref (eval form) 3))
  37         (error "expected ~S in EVAL ~S" expected-result form))
  38       (unless (eql expected-result
  39                    (aref (funcall (compile nil `(lambda () ,form))) 3))
  40         (error "expected ~S in FUNCALL COMPILE ~S" expected-result form)))))