Rename and use temporaries
svn: r6310
This commit is contained in:
parent
3dffefe3c0
commit
860069247f
|
@ -1,7 +1,7 @@
|
||||||
(module lang mzscheme
|
(module lang mzscheme
|
||||||
(require-for-syntax (lib "etc.ss")
|
(require-for-syntax (lib "etc.ss")
|
||||||
(lib "list.ss")
|
(lib "list.ss")
|
||||||
"labels.ss"
|
"lang/labels.ss"
|
||||||
"lang/util.ss"
|
"lang/util.ss"
|
||||||
"lang/elim-letrec.ss"
|
"lang/elim-letrec.ss"
|
||||||
"lang/anormal.ss"
|
"lang/anormal.ss"
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
(module labels mzscheme
|
(module labels mzscheme
|
||||||
(require (lib "md5.ss")
|
(require (lib "md5.ss")
|
||||||
|
(lib "list.ss")
|
||||||
(lib "etc.ss"))
|
(lib "etc.ss"))
|
||||||
(provide make-labeling
|
(provide make-labeling
|
||||||
delete-tag-list!)
|
delete-tag-list!)
|
||||||
|
@ -24,22 +25,24 @@
|
||||||
(integer->char (add1 (char->integer (string-ref str 0))))
|
(integer->char (add1 (char->integer (string-ref str 0))))
|
||||||
(substring str 1))]))
|
(substring str 1))]))
|
||||||
|
|
||||||
(define tag-file-path (this-expression-source-directory))
|
(define default-file-name (build-path (this-expression-source-directory) ".tag-list"))
|
||||||
(define default-file-name ".tag-list")
|
|
||||||
(define file-system-mutex (make-semaphore 1))
|
(define file-system-mutex (make-semaphore 1))
|
||||||
|
|
||||||
;; read-tag-list: string -> (listof (list bytes string))
|
;; read-tag-list: string -> (listof (list bytes string))
|
||||||
;; read the tag list from the file system
|
;; read the tag list from the file system
|
||||||
(define (read-tag-list filename)
|
(define (read-tag-list filename)
|
||||||
(if (file-exists? (build-path tag-file-path filename))
|
(if (file-exists? filename)
|
||||||
(call-with-input-file (build-path tag-file-path filename)
|
(let ([v (call-with-input-file filename
|
||||||
read)
|
read)])
|
||||||
'()))
|
(if (eof-object? v)
|
||||||
|
empty
|
||||||
|
v))
|
||||||
|
empty))
|
||||||
|
|
||||||
;; save-tag-list!: (listof (list bytes string)) string -> (listof (list bytes string))
|
;; save-tag-list!: (listof (list bytes string)) string -> (listof (list bytes string))
|
||||||
;; save the tag list in the file system
|
;; save the tag list in the file system
|
||||||
(define (save-tag-list! new-list filename)
|
(define (save-tag-list! new-list filename)
|
||||||
(call-with-output-file (build-path tag-file-path filename)
|
(call-with-output-file filename
|
||||||
(lambda (o-port)
|
(lambda (o-port)
|
||||||
(write new-list o-port))
|
(write new-list o-port))
|
||||||
'replace))
|
'replace))
|
||||||
|
@ -49,8 +52,8 @@
|
||||||
(define delete-tag-list!
|
(define delete-tag-list!
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[(filename)
|
[(filename)
|
||||||
(when (file-exists? (build-path tag-file-path filename))
|
(when (file-exists? filename)
|
||||||
(delete-file (build-path tag-file-path filename)))]
|
(delete-file filename))]
|
||||||
[() (delete-tag-list! default-file-name)]))
|
[() (delete-tag-list! default-file-name)]))
|
||||||
|
|
||||||
;; lookup-tag: bytes string -> string
|
;; lookup-tag: bytes string -> string
|
|
@ -2,12 +2,12 @@
|
||||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||||
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
|
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
|
||||||
(lib "etc.ss")
|
(lib "etc.ss")
|
||||||
"../labels.ss")
|
(lib "file.ss")
|
||||||
|
"../lang/labels.ss")
|
||||||
|
|
||||||
|
(require/expose (lib "labels.ss" "web-server" "prototype-web-server" "lang") (add1/string))
|
||||||
|
|
||||||
(require/expose (lib "labels.ss" "web-server" "prototype-web-server") (add1/string))
|
(define THE-TEST-FILENAME (make-temporary-file))
|
||||||
|
|
||||||
(define THE-TEST-FILENAME "labels-test-file")
|
|
||||||
|
|
||||||
(provide labels-tests-suite)
|
(provide labels-tests-suite)
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@
|
||||||
(define l3 (make-labeling #"bar" THE-TEST-FILENAME))
|
(define l3 (make-labeling #"bar" THE-TEST-FILENAME))
|
||||||
(define l4 (make-labeling #"baz" THE-TEST-FILENAME))
|
(define l4 (make-labeling #"baz" THE-TEST-FILENAME))
|
||||||
|
|
||||||
(define race-test-file "race-test-file")
|
(define race-test-file (make-temporary-file))
|
||||||
|
|
||||||
(define (genbytes)
|
(define (genbytes)
|
||||||
(string->bytes/utf-8
|
(string->bytes/utf-8
|
||||||
|
|
Loading…
Reference in New Issue
Block a user