diff --git a/collects/meta/props b/collects/meta/props index f002d64de9..f731dac699 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1010,6 +1010,7 @@ path/s is either such a string or a list of them. "collects/tests/data" responsible (ryanc) "collects/tests/datalog" responsible (jay) "collects/tests/db" responsible (ryanc) +"collects/tests/db/programs/sl-gc-crash.rkt" drdr:command-line #f "collects/tests/db/programs/web-test.rkt" drdr:command-line #f "collects/tests/deinprogramm" responsible (sperber) "collects/tests/drracket" responsible (robby) drdr:random #t diff --git a/collects/tests/db/programs/sl-gc-crash.rkt b/collects/tests/db/programs/sl-gc-crash.rkt new file mode 100644 index 0000000000..18db92e8a6 --- /dev/null +++ b/collects/tests/db/programs/sl-gc-crash.rkt @@ -0,0 +1,64 @@ +#lang racket +(require ffi/unsafe/define + ffi/unsafe) + +#| +Open this program in DrRacket. +Click Run and then eval (collect-garbage) in the interaction area. +Repeat a few times, and eventually DrRacket will crash with a +segmentation fault. + +No crash in 5.1, 5.1.1 +Crashes in 5.2, 5.2.1, 5.3, 5.3.1.1 + +git bisect says introduced here: 2ada6d0e89a763f3b8523a87e580b1ffb25430eb +|# + +;; NOTE: make sure file exists by running "touch $filename" +(define filename #"/tmp/my.db") + +;; set NEXT-STMT? for another variation of the test, which does actually +;; seem to invoke the proper function, unlike sqlite3_close (???) +(define NEXT-STMT? #f) + +(define-ffi-definer define-sqlite + (ffi-lib "libsqlite3" '("0" #f))) + +(define-cpointer-type _sqlite3_database) +(define-cpointer-type _sqlite3_statement) + +(define SQLITE_OPEN_READWRITE #x00000002) + +(define-sqlite sqlite3_open_v2 + (_fun (filename flags) :: + (filename : _bytes) + (db : (_ptr o _sqlite3_database)) + (flags : _int) + (vfs : _pointer = #f) + -> (result : _int) + -> (values db result))) + +(define-sqlite sqlite3_close + (_fun _sqlite3_database + -> _int)) + +(define-sqlite sqlite3_next_stmt + (_fun _sqlite3_database _sqlite3_statement/null -> _sqlite3_statement/null)) + +(define c% + (class object% + (super-new) + + (define-values (db status) + (sqlite3_open_v2 filename SQLITE_OPEN_READWRITE)) + + (unless (zero? status) + (eprintf "open got ~s\n" status)) + + (define/public (finalize!) + (when NEXT-STMT? (sqlite3_next_stmt db #f)) + (sqlite3_close db)) + )) + +(define p (new c%)) +(register-finalizer p (lambda (v) (send v finalize!)))