expander: make cache accomodate optional directory path terminator
The cache is sensitive to `current-load-relative-directory`, but normalize with `path->directory-path`.
This commit is contained in:
parent
629153c4e0
commit
4525c231a7
|
@ -1073,10 +1073,9 @@
|
|||
(define am-s (compile-m (a-expr #t) '()))
|
||||
(define b-s (compile-m b-expr (list a-s)))
|
||||
|
||||
(define temp-dir (find-system-path 'temp-dir))
|
||||
(define temp-dir (make-temporary-file "comp~a" 'directory))
|
||||
(define dir (build-path temp-dir (car (use-compiled-file-paths))))
|
||||
(define dir-existed? (directory-exists? dir))
|
||||
(unless dir-existed? (make-directory* dir))
|
||||
(make-directory* dir)
|
||||
|
||||
(define (go a-s)
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
|
@ -1091,8 +1090,7 @@
|
|||
;; Check that we don't crash when trying to use a different `a':
|
||||
(err/rt-test (go am-s) exn:fail?)
|
||||
;; Cleanup
|
||||
(delete-file (build-path dir "check-gen_rkt.zo"))
|
||||
(unless dir-existed? (delete-directory dir)))
|
||||
(delete-directory/files temp-dir))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -1425,7 +1423,7 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
[else (error "unknown")]))
|
||||
|
||||
(let ()
|
||||
(define dir (find-system-path 'temp-dir))
|
||||
(define dir (make-temporary-file "tmx~a" 'directory))
|
||||
(define tmx (build-path dir "tmx.rkt"))
|
||||
(define e (compile '(module tmx racket/base
|
||||
(module s racket/base
|
||||
|
@ -1454,11 +1452,11 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
(dynamic-require tmx #f)
|
||||
(test #f module-declared? `(submod ,tmx s) #f)
|
||||
(test 1 dynamic-require `(submod ,tmx s) 'x))
|
||||
(delete-file zo-path))
|
||||
(delete-directory/files dir))
|
||||
|
||||
;; Check that module-code caching works
|
||||
(let ()
|
||||
(define dir (find-system-path 'temp-dir))
|
||||
(define dir (make-temporary-file "tmx~a" 'directory))
|
||||
(define tmx (build-path dir "tmx2.rkt"))
|
||||
(define e (compile '(module tmx2 racket/kernel
|
||||
(#%provide x)
|
||||
|
@ -1483,7 +1481,6 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
[current-load-relative-directory dir])
|
||||
(eval (parameterize ([read-accept-compiled #t])
|
||||
(read (open-input-bytes bstr)))))
|
||||
|
||||
;; Mangle the bytecode file; cached variant should be used:
|
||||
(call-with-output-file zo-path
|
||||
#:exists 'update
|
||||
|
@ -1492,12 +1489,15 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
(write-bytes (make-bytes 100 (char->integer #\!)) o)))
|
||||
|
||||
(test 2 add1
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[current-load-relative-directory dir])
|
||||
(dynamic-require tmx 'x)))
|
||||
(delete-file zo-path)
|
||||
|
||||
;; Need to retain the namespace until here
|
||||
(ephemeron-value (make-ephemeron first-namespace 7) first-namespace))
|
||||
(ephemeron-value (make-ephemeron first-namespace 7) first-namespace)
|
||||
|
||||
(delete-directory/files dir))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check that `provide` doesn't run enclosed expanders until within a
|
||||
|
|
60
pkgs/racket-test-core/tests/racket/parallel.rkt
Normal file
60
pkgs/racket-test-core/tests/racket/parallel.rkt
Normal file
|
@ -0,0 +1,60 @@
|
|||
#lang racket/base
|
||||
(require racket/place)
|
||||
|
||||
;; Runs multiple places perfoming the test suite simultaneously. Each
|
||||
;; place creates a directory sub<n> to run in, so that filesystem
|
||||
;; tests don't collide.
|
||||
|
||||
;; Note that the old "parallel.rktl" runs multiple threads instead of
|
||||
;; multiple places.
|
||||
|
||||
(define (go)
|
||||
(place
|
||||
pch
|
||||
(define n (place-channel-get pch))
|
||||
(define quiet (place-channel-get pch))
|
||||
(define all (place-channel-get pch))
|
||||
(let ([ns (make-base-namespace)]
|
||||
[eh (exit-handler)]
|
||||
[ql all])
|
||||
(parameterize ([current-namespace ns])
|
||||
(namespace-require '(lib "racket/init"))
|
||||
(eval `(define Section-prefix ,(format "~a:" n)))
|
||||
(when ql
|
||||
(eval `(define quiet-load (quote ,ql))))
|
||||
(let ([dirname (path->complete-path (format "sub~s" n))])
|
||||
(when (directory-exists? dirname)
|
||||
(delete-directory* dirname))
|
||||
(make-directory dirname)
|
||||
(current-directory dirname)
|
||||
(load quiet)
|
||||
(current-directory (build-path dirname 'up))
|
||||
(delete-directory* dirname))))))
|
||||
|
||||
(define (delete-directory* dir)
|
||||
(for-each (lambda (f)
|
||||
(let ([f (build-path dir f)])
|
||||
(if (or (link-exists? f) (file-exists? f))
|
||||
(delete-file f)
|
||||
(delete-directory* f))))
|
||||
(directory-list dir))
|
||||
(delete-directory dir))
|
||||
|
||||
(module+ main
|
||||
(define (parallel n quiet all)
|
||||
(define places
|
||||
(for/list ([i n])
|
||||
(define p (go))
|
||||
(place-channel-put p i)
|
||||
(place-channel-put p quiet)
|
||||
(place-channel-put p all)
|
||||
p))
|
||||
(for-each place-wait places))
|
||||
|
||||
(parallel 3
|
||||
(path->complete-path "quiet.rktl")
|
||||
(path->complete-path "all.rktl"))
|
||||
(exit 0))
|
||||
|
||||
(module+ test
|
||||
(require (submod ".." main)))
|
|
@ -3,6 +3,9 @@
|
|||
;; thread creates a directory sub<n> to run in, so that filesystem
|
||||
;; tests don't collide.
|
||||
|
||||
;; Note that the newer "parallel.rktl" runs multiple places instead
|
||||
;; of multiple threads.
|
||||
|
||||
(namespace-variable-value 'parallel-load #f
|
||||
(lambda ()
|
||||
(namespace-set-variable-value! 'parallel-load "quiet.rktl")))
|
||||
|
|
|
@ -3,8 +3,10 @@
|
|||
|
||||
(Section 'parameters)
|
||||
|
||||
(require racket/file)
|
||||
|
||||
(define temp-compiled-file
|
||||
(path->string (build-path (find-system-path 'temp-dir) "param-temp-file")))
|
||||
(path->string (make-temporary-file "param-temp-file~a")))
|
||||
|
||||
(let ([p (open-output-file temp-compiled-file #:exists 'replace)])
|
||||
(display (compile '(cons 1 2)) p)
|
||||
|
|
|
@ -978,7 +978,7 @@
|
|||
;; Text mode, file positions, and buffers
|
||||
|
||||
(let ()
|
||||
(define path (build-path (find-system-path 'temp-dir) "test.txt"))
|
||||
(define path (make-temporary-file "test~a.txt"))
|
||||
|
||||
(define ofile (open-output-file path #:mode 'text #:exists 'replace))
|
||||
(fprintf ofile "abc\ndef\nghi\n")
|
||||
|
|
|
@ -3,6 +3,8 @@
|
|||
|
||||
(Section 'submodule)
|
||||
|
||||
(require racket/file)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(test #t module-path? '(submod "."))
|
||||
|
@ -634,10 +636,7 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Directory for testing
|
||||
|
||||
(define temp-dir
|
||||
(build-path (find-system-path 'temp-dir)
|
||||
(format "submodule-tests-~s" (current-seconds))))
|
||||
(make-directory temp-dir)
|
||||
(define temp-dir (make-temporary-file "submodule-tests-~s" 'directory))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check submodule resolution of relative paths:
|
||||
|
@ -700,11 +699,7 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Delete the temp-dir
|
||||
|
||||
(let loop ([x temp-dir])
|
||||
(cond [(file-exists? x) (delete-file x)]
|
||||
[(directory-exists? x) (parameterize ([current-directory x])
|
||||
(for-each loop (directory-list)))
|
||||
(delete-directory x)]))
|
||||
(delete-directory/files temp-dir)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Module attach
|
||||
|
|
|
@ -38628,7 +38628,10 @@ static const char *startup_source =
|
|||
"(define-values"
|
||||
"(make-module-cache-key)"
|
||||
"(lambda(hash-code_0)"
|
||||
" (begin (if hash-code_0 (string->symbol (format \"~s\" (list hash-code_0 (current-load-relative-directory)))) #f))))"
|
||||
"(begin"
|
||||
"(if hash-code_0"
|
||||
" (string->symbol (format \"~s\" (list hash-code_0 (path->directory-path (current-load-relative-directory)))))"
|
||||
" #f))))"
|
||||
"(define-values"
|
||||
"(module-cache-set!)"
|
||||
"(lambda(key_0 proc_0)(begin(hash-set!(unsafe-place-local-ref cell.1$3) key_0(make-ephemeron key_0 proc_0)))))"
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -28,7 +28,8 @@
|
|||
(and hash-code
|
||||
;; Encode as a symbol so we can use an eq?-based hash table
|
||||
;; (i.e., explot the low-level lock on the symbol table)
|
||||
(string->symbol (format "~s" (list hash-code (current-load-relative-directory))))))
|
||||
(string->symbol (format "~s" (list hash-code (path->directory-path
|
||||
(current-load-relative-directory)))))))
|
||||
|
||||
(define (module-cache-set! key proc)
|
||||
(hash-set! module-cache key (make-ephemeron key proc)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user