parent
60129ffaca
commit
5b66a2e590
46
pkgs/racket-test/tests/racket/rerequire.rkt
Normal file
46
pkgs/racket-test/tests/racket/rerequire.rkt
Normal file
|
@ -0,0 +1,46 @@
|
||||||
|
#lang racket
|
||||||
|
(require racket/file
|
||||||
|
racket/rerequire)
|
||||||
|
|
||||||
|
(define dir (make-temporary-file "rereq-~a" 'directory))
|
||||||
|
|
||||||
|
(display-to-file
|
||||||
|
(string-append
|
||||||
|
"#lang racket/base\n"
|
||||||
|
"(module inner racket/base\n"
|
||||||
|
" (require \"two.rkt\")\n"
|
||||||
|
" (provide proc))\n"
|
||||||
|
"(module more-inner racket/base\n"
|
||||||
|
" (require (submod \"..\" inner))\n"
|
||||||
|
" (provide proc))\n"
|
||||||
|
"(require 'more-inner)\n"
|
||||||
|
"(provide proc)")
|
||||||
|
(build-path dir "one.rkt")
|
||||||
|
#:exists 'replace)
|
||||||
|
|
||||||
|
(define (change-required-file path proc-value)
|
||||||
|
(display-to-file
|
||||||
|
(string-append
|
||||||
|
"#lang racket/base\n"
|
||||||
|
"(module other racket/base)\n"
|
||||||
|
"(provide proc)\n"
|
||||||
|
(format "(define (proc) ~v)" proc-value))
|
||||||
|
(build-path dir path)
|
||||||
|
#:exists 'replace)
|
||||||
|
(sleep 1) ; to make sure mod time changes so rerequire notices it
|
||||||
|
(file-or-directory-modify-seconds
|
||||||
|
(build-path dir path)
|
||||||
|
(current-seconds)))
|
||||||
|
|
||||||
|
;; create "two.rkt" with `proc` function that evaluates to "foo"
|
||||||
|
(change-required-file "two.rkt" "foo")
|
||||||
|
;; even though "two.rkt" is inside a submodule, rerequire will transitively load it the first time
|
||||||
|
(unless (member (build-path dir "two.rkt")
|
||||||
|
(dynamic-rerequire (build-path dir "one.rkt")))
|
||||||
|
(error "failed on round"))
|
||||||
|
;; change "two.rkt"
|
||||||
|
(change-required-file "two.rkt" "zam")
|
||||||
|
;; this will error: rerequire should transitively reload "two.rkt", but doesn't
|
||||||
|
(when (empty? (dynamic-rerequire (build-path dir "one.rkt")
|
||||||
|
#:verbosity 'none))
|
||||||
|
(error "failed on second round"))
|
|
@ -61,13 +61,25 @@
|
||||||
[path (normal-case-path (simplify-path path))])
|
[path (normal-case-path (simplify-path path))])
|
||||||
;; Record module timestamp and dependencies:
|
;; Record module timestamp and dependencies:
|
||||||
(define-values (ts actual-path) (get-timestamp path))
|
(define-values (ts actual-path) (get-timestamp path))
|
||||||
|
(define (code->dependencies code)
|
||||||
|
(apply append
|
||||||
|
(map cdr (module-compiled-imports code))))
|
||||||
(let ([a-mod (mod name
|
(let ([a-mod (mod name
|
||||||
ts
|
ts
|
||||||
(if code
|
(if code
|
||||||
(apply append
|
(code->dependencies code)
|
||||||
(map cdr (module-compiled-imports code)))
|
|
||||||
null))])
|
null))])
|
||||||
(hash-set! loaded path a-mod))
|
(hash-set! loaded path a-mod)
|
||||||
|
;; Register all submodules, too; even though we load at the
|
||||||
|
;; file granularity, we need submodules for dependencies
|
||||||
|
(when code
|
||||||
|
(let loop ([code code])
|
||||||
|
(for ([submod-code (in-list (append (module-compiled-submodules code #t)
|
||||||
|
(module-compiled-submodules code #f)))])
|
||||||
|
(define name (module-compiled-name submod-code))
|
||||||
|
(hash-set! loaded (cons path (cdr name))
|
||||||
|
(mod name ts (code->dependencies submod-code)))
|
||||||
|
(loop submod-code)))))
|
||||||
;; Evaluate the module:
|
;; Evaluate the module:
|
||||||
(parameterize ([current-module-declare-source actual-path])
|
(parameterize ([current-module-declare-source actual-path])
|
||||||
(eval code))))
|
(eval code))))
|
||||||
|
@ -89,17 +101,30 @@
|
||||||
(define (check-latest mod verbosity path-collector)
|
(define (check-latest mod verbosity path-collector)
|
||||||
(define mpi (module-path-index-join mod #f))
|
(define mpi (module-path-index-join mod #f))
|
||||||
(define done (make-hash))
|
(define done (make-hash))
|
||||||
(let loop ([mpi mpi])
|
(let loop ([mpi mpi] [wrt-mpi #f] [wrt-path #f])
|
||||||
(define rpath (module-path-index-resolve mpi))
|
(define rpath (module-path-index-resolve mpi))
|
||||||
(define path (let ([p (resolved-module-path-name rpath)])
|
(define name (resolved-module-path-name rpath))
|
||||||
(if (pair? p) (car p) p)))
|
(define path (if (pair? name)
|
||||||
|
(let ([path (car name)])
|
||||||
|
(if (and (symbol? path)
|
||||||
|
;; If the code was compiled from source, then the
|
||||||
|
;; "self" modidx may be reported for a submodule
|
||||||
|
;; import, so manually resolve to `wrt-path`:
|
||||||
|
(self-modidx-base? mpi))
|
||||||
|
wrt-path
|
||||||
|
path))
|
||||||
|
name))
|
||||||
(when (path? path)
|
(when (path? path)
|
||||||
(define npath (normal-case-path path))
|
(define npath (normal-case-path path))
|
||||||
(unless (hash-ref done npath #f)
|
(define key (if (pair? name)
|
||||||
(hash-set! done npath #t)
|
(cons npath (cdr name))
|
||||||
(define mod (hash-ref loaded npath #f))
|
npath))
|
||||||
|
(unless (hash-ref done key #f)
|
||||||
|
(hash-set! done key #t)
|
||||||
|
(define mod (hash-ref loaded key #f))
|
||||||
(when mod
|
(when mod
|
||||||
(for-each loop (mod-depends mod))
|
(for ([dep-mpi (in-list (mod-depends mod))])
|
||||||
|
(loop dep-mpi mpi path))
|
||||||
(define-values (ts actual-path) (get-timestamp npath))
|
(define-values (ts actual-path) (get-timestamp npath))
|
||||||
(when (ts . > . (mod-timestamp mod))
|
(when (ts . > . (mod-timestamp mod))
|
||||||
(define orig (current-load/use-compiled))
|
(define orig (current-load/use-compiled))
|
||||||
|
@ -109,3 +134,16 @@
|
||||||
[current-module-declare-source actual-path])
|
[current-module-declare-source actual-path])
|
||||||
((rerequire-load/use-compiled orig #t verbosity path-collector)
|
((rerequire-load/use-compiled orig #t verbosity path-collector)
|
||||||
npath (mod-name mod)))))))))
|
npath (mod-name mod)))))))))
|
||||||
|
|
||||||
|
;; Is `mpi` a submod relative to "self"?
|
||||||
|
(define (self-modidx-base? mpi)
|
||||||
|
(define-values (mp base) (module-path-index-split mpi))
|
||||||
|
(cond
|
||||||
|
[(and base
|
||||||
|
(pair? mp)
|
||||||
|
(eq? (car mp) 'submod)
|
||||||
|
(member (cadr mp) '("." "..")))
|
||||||
|
(define-values (base-base base-path) (module-path-index-split base))
|
||||||
|
(or (and (not base-base) (not base-path))
|
||||||
|
(self-modidx-base? base))]
|
||||||
|
[else #f]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user