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

fix too-early large-allocation check

Browse Source 
Closes PR 12000
This commit is contained in:
Matthew Flatt 2011-06-30 08:56:28 -06:00
parent 0025ff968d
commit 737a3bd91a
2 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/tests/racket/long-cmdline.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang racket/base
(require racket/system)
(let ([p (find-executable-path (find-system-path 'exec-file))])
(let ([s (open-output-bytes)])
(parameterize ([current-output-port s])
(apply system* p "-e" "'done" (for/list ([i 8192]) "x")))
(unless (equal? (get-output-bytes s) #"'done\n")
(error "test failed"))))

6
src/racket/gc2/mem_account.c
View File

@ -622,7 +622,11 @@ int BTC_single_allocation_limit(NewGC *gc, size_t sizeb) {
* is much smaller than the actual available memory, and as long as * is much smaller than the actual available memory, and as long as
* GC_out_of_memory protects any user-requested allocation whose size * GC_out_of_memory protects any user-requested allocation whose size
* is independent of any existing object, then we can enforce the limit. */ * is independent of any existing object, then we can enforce the limit. */
return (custodian_single_time_limit(gc, thread_get_owner(scheme_current_thread)) < sizeb); Scheme_Thread *p = scheme_current_thread;
if (p)
return (custodian_single_time_limit(gc, thread_get_owner(p)) < sizeb);
else
return 0;
} }
static inline void BTC_clean_up(NewGC *gc) { static inline void BTC_clean_up(NewGC *gc) {