mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 20:30:28 +02:00
(make-struct): Exercise the error check on tail
array size != 0 when layout spec doesn't have tail array. (make-vtable): Exercise this.
This commit is contained in:
parent
364f8ccfdc
commit
08ea3794d2
1 changed files with 43 additions and 1 deletions
|
@ -102,6 +102,13 @@
|
|||
(equal? (make-ball red "Bob") (make-ball red "Bill"))))))
|
||||
|
||||
|
||||
;;
|
||||
;; make-struct
|
||||
;;
|
||||
|
||||
(define exception:bad-tail
|
||||
(cons 'misc-error "tail array not allowed unless"))
|
||||
|
||||
(with-test-prefix "make-struct"
|
||||
|
||||
;; in guile 1.8.1 and earlier, this caused an error throw out of an
|
||||
|
@ -111,7 +118,42 @@
|
|||
(pass-if-exception "wrong type for `u' field" exception:wrong-type-arg
|
||||
(let* ((vv (make-vtable-vtable "" 0))
|
||||
(v (make-struct vv 0 (make-struct-layout "uw"))))
|
||||
(make-struct v 0 'x))))
|
||||
(make-struct v 0 'x)))
|
||||
|
||||
;; In guile 1.8.1 and earlier, and 1.6.8 and earlier, there was no check
|
||||
;; on a tail array being created without an R/W/O type for it. This left
|
||||
;; it uninitialized by scm_struct_init(), resulting in garbage getting
|
||||
;; into an SCM when struct-ref read it (and attempting to print a garbage
|
||||
;; SCM can cause a segv).
|
||||
;;
|
||||
(pass-if-exception "no R/W/O for tail array" exception:bad-tail
|
||||
(let* ((vv (make-vtable-vtable "" 0))
|
||||
(v (make-struct vv 0 (make-struct-layout "pw"))))
|
||||
(make-struct v 123 'x))))
|
||||
|
||||
;;
|
||||
;; make-vtable
|
||||
;;
|
||||
|
||||
(with-test-prefix "make-vtable"
|
||||
|
||||
(pass-if "without printer"
|
||||
(let* ((vtable (make-vtable "pwpr"))
|
||||
(struct (make-struct vtable 0 'x 'y)))
|
||||
(and (eq? 'x (struct-ref struct 0))
|
||||
(eq? 'y (struct-ref struct 1)))))
|
||||
|
||||
(pass-if "with printer"
|
||||
(let ()
|
||||
(define (print struct port)
|
||||
(display "hello" port))
|
||||
|
||||
(let* ((vtable (make-vtable "pwpr" print))
|
||||
(struct (make-struct vtable 0 'x 'y))
|
||||
(str (call-with-output-string
|
||||
(lambda (port)
|
||||
(display struct port)))))
|
||||
(equal? str "hello")))))
|
||||
|
||||
|
||||
;;; Local Variables:
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue