From b3373157854310c7b4684561b6673f5ddfc2ef6f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 13 Apr 2008 20:41:23 +0200
Subject: [PATCH] Test the interaction of GOOPS objects with
 `struct-{ref,set!}'.

---
 test-suite/ChangeLog        |  7 +++++++
 test-suite/tests/goops.test | 28 ++++++++++++++++++++++++++--
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index fa169bc60..518e53f8f 100644
--- 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 8ed697c59..e4c2df906 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 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"