;;;; structs.test --- Structures. -*- mode: scheme; coding: utf-8; -*-
;;;; Ludovic Courtès <ludo@gnu.org>, 2006-06-12.
;;;;
-;;;; Copyright (C) 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 2010, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;; Struct example taken from the reference manual (by Tom Lord).
;;;
-(define ball-root (make-vtable-vtable "pr" 0))
+(define ball-root
+ (make-vtable (string-append standard-vtable-fields "pr") 0))
(define (make-ball-type ball-color)
(make-struct ball-root 0
(and (eq? (struct-vtable red) ball-root)
(eq? (struct-vtable green) ball-root)
(eq? (struct-vtable (make-ball red "Bob")) red)
+ (eq? (struct-vtable ball-root) <standard-vtable>)
;; end of the vtable tower
- (eq? (struct-vtable ball-root) ball-root)))
+ (eq? (struct-vtable <standard-vtable>) <standard-vtable>)))
(pass-if-exception "write-access denied"
exception:struct-set!-denied
(not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
(equal? (make-ball red "Bob") (make-ball red "Bill"))))))
+\f
+(with-test-prefix "hash"
+
+ (pass-if "simple structs"
+ (let* ((v (make-vtable "pr"))
+ (s1 (make-struct v 0 "hello"))
+ (s2 (make-struct v 0 "hello")))
+ (= (hash s1 7777) (hash s2 7777))))
+
+ (pass-if "different structs"
+ (let* ((v (make-vtable "pr"))
+ (s1 (make-struct v 0 "hello"))
+ (s2 (make-struct v 0 "world")))
+ (or (not (= (hash s1 7777) (hash s2 7777)))
+ (throw 'unresolved))))
+
+ (pass-if "different struct types"
+ (let* ((v1 (make-vtable "pr"))
+ (v2 (make-vtable "pr"))
+ (s1 (make-struct v1 0 "hello"))
+ (s2 (make-struct v2 0 "hello")))
+ (or (not (= (hash s1 7777) (hash s2 7777)))
+ (throw 'unresolved))))
+ (pass-if "more complex structs"
+ (let ((s1 (make-ball red (string-copy "Bob")))
+ (s2 (make-ball red (string-copy "Bob"))))
+ (= (hash s1 7777) (hash s2 7777))))
+
+ (pass-if "struct with weird fields"
+ (let* ((v (make-vtable "prurph"))
+ (s1 (make-struct v 0 "hello" 123 "invisible-secret1"))
+ (s2 (make-struct v 0 "hello" 123 "invisible-secret2")))
+ (= (hash s1 7777) (hash s2 7777))))
+
+ (pass-if "cyclic structs"
+ (let* ((v (make-vtable "pw"))
+ (a (make-struct v 0 #f))
+ (b (make-struct v 0 a)))
+ (struct-set! a 0 b)
+ (and (hash a 7777) (hash b 7777) #t))))
+
+\f
;;
;; make-struct
;;
;; the program
;;
(pass-if-exception "wrong type for `u' field" exception:wrong-type-arg
- (let* ((vv (make-vtable-vtable "" 0))
+ (let* ((vv (make-vtable standard-vtable-fields))
(v (make-struct vv 0 (make-struct-layout "uw"))))
(make-struct v 0 'x)))
;; SCM can cause a segv).
;;
(pass-if-exception "no R/W/O for tail array" exception:bad-tail
- (let* ((vv (make-vtable-vtable "" 0))
+ (let* ((vv (make-vtable standard-vtable-fields))
(v (make-struct vv 0 (make-struct-layout "pw"))))
(make-struct v 123 'x))))