mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source 
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
This commit is contained in:
Andy Wingo 2014-04-28 18:51:21 +02:00
commit d7a67c3e91
35 changed files with 1488 additions and 1322 deletions
Download patch file Download diff file Expand all files Collapse all files

43
test-suite/tests/goops.test
View file

@ -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))))