diff options
author | Andy Wingo <wingo@pobox.com> | 2012-07-28 13:22:57 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-07-28 13:22:57 +0200 |
commit | e088b09d7dce5d78c96288778969876b6d25d726 (patch) | |
tree | 58b208afe85331a75191361c9d5fdb10d6cf06f0 | |
parent | e0f68f785d3899c6b565c12d6540f20730fcd9cc (diff) | |
parent | 880e114b9d06bb488b27a3af1d1fdefcc1f464bd (diff) | |
download | guile-e088b09d7dce5d78c96288778969876b6d25d726.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
libguile/struct.c
libguile/struct.h
-rw-r--r-- | test-suite/tests/goops.test | 6 | ||||
-rw-r--r-- | test-suite/tests/structs.test | 12 |
2 files changed, 11 insertions, 7 deletions
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index b864b2408..1705ee811 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -1,6 +1,6 @@ ;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 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 @@ -147,7 +147,9 @@ (pass-if "struct vtable" ;; Previously, `class-of' would fail for nameless structs, i.e., structs ;; for which `struct-vtable-name' is #f. - (is-a? (class-of (make-vtable-vtable "prprpr" 0)) <class>))) + (is-a? (class-of (make-vtable + (string-append standard-vtable-fields "prprpr"))) + <class>))) (with-test-prefix "defining classes" diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test index 55e08075b..431a014b8 100644 --- a/test-suite/tests/structs.test +++ b/test-suite/tests/structs.test @@ -1,7 +1,7 @@ ;;;; 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 @@ -26,7 +26,8 @@ ;;; 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 @@ -63,9 +64,10 @@ (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 @@ -139,7 +141,7 @@ ;; 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))) @@ -150,7 +152,7 @@ ;; 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)))) |