From 2b2c44774f74cc05a0cc010cb6e76472a52c8642 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jan 2012 11:17:52 +0100 Subject: [PATCH] fix scheme_basic_env() reset behavior Also, fix test to that it DrDr will run it. --- collects/tests/racket/embed-in-c.c | 6 +-- collects/tests/racket/embed-in-c.rkt | 66 +++++++++++++++++++++++++++ collects/tests/racket/embed-in-c.rktl | 48 ------------------- src/racket/src/env.c | 2 - src/racket/src/module.c | 12 +++-- 5 files changed, 77 insertions(+), 57 deletions(-) create mode 100644 collects/tests/racket/embed-in-c.rkt delete mode 100644 collects/tests/racket/embed-in-c.rktl diff --git a/collects/tests/racket/embed-in-c.c b/collects/tests/racket/embed-in-c.c index 9bc2c4c264..a65ba8bae9 100644 --- a/collects/tests/racket/embed-in-c.c +++ b/collects/tests/racket/embed-in-c.c @@ -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); diff --git a/collects/tests/racket/embed-in-c.rkt b/collects/tests/racket/embed-in-c.rkt new file mode 100644 index 0000000000..7af37c63e8 --- /dev/null +++ b/collects/tests/racket/embed-in-c.rkt @@ -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") + diff --git a/collects/tests/racket/embed-in-c.rktl b/collects/tests/racket/embed-in-c.rktl deleted file mode 100644 index 1341f2f0f7..0000000000 --- a/collects/tests/racket/embed-in-c.rktl +++ /dev/null @@ -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"))) diff --git a/src/racket/src/env.c b/src/racket/src/env.c index 576e4c84b0..9c976b5d2f 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -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(); diff --git a/src/racket/src/module.c b/src/racket/src/module.c index 4f8984a589..f94b5bce8f 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -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();