mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

update tests after vtable-vtable deprecation

Browse source 
* test-suite/tests/goops.test ("classes for built-in types"): Use a
  vtable instead of a vtable-vtable.

* test-suite/tests/structs.test (ball-root)
  ("low-level struct procedures", "make-struct"): Rework to use normal
  vtables instead of making new vtable-vtable.
This commit is contained in:
Andy Wingo 2012-07-28 12:58:46 +02:00
parent 6d46f1e48a
commit 07e6d2d451
2 changed files with 11 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

6
test-suite/tests/goops.test
View file

@ -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"

12
test-suite/tests/structs.test
View file

@ -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))))