diff options
author | Andy Wingo <wingo@pobox.com> | 2014-04-28 18:51:21 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-04-28 18:51:21 +0200 |
commit | d7a67c3e918acd8ca46dc7792a8ca98b33cb94e8 (patch) | |
tree | 7ccf125978778d1ac6bb656245305c76db8e02d0 /test-suite/tests | |
parent | 475772ea57c97d0fa0f9ed9303db137d9798ddd3 (diff) | |
parent | 4338f2f91e1dd63a40384077d091295d90047926 (diff) | |
download | guile-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.test | 43 |
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)))) |