diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index 166167a7e7..b892bded20 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -9,3 +9,23 @@ IN: io.mmap.tests [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors + + +[ ] +[ "mmap-empty-file.txt" temp-file touch-file ] unit-test + +! Test for leaking resources bug on Unix +[ ] +[ + 100000 [ + [ + "mmap-empty-file.txt" temp-file [ + drop + ] with-mapped-file + ] [ dup bad-mmap-size? [ drop ] [ rethrow ] if ] recover + ] times + + "asdf" "mmap-asdf-file.txt" temp-file [ ascii set-file-contents ] keep [ + drop + ] with-mapped-file +] unit-test diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 6f2fabb709..1a58471514 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -2,15 +2,20 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors io.files io.files.info io.backend kernel quotations system alien alien.accessors -accessors system vocabs.loader combinators alien.c-types ; +accessors system vocabs.loader combinators alien.c-types +math ; IN: io.mmap TUPLE: mapped-file address handle length disposed ; HOOK: (mapped-file) os ( path length -- address handle ) +ERROR: bad-mmap-size path size ; + : ( path -- mmap ) - [ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep + [ normalize-path ] [ file-info size>> ] bi + dup 0 <= [ bad-mmap-size ] when + [ (mapped-file) ] keep f mapped-file boa ; HOOK: close-mapped-file io-backend ( mmap -- ) diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor index 9325dcd632..0fa8e1151f 100644 --- a/basis/io/mmap/unix/unix.factor +++ b/basis/io/mmap/unix/unix.factor @@ -9,7 +9,7 @@ IN: io.mmap.unix :: mmap-open ( path length prot flags -- alien fd ) [ f length prot flags - path open-r/w |dispose + path open-r/w [ |dispose drop ] keep [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep ] with-destructors ;