From 874c0331c3903602314e87062a1bea7300b854f8 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 7 Apr 2007 02:23:36 +0000 Subject: [PATCH] do what you can when not in 3m svn: r5878 --- collects/mzlib/sandbox.ss | 4 +++- collects/tests/mzscheme/sandbox.ss | 9 +++++---- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/collects/mzlib/sandbox.ss b/collects/mzlib/sandbox.ss index 580742731f..868e9ffdef 100644 --- a/collects/mzlib/sandbox.ss +++ b/collects/mzlib/sandbox.ss @@ -173,12 +173,14 @@ (define-struct (exn:fail:resource exn:fail) (resource)) + (define 3m? (eq? '3m (system-type 'gc))) + (define (call-with-limits sec mb thunk) (let ([cust (make-custodian)] [ch (make-channel)] ;; use this to copy parameter changes from the sub-thread [p current-preserved-thread-cell-values]) - (when mb (custodian-limit-memory cust (* mb 1024 1024) cust)) + (when (and mb 3m?) (custodian-limit-memory cust (* mb 1024 1024) cust)) (let* ([work (parameterize ([current-custodian cust]) (thread (lambda () (channel-put ch diff --git a/collects/tests/mzscheme/sandbox.ss b/collects/tests/mzscheme/sandbox.ss index 75b300b87b..5d159cca68 100644 --- a/collects/tests/mzscheme/sandbox.ss +++ b/collects/tests/mzscheme/sandbox.ss @@ -56,7 +56,10 @@ (id 1) => 1 (id (plus1 x)) => 1 (loop) =err> "out of time" - (memory 1000000) =err> "out of memory" + --top-- + (when (eq? '3m (system-type 'gc)) + (t --eval-- (memory 1000000) =err> "out of memory")) + --eval-- (printf "x = ~s\n" x) => (void) ,eof =err> "terminated" x =err> "terminated" @@ -266,6 +269,4 @@ (set! y 789) ; would be an error without the `set!' parameter y => 789 - ) - - ) + ))