~ chicken-core (chicken-5) 27cd45d410abc0290998c5022adc2655126f2372
commit 27cd45d410abc0290998c5022adc2655126f2372
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Aug 22 18:19:58 2015 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sat Aug 22 19:37:27 2015 +0200
removed code in apply-test that used fixed limit (there is no fixed limit, the limit depends on multiple factors)
Conflicts:
tests/apply-test.scm
diff --git a/tests/apply-test.scm b/tests/apply-test.scm
index b5c1da32..3ec491c5 100644
--- a/tests/apply-test.scm
+++ b/tests/apply-test.scm
@@ -18,28 +18,15 @@
(car lst)
(loop (cdr lst)))))
-(define max-argcount ##sys#apply-argument-limit)
-
-(begin-for-syntax
- (define max-direct-argcount
- (cond-expand
- ;; This depends the temp stack's size (as does max-argcount w/ manyargs).
- ;; We can't use the foreign value for C_TEMPORARY_STACK_SIZE here because
- ;; we're evaluating this in the compiler, not compiling it (confused yet?)
- (compiling 2048)
- ;; But in interpreted mode, everything boils down to "apply", so if no apply
- ;; hack is available, we're more limited in csi than in csc.
- (else ##sys#apply-argument-limit))))
-
(when (feature? 'manyargs) (print "many arguments supported."))
(define (foo . args)
(when (pair? args)
(assert (= (length args) (last args)))))
-(printf "testing 'apply' with 0..~A (maximum apply argument count)...\n" max-argcount)
+(printf "testing 'apply' with 0..~A (maximum apply argument count)...\n" 2000)
(do ((i 0 (add1 i)))
- ((>= i max-argcount))
+ ((>= i 2000))
(apply foo (list-tabulate i add1)))
(let-syntax
@@ -51,26 +38,10 @@
;; Lowest edge cases
,@(list-tabulate 50 (lambda (i) `(foo ,@(list-tabulate i add1))))
(printf "invoking directly with ~A..~A (maximum ~A direct argument count)...\n"
- ,(- max-direct-argcount 50) ,max-direct-argcount
+ ,(- 2000 50) 2000
(cond-expand (compiling "compiled") (else "interpreted")))
;; Highest edge cases
,@(list-tabulate
- 50 (lambda (i) `(foo ,@(list-tabulate (- max-direct-argcount i) add1)))))))))
+ 50 (lambda (i) `(foo ,@(list-tabulate (- 2000 i) add1)))))))))
(print "If this segfaults on x86-64, try updating GCC (4.5 has a code-generation bug):")
(invoke-directly))
-
-(define-syntax assert-argcount-error
- (syntax-rules ()
- ((_ expr)
- (assert (condition-case (begin expr #f)
- ((exn runtime limit) 'a-okay))))))
-
-(print "testing 'apply' can detect calls of too many arguments...")
-(assert-argcount-error (apply foo (list-tabulate (add1 max-argcount) add1)))
-
-(print "testing direct invocation can detect calls of too many arguments...")
-(let-syntax ((invoke-directly-with-too-many-args
- (ir-macro-transformer
- (lambda (i r c)
- `(assert-argcount-error (foo ,@(list-tabulate (add1 max-direct-argcount) add1)))))))
- (invoke-directly-with-too-many-args))
Trap