summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-04-28 18:51:21 +0200
committerAndy Wingo <wingo@pobox.com>2014-04-28 18:51:21 +0200
commitd7a67c3e918acd8ca46dc7792a8ca98b33cb94e8 (patch)
tree7ccf125978778d1ac6bb656245305c76db8e02d0 /test-suite/tests
parent475772ea57c97d0fa0f9ed9303db137d9798ddd3 (diff)
parent4338f2f91e1dd63a40384077d091295d90047926 (diff)
downloadguile-d7a67c3e918acd8ca46dc7792a8ca98b33cb94e8.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: .gitignore doc/example-smob/Makefile doc/ref/api-smobs.texi doc/ref/libguile-concepts.texi doc/ref/libguile-smobs.texi libguile.h libguile/finalizers.c libguile/finalizers.h libguile/goops.c module/language/tree-il/compile-glil.scm module/oop/goops.scm
Diffstat (limited to 'test-suite/tests')
-rw-r--r--test-suite/tests/goops.test43
1 files changed, 39 insertions, 4 deletions
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index 1705ee811..d8a5ecfad 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, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014 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
@@ -474,9 +474,9 @@
(x bar)
(set! (x bar) 2)
(equal? (reverse z)
- '(before-ref before-set! 1 before-ref after-ref
- after-set! 1 1 before-ref after-ref
- before-set! 2 before-ref after-ref after-set! 2 2)))
+ '(before-set! 1 before-ref after-ref
+ after-set! 1 1 before-ref after-ref
+ before-set! 2 before-ref after-ref after-set! 2 2)))
(current-module))))
(use-modules (oop goops composite-slot))
@@ -527,3 +527,38 @@
exception:no-applicable-method
(eval '(quxy 1)
(current-module))))
+
+(with-test-prefix "foreign slots"
+ (define-class <foreign-test> ()
+ (a #:init-keyword #:a #:class <foreign-slot>
+ #:accessor test-a)
+ (b #:init-keyword #:b #:init-form 3 #:class <foreign-slot>
+ #:accessor test-b))
+
+ (pass-if-equal "constructing, no initargs"
+ '(0 3)
+ (let ((x (make <foreign-test>)))
+ (list (slot-ref x 'a)
+ (slot-ref x 'b))))
+
+ (pass-if-equal "constructing, initargs"
+ '(1 2)
+ (let ((x (make <foreign-test> #:a 1 #:b 2)))
+ (list (slot-ref x 'a)
+ (slot-ref x 'b))))
+
+ (pass-if-equal "getters"
+ '(0 3)
+ (let ((x (make <foreign-test>)))
+ (list (test-a x) (test-b x))))
+
+ (pass-if-equal "setters"
+ '(10 20)
+ (let ((x (make <foreign-test>)))
+ (set! (test-a x) 10)
+ (set! (test-b x) 20)
+ (list (test-a x) (test-b x))))
+
+ (pass-if-exception "out of range"
+ exception:out-of-range
+ (make <foreign-test> #:a (ash 1 64))))