probable fix to PR 8986

svn: r7529
This commit is contained in:
Robby Findler 2007-10-19 16:55:38 +00:00
parent c1f3be1c90
commit e843842c70
5 changed files with 35 additions and 12 deletions

View File

@ -1302,6 +1302,7 @@
(read-curly-brace-as-paren #f)
(read-accept-infix-dot #f)
(print-vector-length #f))))
(define/override (get-transformer-module) #f)
(define/override (default-settings)
(drscheme:language:make-simple-settings #f 'write 'mixed-fraction-e #f #t 'debug))
(define/override (order-manuals x)

View File

@ -878,7 +878,9 @@
(λ (port)
(write `(let () ;; cannot use begin, since it gets flattened to top-level (and re-compiled!)
(,(if use-copy? 'namespace-require/copy 'namespace-require) ',module-language-spec)
(namespace-transformer-require ',transformer-module-language-spec)
,@(if transformer-module-language-spec
(list `(namespace-transformer-require ',transformer-module-language-spec))
(list))
((dynamic-require ',init-code-mod-name 'init-code)))
port))
'truncate
@ -895,7 +897,8 @@
'truncate 'text)))
(let* ([pre-to-be-embedded-module-specs0
(if (equal? module-language-spec transformer-module-language-spec)
(if (or (not transformer-module-language-spec)
(equal? module-language-spec transformer-module-language-spec))
(list module-language-spec)
(list module-language-spec
transformer-module-language-spec))]
@ -1110,7 +1113,8 @@
(if use-copy?
(namespace-require/copy module-spec)
(namespace-require module-spec))
(namespace-transformer-require transformer-module-spec)))))
(when transformer-module-spec
(namespace-transformer-require transformer-module-spec))))))
;; module-based-language-front-end : (port reader -> (-> (union sexp syntax eof)))
;; type reader = type-spec-of-read-syntax (see mz manual for details)

View File

@ -41,7 +41,8 @@
(current-command-line-arguments program-argv)
((if use-require/copy? namespace-require/copy namespace-require)
language-module-spec)
(namespace-transformer-require transformer-module-spec)
(when transformer-module-spec
(namespace-transformer-require transformer-module-spec))
(init-code-proc)

View File

@ -92,6 +92,8 @@
(rename require #%require)
(rename provide #%provide))
(provide-for-syntax syntax-rules)
(define-syntax synrule-in-stx-module-begin
(lambda (stx)
(datum->syntax-object

View File

@ -122,7 +122,9 @@ the settings above should match r5rs
(test-expression "(list 1)" "(1)")
(test-expression "(car (list))" "{bug09.png} car: expects argument of type <pair>; given ()")
(test-expression "argv" "#0()")))
(test-expression "argv" "#0()")
(test-expression "(define-syntax app syntax-case)" "syntax-case: bad syntax in: syntax-case")))
@ -219,7 +221,8 @@ the settings above should match r5rs
(test-expression "(list 1)" "(1)")
(test-expression "(car (list))" "{bug09.png} car: expects argument of type <pair>; given ()")
(test-expression "argv" "#0()")))
(test-expression "argv" "#0()")
(test-expression "(define-syntax app syntax-case)" "syntax-case: bad syntax in: syntax-case")))
@ -323,7 +326,9 @@ the settings above should match r5rs
(test-expression "(car (list))"
"{bug09.png} car: expects argument of type <pair>; given ()")
(test-expression "argv" "{bug09.png} reference to undefined identifier: argv")))
(test-expression "argv" "{bug09.png} reference to undefined identifier: argv")
(test-expression "(define-syntax app syntax-case)"
"compile: bad syntax; reference to top-level identifier is not allowed, because no #%top syntax transformer is bound in: syntax-case")))
;; ;
;
@ -444,7 +449,8 @@ the settings above should match r5rs
(test-expression "argv"
"argv: name is not defined, not a parameter, and not a primitive name"
"reference to an identifier before its definition: argv")))
"reference to an identifier before its definition: argv")
(test-expression "(define-syntax app syntax-case)" "")))
@ -567,7 +573,10 @@ the settings above should match r5rs
(test-expression "argv"
"argv: name is not defined, not a parameter, and not a primitive name"
"reference to an identifier before its definition: argv")))
"reference to an identifier before its definition: argv")
(test-expression "(define-syntax app syntax-case)"
"define-syntax: name is not defined, not a parameter, and not a primitive name")))
@ -680,7 +689,9 @@ the settings above should match r5rs
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "argv"
"argv: name is not defined, not a parameter, and not a primitive name"
"reference to an identifier before its definition: argv")))
"reference to an identifier before its definition: argv")
(test-expression "(define-syntax app syntax-case)"
"define-syntax: name is not defined, not a parameter, and not a primitive name")))
@ -793,7 +804,9 @@ the settings above should match r5rs
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "argv"
"argv: name is not defined, not a parameter, and not a primitive name"
"reference to an identifier before its definition: argv")))
"reference to an identifier before its definition: argv")
(test-expression "(define-syntax app syntax-case)"
"define-syntax: name is not defined, not a parameter, and not a primitive name")))
@ -904,7 +917,9 @@ the settings above should match r5rs
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "argv"
"argv: name is not defined, not a parameter, and not a primitive name"
"reference to an identifier before its definition: argv")))
"reference to an identifier before its definition: argv")
(test-expression "(define-syntax app syntax-case)"
"define-syntax: name is not defined, not a parameter, and not a primitive name")))