suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix scheme_basic_env() reset behavior

Browse Source 
Also, fix test to that it DrDr will run it.
This commit is contained in:
Matthew Flatt 2012-01-02 11:17:52 +01:00
parent 03808d245c
commit 2b2c44774f
5 changed files with 77 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/racket/embed-in-c.c
View File

@ -20,7 +20,7 @@ static int run(Scheme_Env *e, int argc, char *argv[])
scheme_set_collects_path(scheme_make_path(MZ_COLLECTION_PATH));
scheme_init_collection_paths(e, scheme_null);
v = scheme_intern_symbol("scheme/base");
v = scheme_intern_symbol("racket/base");
scheme_namespace_require(v);
config = scheme_current_config();
@ -43,11 +43,11 @@ static int run(Scheme_Env *e, int argc, char *argv[])
/* RESET: */
e = scheme_basic_env();
scheme_init_collection_paths(e, scheme_null);
v = scheme_intern_symbol("scheme/base");
v = scheme_intern_symbol("racket/base");
scheme_namespace_require(v);
/* read-eval-print loop, uses initial Scheme_Env: */
a[0] = scheme_intern_symbol("scheme/base");
a[0] = scheme_intern_symbol("racket/base");
a[1] = scheme_intern_symbol("read-eval-print-loop");
v = scheme_dynamic_require(2, a);
scheme_apply(v, 0, NULL);

66
collects/tests/racket/embed-in-c.rkt Normal file
View File

@ -0,0 +1,66 @@
#lang racket
;; Works for Linux.
;; Almost works for Mac OS X.
;; Assumes 3m.
(require racket/system
setup/dirs)
(define-syntax-rule (test expected expr)
(let ([val expr])
(unless (equal? expected val)
(error 'test "failed at ~s: ~e" 'expr val))))
(define dir (collection-path "tests" "racket"))
(define lib-dir (find-lib-dir))
(define (buildinfo def)
(or (and (file-exists? (build-path lib-dir "buildinfo"))
(let ([m (call-with-input-file*
(build-path lib-dir "buildinfo")
(lambda (in)
(regexp-match (regexp (format "(?m:^~a=(.*)$)" def)) in)))])
(and m (cadr m))))
""))
(parameterize ([current-directory dir])
(unless (system (format "cc -c -o embed-in-c.o -DMZ_COLLECTION_PATH='\"~a\"' -I\"~a\" -DMZ_PRECISE_GC ~a embed-in-c.c"
(find-collects-dir)
(find-include-dir)
(buildinfo "CFLAGS")))
(error "compile failed"))
(unless (system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a"
(case (system-type 'link)
[(framework)
(format "-F\"~a\" -framework Racket" lib-dir)]
[(static shared)
(format "-L\"~a\" -lracket3m ~a ~a" lib-dir
(buildinfo "LDFLAGS") (buildinfo "LIBS"))]
[else
(error "unsupported")])))
(error "link failed"))
(let ([o (open-output-bytes)]
[e (open-output-bytes)])
(unless (parameterize ([current-input-port (open-input-bytes #"5\n(log-error \"ouch!\")")]
[current-output-port o]
[current-error-port e])
(system
(format "~a./embed-in-c 1 2 3"
(case (system-type 'link)
[(framework)
(format "env DYLD_FRAMEWORK_PATH=\"~a\" " lib-dir)]
[else ""]))))
(error 'run "failed: ~s" (get-output-bytes e)))
(test #"ouch!\n" (get-output-bytes e))
(test #"1\n2\n3\n> 5\n> > " (get-output-bytes o)))
(let ([maybe-delete-file
(lambda (f) (when (file-exists? f) (delete-file f)))])
(maybe-delete-file "embed-in-c.o")
(maybe-delete-file "embed-in-c")))
(printf "passed\n")

48
collects/tests/racket/embed-in-c.rktl
View File

@ -1,48 +0,0 @@
;; Works for Linux.
;; Almost works for Mac OS X.
;; Assumes 3m.
(load-relative "loadtest.rktl")
(Section 'embed-in-c)
(require scheme/system
setup/dirs)
(define dir (collection-path "tests" "racket"))
(define lib-dir (find-lib-dir))
(parameterize ([current-directory dir])
(test #t system (format "cc -c -o embed-in-c.o -DMZ_COLLECTION_PATH='\"~a\"' -I\"~a\" -DMZ_PRECISE_GC embed-in-c.c"
(find-collects-dir)
(find-include-dir)))
(test #t system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a"
(case (system-type 'link)
[(framework)
(format "-F\"~a\" -framework Racket" lib-dir)]
[(static shared)
(format "-L\"~a\" -lracket3m" lib-dir)]
[else
(error "unsupported")])))
(let ([o (open-output-bytes)]
[e (open-output-bytes)])
(test #t
(lambda (s)
(parameterize ([current-input-port (open-input-bytes #"5\n(log-error \"ouch!\")")]
[current-output-port o]
[current-error-port e])
(system s)))
(format "~a./embed-in-c 1 2 3"
(case (system-type 'link)
[(framework)
(format "env DYLD_FRAMEWORK_PATH=\"~a\" " lib-dir)]
[else ""])))
(test #"ouch!\n" get-output-bytes e)
(test #"1\n2\n3\n> 5\n> > " get-output-bytes o))
(let ([maybe-delete-file
(lambda (f) (when (file-exists? f) (delete-file f)))])
(maybe-delete-file "embed-in-c.o")
(maybe-delete-file "embed-in-c")))

2
src/racket/src/env.c
View File

@ -203,9 +203,7 @@ Scheme_Env *scheme_restart_instance() {
scheme_init_port_fun_config();
scheme_init_error_config();
scheme_init_logger_config();
#ifndef NO_SCHEME_EXNS
scheme_init_exn_config();
#endif
boot_module_resolver();

12
src/racket/src/module.c
View File

@ -417,12 +417,16 @@ void scheme_init_module_resolver(void)
Scheme_Object *o;
Scheme_Config *config;
REGISTER_SO(starts_table);
starts_table = scheme_make_weak_equal_table();
/* this function is called multiple times when scheme_basic_env() is called multiple times */
if (!starts_table) {
REGISTER_SO(starts_table);
starts_table = scheme_make_weak_equal_table();
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
REGISTER_SO(place_local_modpath_table);
place_local_modpath_table = scheme_make_weak_equal_table();
REGISTER_SO(place_local_modpath_table);
place_local_modpath_table = scheme_make_weak_equal_table();
#endif
}
config = scheme_current_config();