mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
7ac3d17cea
On Hurd, setrlimits are not yet implemented. See <https://lists.gnu.org/archive/html/bug-hurd/2017-05/msg00013.html>. * test-suite/standalone/test-out-of-memory: skip for Hurd. * test-suite/standalone/test-stack-overflow: skip for Hurd.
60 lines
1.7 KiB
Scheme
Executable file
60 lines
1.7 KiB
Scheme
Executable file
#!/bin/sh
|
|
guild compile "$0"
|
|
exec guile -q -s "$0" "$@"
|
|
!#
|
|
|
|
(unless (defined? 'setrlimit)
|
|
;; Without an rlimit, this test can take down your system, as it
|
|
;; consumes all of your memory in stack space. That doesn't seem like
|
|
;; something we should run as part of an automated test suite.
|
|
(exit 0))
|
|
|
|
(when (string-ci= "darwin" (vector-ref (uname) 0))
|
|
;; setrlimits are ignored in OS X (tested on 10.9 and 10.10). Proceeding
|
|
;; with the test would fill all available memory and probably end in a crash.
|
|
;; See also test-out-of-memory.
|
|
(exit 77)) ; uresolved
|
|
|
|
(when (string-ci= "GNU" (vector-ref (uname) 0))
|
|
;; setrlimits are not yet implemented on GNU/Hurd systems. Proceeding
|
|
;; with the test would end in a crash. See
|
|
;; <https://lists.gnu.org/archive/html/bug-hurd/2017-05/msg00013.html>
|
|
(exit 77)) ; unresolved
|
|
|
|
(when (string-contains-ci (vector-ref (uname) 0) "CYGWIN_NT")
|
|
;; attempting to use setrlimits for memory RLIMIT_AS will always
|
|
;; produce an invalid argument error on Cygwin (tested on
|
|
;; CYGWIN_NT-10.0 DLL v2.7.0). Proceeding with the test would fill
|
|
;; all available memory and probably end in a crash. See also
|
|
;; test-out-of-memory.
|
|
(exit 77)) ; unresolved
|
|
|
|
;; 100 MB.
|
|
(define *limit* (* 100 1024 1024))
|
|
|
|
(call-with-values (lambda () (getrlimit 'as))
|
|
(lambda (soft hard)
|
|
(unless (and soft (< soft *limit*))
|
|
(setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
|
|
|
|
(define (test)
|
|
(catch 'stack-overflow
|
|
(lambda ()
|
|
(let lp ()
|
|
(lp)
|
|
(error "should not be reached")))
|
|
(lambda _
|
|
#t)))
|
|
|
|
;; Run the test a few times. The stack will only be enlarged and
|
|
;; relocated on the first one.
|
|
|
|
(test)
|
|
(test)
|
|
(test)
|
|
(test)
|
|
(test)
|
|
|
|
;; Local Variables:
|
|
;; mode: scheme
|
|
;; End:
|