forked from racket/racket
/
load-handler.rkt
92 lines (78 loc) · 3.57 KB
/
load-handler.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#lang racket/base
(require racket/file
mzlib/compile)
(provide try-load-handler-now)
(module+ main
(try-load-handler-now))
(define (try-load-handler-now)
;; Check a load handler's treatment of the "expected module" argument.
(define tmp-dir (build-path (find-system-path 'temp-dir) "lhm"))
(define tmp-file-name "m.rkt")
(define tmp-file (build-path tmp-dir tmp-file-name))
(make-directory* tmp-dir)
(with-output-to-file tmp-file
#:exists 'truncate/replace
(lambda ()
(write '(module m racket/base
(define m 'm) ; errors on redeclaration
(provide m)
(module* alpha racket/base
(define a 'a)
(provide a))
(module* beta racket/base
(define b 'b)
(provide b))))))
(when (directory-exists? (build-path tmp-dir "compiled"))
(delete-directory/files (build-path tmp-dir "compiled")))
(define (do-test a b where)
(unless (equal? a b)
(error 'failed
"~a expected: ~e got: ~e"
where a b)))
(define-syntax-rule (test a b)
(do-test a b 'b))
(parameterize ([current-namespace (make-base-namespace)])
(test 'm (dynamic-require tmp-file 'm))
;; From source, all modules get declared:
(test #t (module-declared? tmp-file #f))
(test #t (module-declared? `(submod ,tmp-file alpha) #f))
(test #t (module-declared? `(submod ,tmp-file beta) #f))
(test #f (module-declared? `(submod ,tmp-file other) #f))
(test #f (module-declared? `(submod ,tmp-file other) #t))
;; Requires should succeed:
(test 'a (dynamic-require `(submod ,tmp-file alpha) 'a))
(test 'b (dynamic-require `(submod ,tmp-file beta) 'b)))
(parameterize ([current-namespace (make-base-namespace)])
(void (compile-file tmp-file)))
(parameterize ([current-namespace (make-base-namespace)])
(test 'm (dynamic-require tmp-file 'm))
;; From bytecode, modules get declared only on demand:
(test #t (module-declared? tmp-file #f))
(test #f (module-declared? `(submod ,tmp-file alpha) #f))
(test #f (module-declared? `(submod ,tmp-file beta) #f))
(test #f (module-declared? `(submod ,tmp-file other) #f))
(test #f (module-declared? `(submod ,tmp-file other) #t))
;; Requires should succeed:
(test 'a (dynamic-require `(submod ,tmp-file alpha) 'a))
(test #t (module-declared? `(submod ,tmp-file alpha) #f))
(test #f (module-declared? `(submod ,tmp-file beta) #f))
(test 'b (dynamic-require `(submod ,tmp-file beta) 'b))
(test #t (module-declared? `(submod ,tmp-file beta) #f)))
(parameterize ([current-namespace (make-base-namespace)])
;; eval compiled code directly:
(parameterize ([current-module-declare-name (make-resolved-module-path (build-path tmp-dir tmp-file-name))]
[read-accept-compiled #t])
(with-input-from-file (build-path tmp-dir "compiled" (path-add-suffix tmp-file-name #".zo"))
(lambda () (eval (read)))))
;; It's as if we read from source:
(test 'm (dynamic-require tmp-file 'm))
;; From source, all modules get declared:
(test #t (module-declared? tmp-file #f))
(test #t (module-declared? `(submod ,tmp-file alpha) #f))
(test #t (module-declared? `(submod ,tmp-file beta) #f))
(test #f (module-declared? `(submod ,tmp-file other) #f))
(test #f (module-declared? `(submod ,tmp-file other) #t))
;; Requires should succeed:
(test 'a (dynamic-require `(submod ,tmp-file alpha) 'a))
(test 'b (dynamic-require `(submod ,tmp-file beta) 'b)))
(delete-directory/files tmp-dir))