adding guards around reading modules.
This commit is contained in:
parent
89d485ed29
commit
1447b39167
|
@ -11,6 +11,7 @@
|
||||||
"../parser/parse-bytecode.rkt"
|
"../parser/parse-bytecode.rkt"
|
||||||
"../resource/structs.rkt"
|
"../resource/structs.rkt"
|
||||||
"../promise.rkt"
|
"../promise.rkt"
|
||||||
|
"../get-module-bytecode.rkt"
|
||||||
(prefix-in hash-cache: "hash-cache.rkt")
|
(prefix-in hash-cache: "hash-cache.rkt")
|
||||||
racket/match
|
racket/match
|
||||||
racket/list
|
racket/list
|
||||||
|
@ -19,6 +20,8 @@
|
||||||
racket/path
|
racket/path
|
||||||
racket/string
|
racket/string
|
||||||
racket/port
|
racket/port
|
||||||
|
syntax/modread
|
||||||
|
syntax/kerncase
|
||||||
(prefix-in query: "../lang/js/query.rkt")
|
(prefix-in query: "../lang/js/query.rkt")
|
||||||
(prefix-in resource-query: "../resource/query.rkt")
|
(prefix-in resource-query: "../resource/query.rkt")
|
||||||
(prefix-in runtime: "get-runtime.rkt")
|
(prefix-in runtime: "get-runtime.rkt")
|
||||||
|
@ -92,6 +95,61 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;; check-valid-source: Source -> void
|
||||||
|
;; Check to see if the file, if a module, is a valid module file.
|
||||||
|
(define (check-valid-source src)
|
||||||
|
(cond
|
||||||
|
[(StatementsSource? src)
|
||||||
|
(void)]
|
||||||
|
[(MainModuleSource? src)
|
||||||
|
(check-valid-module-source (MainModuleSource-path src))]
|
||||||
|
[(ModuleSource? src)
|
||||||
|
(check-valid-module-source (ModuleSource-path src))]
|
||||||
|
[(SexpSource? src)
|
||||||
|
(void)]
|
||||||
|
[(UninterpretedSource? src)
|
||||||
|
(void)]))
|
||||||
|
|
||||||
|
(define (check-valid-module-source module-source-path)
|
||||||
|
;; Check that the file exists.
|
||||||
|
(unless (file-exists? module-source-path)
|
||||||
|
(printf "Can't read a Racket module from ~e. The file does not appear to exist.\n"
|
||||||
|
module-source-path)
|
||||||
|
(error 'check-valid-module-source))
|
||||||
|
|
||||||
|
;; Check that it looks like a module.
|
||||||
|
(define stx
|
||||||
|
(with-handlers ([exn:fail?
|
||||||
|
(lambda (exn)
|
||||||
|
;; We can't even get the bytecode for the file.
|
||||||
|
;; Fail immediately.
|
||||||
|
(printf "Can't read a Racket module from ~e. The file may be ill-formed.\n"
|
||||||
|
module-source-path)
|
||||||
|
(printf "\nFor reference, the error message produced when trying to read ~e is:\n\n" module-source-path)
|
||||||
|
(printf "~a\n" (exn-message exn))
|
||||||
|
(error 'check-valid-module-source))])
|
||||||
|
(parameterize ([read-accept-reader #t])
|
||||||
|
(call-with-input-file* module-source-path
|
||||||
|
(lambda (ip)
|
||||||
|
(read-syntax #f ip))))))
|
||||||
|
|
||||||
|
(define language-stx
|
||||||
|
(kernel-syntax-case stx #t
|
||||||
|
[(module name language body ...)
|
||||||
|
#'language]
|
||||||
|
[else
|
||||||
|
(printf "Can't read a Racket module from ~e.\nThe file exists, but does not appear to be a Racket module.\n"
|
||||||
|
module-source-path)
|
||||||
|
(error 'check-valid-module-source)]))
|
||||||
|
|
||||||
|
;; Check that the module is written in a language that we allow.
|
||||||
|
(displayln language-stx)
|
||||||
|
(void))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; source-is-javascript-module?: Source -> boolean
|
;; source-is-javascript-module?: Source -> boolean
|
||||||
;; Returns true if the source looks like a Javascript-implemented module.
|
;; Returns true if the source looks like a Javascript-implemented module.
|
||||||
(define (source-is-javascript-module? src)
|
(define (source-is-javascript-module? src)
|
||||||
|
@ -256,6 +314,9 @@ M.modules[~s] =
|
||||||
;; Translate all JavaScript-implemented sources into uninterpreted sources;
|
;; Translate all JavaScript-implemented sources into uninterpreted sources;
|
||||||
;; we'll leave its interpretation to on-visit-src.
|
;; we'll leave its interpretation to on-visit-src.
|
||||||
(define (wrap-source src)
|
(define (wrap-source src)
|
||||||
|
(log-debug "Checking valid source")
|
||||||
|
(check-valid-source src)
|
||||||
|
|
||||||
(log-debug "Checking if the source has a JavaScript implementation")
|
(log-debug "Checking if the source has a JavaScript implementation")
|
||||||
(cond
|
(cond
|
||||||
[(source-is-javascript-module? src)
|
[(source-is-javascript-module? src)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user