Fix accessor struct field inlining

[bpt/guile.git] / test-suite / tests / goops.test

diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 724c0ee..1c6d33e 100644 (file)
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -599,3 +599,37 @@
           (pass-if-equal 100 (slot-ref a 'test))
           (pass-if-equal 100 (slot-ref b 'test))
           (pass-if-equal 200 (slot-ref c 'test)))))))
+
+(with-test-prefix "accessor slots"
+  (let* ((a-accessor (make-accessor 'a))
+         (b-accessor (make-accessor 'b))
+         (<a> (class ()
+                (a #:init-keyword #:a #:accessor a-accessor)
+                #:name '<a>))
+         (<b> (class ()
+                (b #:init-keyword #:b #:accessor b-accessor)
+                #:name '<b>))
+         (<ab> (class (<a> <b>) #:name '<ab>))
+         (<ba> (class (<b> <a>) #:name '<ba>))
+         (<cab> (class (<ab>)
+                  (a #:init-keyword #:a)
+                  #:name '<cab>))
+         (<cba> (class (<ba>)
+                  (a #:init-keyword #:a)
+                  #:name '<cba>))
+         (a (make <a> #:a 'a))
+         (b (make <b> #:b 'b))
+         (ab (make <ab> #:a 'a #:b 'b))
+         (ba (make <ba> #:a 'a #:b 'b))
+         (cab (make <cab> #:a 'a #:b 'b))
+         (cba (make <cba> #:a 'a #:b 'b)))
+    (pass-if-equal "a accessor on a" 'a (a-accessor a))
+    (pass-if-equal "a accessor on ab" 'a (a-accessor ab))
+    (pass-if-equal "a accessor on ba" 'a (a-accessor ba))
+    (pass-if-equal "a accessor on cab" 'a (a-accessor cab))
+    (pass-if-equal "a accessor on cba" 'a (a-accessor cba))
+    (pass-if-equal "b accessor on a" 'b (b-accessor b))
+    (pass-if-equal "b accessor on ab" 'b (b-accessor ab))
+    (pass-if-equal "b accessor on ba" 'b (b-accessor ba))
+    (pass-if-equal "b accessor on cab" 'b (b-accessor cab))
+    (pass-if-equal "b accessor on cba" 'b (b-accessor cba))))