mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Skip tests that require STATPROF when not supported

Browse source 
* test-suite/tests/statprof.test (when-implemented): throw unresolved
    when SIGPROF unavailable
This commit is contained in:
Michael Gran 2023-06-20 12:21:54 -07:00
parent f187c46bd9
commit d512ec0657
1 changed files with 11 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

20
test-suite/tests/statprof.test
View file

@ -36,15 +36,17 @@
;; on platforms such as GNU/Hurd or Cygwin where `ITIMER_PROF' is is ;; on platforms such as GNU/Hurd or Cygwin where `ITIMER_PROF' is is
;; currently unimplemented. ;; currently unimplemented.
(define-syntax-rule (when-implemented body ...) (define-syntax-rule (when-implemented body ...)
(catch 'system-error (begin
(lambda () (unless (defined? 'SIGPROF) (throw 'unresolved))
body ...) (catch 'system-error
(lambda args (lambda ()
(let ((errno (system-error-errno args))) body ...)
(false-if-exception (statprof-stop)) (lambda args
(if (or (= errno ENOSYS) (= errno EINVAL)) (let ((errno (system-error-errno args)))
(throw 'unresolved) (false-if-exception (statprof-stop))
(apply throw args)))))) (if (or (= errno ENOSYS) (= errno EINVAL))
(throw 'unresolved)
(apply throw args)))))))
(pass-if-equal "return values" (pass-if-equal "return values"
'(42 77) '(42 77)