diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 6b60ee2133..f4d0147280 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -202,7 +202,10 @@ M: output-port dispose* ] with-destructors ; M: buffered-port dispose* - [ call-next-method ] [ buffer>> dispose ] bi ; + [ + [ buffer>> &dispose drop ] + [ call-next-method ] bi + ] with-destructors ; M: port cancel-operation handle>> cancel-operation ; diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index ca7ba0cd49..49b9820574 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/basis/io/sockets/secure/openssl/openssl.factor @@ -133,10 +133,12 @@ M: openssl ( config -- context ) ] with-destructors ; M: openssl-context dispose* - [ aliens>> [ free ] each ] - [ sessions>> values [ SSL_SESSION_free ] each ] - [ handle>> SSL_CTX_free ] - tri ; + [ + [ aliens>> [ &free drop ] each ] + [ sessions>> values [ SSL_SESSION_free ] each ] + [ handle>> SSL_CTX_free ] + tri + ] with-destructors ; TUPLE: ssl-handle < disposable file handle connected ; @@ -150,13 +152,19 @@ SYMBOL: default-secure-context ] unless* ; : ( fd -- ssl ) - ssl-handle new-disposable - current-secure-context handle>> SSL_new - dup ssl-error >>handle - swap >>file ; + [ + ssl-handle new-disposable |dispose + current-secure-context handle>> SSL_new + dup ssl-error >>handle + swap >>file + ] with-destructors ; M: ssl-handle dispose* - [ handle>> SSL_free ] [ file>> dispose ] bi ; + [ + ! Free file>> after SSL_free + [ file>> &dispose drop ] + [ handle>> SSL_free ] bi + ] with-destructors ; : check-verify-result ( ssl-handle -- ) SSL_get_verify_result dup X509_V_OK = diff --git a/basis/io/sockets/secure/unix/unix-tests.factor b/basis/io/sockets/secure/unix/unix-tests.factor index d8619d9bac..e6759109b9 100644 --- a/basis/io/sockets/secure/unix/unix-tests.factor +++ b/basis/io/sockets/secure/unix/unix-tests.factor @@ -65,10 +65,11 @@ io.sockets.secure.debug ; [ ] [ [ - "127.0.0.1" 0 ascii [ - dup addr>> port>> "port" get fulfill - accept drop 1 minutes sleep dispose - ] with-disposal + [ + "127.0.0.1" 0 ascii &dispose + dup addr>> port>> "port" get fulfill + accept drop &dispose 1 minutes sleep + ] with-destructors ] "Silly server" spawn drop ] unit-test @@ -83,18 +84,22 @@ io.sockets.secure.debug ; [ ] [ [ - "127.0.0.1" "port" get ?promise - ascii drop 1 minutes sleep dispose + [ + "127.0.0.1" "port" get ?promise + ascii drop &dispose 1 minutes sleep + ] with-destructors ] "Silly client" spawn drop ] unit-test [ 1 seconds secure-socket-timeout [ [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop dup stream-read1 drop dispose - ] with-disposal + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop &dispose dup stream-read1 drop + ] with-disposal + ] with-destructors ] with-test-context ] with-variable ] [ io-timeout? ] must-fail-with @@ -108,11 +113,13 @@ io.sockets.secure.debug ; [ ] [ [ [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop 1 minutes sleep dispose - ] with-disposal - ] with-test-context + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop &dispose 1 minutes sleep + ] with-disposal + ] with-test-context + ] with-destructors ] "Silly server" spawn drop ] unit-test @@ -131,20 +138,24 @@ io.sockets.secure.debug ; [ ] [ [ [ - "127.0.0.1" "port" get ?promise - ascii drop 1 minutes sleep dispose - ] with-test-context + [ + "127.0.0.1" "port" get ?promise + ascii drop &dispose 1 minutes sleep + ] with-test-context + ] with-destructors ] "Silly client" spawn drop ] unit-test [ - 1 seconds secure-socket-timeout [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop dispose - ] with-disposal - ] with-test-context - ] with-variable + [ + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop &dispose + ] with-disposal + ] with-test-context + ] with-variable + ] with-destructors ] [ io-timeout? ] must-fail-with ] drop