1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(load-extension "li_std_auto_ptr.so")
(require (lib "defmacro.ss"))
; Copied from ../schemerunme/li_std_auto_ptr.scm and modified for exceptions
; Define an equivalent to Guile's gc procedure
(define-macro (gc)
`(collect-garbage 'major))
(define checkCount
(lambda (expected-count)
(define actual-count (Klass-getTotal-count))
(unless (= actual-count expected-count) (error (format "Counts incorrect, expected:~a actual:~a" expected-count actual-count)))))
; Test raw pointer handling involving virtual inheritance
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (useKlassRawPtr kini))
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(set! kini '()) (gc)
(checkCount 0)
; auto_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassAutoPtr kin))
(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(set! kin '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(define notowned (get-not-owned-ptr kin))
(set! exception_thrown "no exception thrown for notowned")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassAutoPtr notowned))
(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kini))
(checkCount 0)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(unless (is-nullptr kini)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define null '())
(takeKlassAutoPtr null)
(takeKlassAutoPtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (overloadTest) 0)
(error "overloadTest failed"))
(unless (= (overloadTest null) 1)
(error "overloadTest failed"))
(unless (= (overloadTest (new-Klass "over")) 1)
(error "overloadTest failed"))
(checkCount 0)
; auto_ptr as output
(define k1 (makeKlassAutoPtr "first"))
(define k2 (makeKlassAutoPtr "second"))
(checkCount 2)
(set! k1 '()) (gc)
(checkCount 1)
(unless (string=? (Klass-getLabel k2) "second")
(error "wrong object label" ))
(set! k2 '()) (gc)
(checkCount 0)
(unless (null? (makeNullAutoPtr))
(error "null failure"))
(exit 0)
|
