(load-extension "cpp11_std_unique_ptr.so") (require (lib "defmacro.ss")) ; Copied from ../schemerunme/cpp11_std_unique_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) ; unique_ptr as input (define kin (new-Klass "KlassInput")) (checkCount 1) (define s (takeKlassUniquePtr 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 (takeKlassUniquePtr 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)))]) (takeKlassUniquePtr kin)) (unless (string=? exception_thrown "takeKlassUniquePtr: 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)))]) (takeKlassUniquePtr notowned)) (unless (string=? exception_thrown "takeKlassUniquePtr: 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 (takeKlassUniquePtr 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 '()) (takeKlassUniquePtr null) (takeKlassUniquePtr (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) ; unique_ptr as output (define k1 (makeKlassUniquePtr "first")) (define k2 (makeKlassUniquePtr "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? (makeNullUniquePtr)) (error "null failure")) (exit 0)