Test the interaction of GOOPS objects with `struct-{ref,set!}'.

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index fa169bc606d9c667e3be6db73150e683cfe57721..518e53f8fd82b46829989d7b9372f296619ce2f5 100644 (file)
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,10 @@
+2008-04-13  Ludovic Courtès  <ludo@gnu.org>
+
+       * tests/goops.test (defining classes)[interaction with
+       `struct-ref', interaction with `struct-set!']: New test.  Checks
+       the interaction of `struct-ref' with "light structs", fixed on
+       2008-04-10 (commit 4650d115020924e8da5547d4c346cbe5cd01029e).
+
 2008-04-06  Ludovic Courtès  <ludo@gnu.org>
 
        * standalone/test-asmobs-lib.c, standalone/test-conversion.c,

diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 8ed697c59bba242c4645e198bdbddfaeca8f153a..e4c2df9062cf6758ec2cfa3b07ec10b1be196487 100644 (file)
--- 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 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -148,7 +148,31 @@
                          #t)
                        (lambda args
                          #f)))
-    ))
+
+    (pass-if "interaction with `struct-ref'"
+       (eval '(define-class <class-struct> ()
+                (foo #:init-keyword #:foo)
+                (bar #:init-keyword #:bar))
+             (current-module))
+       (eval '(let ((x (make <class-struct>
+                         #:foo 'hello
+                         #:bar 'world)))
+                (and (struct? x)
+                     (eq? (struct-ref x 0) 'hello)
+                     (eq? (struct-ref x 1) 'world)))
+             (current-module)))
+
+     (pass-if "interaction with `struct-set!'"
+       (eval '(define-class <class-struct-2> ()
+                (foo) (bar))
+             (current-module))
+       (eval '(let ((x (make <class-struct-2>)))
+                (struct-set! x 0 'hello)
+                (struct-set! x 1 'world)
+                (and (struct? x)
+                     (eq? (struct-ref x 0) 'hello)
+                     (eq? (struct-ref x 1) 'world)))
+             (current-module)))))
 
 (with-test-prefix "defining generics"