diff options
author | Mike Gran <spk121@yahoo.com> | 2017-03-06 22:57:03 -0800 |
---|---|---|
committer | Mike Gran <spk121@yahoo.com> | 2017-03-06 23:08:25 -0800 |
commit | f5b362586d7622c408d4402c7cb496c45ffb56e8 (patch) | |
tree | dc29f257b5b753a5b2d82968b09699a718f7f288 /test-suite/tests | |
parent | 4ce31fd387e89c8f64716866705a5a34651506ea (diff) | |
download | guile-wip-itimer-checks.tar.gz |
Check for working profiling and virtual itimerswip-itimer-checks
* configure.ac (HAVE_USABLE_GETITIMER_PROF, HAVE_USABLE_GETITIMER_VIRTUAL): new tests
* doc/ref/posix.texi (setitimer, getitimer): document provided? 'ITIMER_VIRTUAL and 'ITIMER_PROF
* doc/ref/statprof.texi (statprof): document ITIMER_PROF requirements
* libguile/scmsigs.c (scm_setitimer, scm_getitimer): document (provided? 'ITIMER_VIRTUAL) and (provided? 'ITIMER_READ)
(scm_init_scmsigs): add features ITIMER_VIRTUAL and ITIMER_PROF
* test-suite/tests/asyncs.test ("prevention via sigprof"): throw when unsupported
* test-suite/tests/signals.test: throw when not supported
* test-suite/tests/statprof.test: throw when not supported
Diffstat (limited to 'test-suite/tests')
-rw-r--r-- | test-suite/tests/asyncs.test | 5 | ||||
-rw-r--r-- | test-suite/tests/signals.test | 76 | ||||
-rw-r--r-- | test-suite/tests/statprof.test | 15 |
3 files changed, 55 insertions, 41 deletions
diff --git a/test-suite/tests/asyncs.test b/test-suite/tests/asyncs.test index 437927a81..4ac9020c4 100644 --- a/test-suite/tests/asyncs.test +++ b/test-suite/tests/asyncs.test @@ -1,6 +1,6 @@ ;;;; asyncs.test -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2016 Free Software Foundation, Inc. +;;;; Copyright (C) 2016, 2017 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -51,7 +51,8 @@ (setitimer ITIMER_PROF 0 0 0 0) (sigaction SIGPROF prev-handler))))) -(when (defined? 'setitimer) +(when (and (defined? 'setitimer) + (provided? 'ITIMER_PROF)) (pass-if "preemption via sigprof" ;; Use an atomic box as a compiler barrier. (let* ((box (make-atomic-box 0)) diff --git a/test-suite/tests/signals.test b/test-suite/tests/signals.test index ef61aaa83..ac730a91e 100644 --- a/test-suite/tests/signals.test +++ b/test-suite/tests/signals.test @@ -1,17 +1,17 @@ ;;;; signals.test --- test suite for Guile's signal functions -*- scheme -*- -;;;; -;;;; Copyright (C) 2009, 2014 Free Software Foundation, Inc. -;;;; +;;;; +;;;; Copyright (C) 2009, 2014, 2017 Free Software Foundation, Inc. +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, @@ -41,39 +41,51 @@ (equal? (setitimer ITIMER_REAL 0 0 0 0) '((0 . 0) (0 . 0)))) (pass-if "ITIMER_VIRTUAL" - (equal? (setitimer ITIMER_VIRTUAL 0 0 0 0) - '((0 . 0) (0 . 0)))) + (if (not (provided? 'ITIMER_VIRTUAL)) + (throw 'unsupported) + (equal? (setitimer ITIMER_VIRTUAL 0 0 0 0) + '((0 . 0) (0 . 0))))) (pass-if "ITIMER_PROF" - (equal? (setitimer ITIMER_PROF 0 0 0 0) - '((0 . 0) (0 . 0))))) + (if (not (provided? 'ITIMER_PROF)) + (throw 'unsupported) + (equal? (setitimer ITIMER_PROF 0 0 0 0) + '((0 . 0) (0 . 0)))))) (with-test-prefix "setting values correctly" (pass-if "initial setting" - (equal? (setitimer ITIMER_PROF 1 0 3 0) - '((0 . 0) (0 . 0)))) + (if (not (provided? 'ITIMER_PROF)) + (throw 'unsupported) + (equal? (setitimer ITIMER_PROF 1 0 3 0) + '((0 . 0) (0 . 0))))) (pass-if "reset to zero" - (match (setitimer ITIMER_PROF 0 0 0 0) - ((interval value) - ;; We don't presume that the timer is strictly lower than the - ;; value at which we set it, given its limited internal - ;; precision. Assert instead that the timer is between 2 and - ;; 3.5 seconds. - (and (<= 0.9 (time-pair->secs interval) 1.1) - (<= 2.0 (time-pair->secs value) 3.5)))))) + (if (not (provided? 'ITIMER_PROF)) + (throw 'unsupported) + (match (setitimer ITIMER_PROF 0 0 0 0) + ((interval value) + ;; We don't presume that the timer is strictly lower than the + ;; value at which we set it, given its limited internal + ;; precision. Assert instead that the timer is between 2 and + ;; 3.5 seconds. + (and (<= 0.9 (time-pair->secs interval) 1.1) + (<= 2.0 (time-pair->secs value) 3.5))))))) (with-test-prefix "usecs > 1e6" (pass-if "initial setting" - (equal? (setitimer ITIMER_PROF 1 0 0 #e3e6) - '((0 . 0) (0 . 0)))) + (if (not (provided? 'ITIMER_PROF)) + (throw 'unsupported) + (equal? (setitimer ITIMER_PROF 1 0 0 #e3e6) + '((0 . 0) (0 . 0))))) (pass-if "reset to zero" - (match (setitimer ITIMER_PROF 0 0 0 0) - ((interval value) - ;; We don't presume that the timer is strictly lower than the - ;; value at which we set it, given its limited internal - ;; precision. Assert instead that the timer is between 2 and - ;; 3.5 seconds. - (and (<= 0.9 (time-pair->secs interval) 1.1) - (<= 2.0 (time-pair->secs value) 3.5) - (match value - ((secs . usecs) - (<= 0 usecs 999999)))))))))) + (if (not (provided? 'ITIMER_PROF)) + (throw 'unsupported) + (match (setitimer ITIMER_PROF 0 0 0 0) + ((interval value) + ;; We don't presume that the timer is strictly lower than the + ;; value at which we set it, given its limited internal + ;; precision. Assert instead that the timer is between 2 and + ;; 3.5 seconds. + (and (<= 0.9 (time-pair->secs interval) 1.1) + (<= 2.0 (time-pair->secs value) 3.5) + (match value + ((secs . usecs) + (<= 0 usecs 999999))))))))))) diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test index a597f3198..994d88269 100644 --- a/test-suite/tests/statprof.test +++ b/test-suite/tests/statprof.test @@ -1,4 +1,5 @@ -;; guile-lib -*- scheme -*- +;;;; statprof.test --- test suite for Guile's profiler -*- scheme -*- +;;;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2009, 2010, 2014 Andy Wingo <wingo at pobox dot com> ;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org> @@ -31,9 +32,9 @@ #:use-module (srfi srfi-1) #:use-module (statprof)) -;; Throw `unresolved' upon ENOSYS. This is used to skip tests on -;; platforms such as GNU/Hurd where `ITIMER_PROF' is is currently -;; unimplemented. +;; Throw `unresolved' upon ENOSYS or EINVAL. This is used to skip tests +;; on platforms such as GNU/Hurd or Cygwin where `ITIMER_PROF' is is +;; currently unimplemented. (define-syntax-rule (when-implemented body ...) (catch 'system-error (lambda () @@ -41,7 +42,7 @@ (lambda args (let ((errno (system-error-errno args))) (false-if-exception (statprof-stop)) - (if (= errno ENOSYS) + (if (or (= errno ENOSYS) (= errno EINVAL)) (throw 'unresolved) (apply throw args)))))) @@ -125,7 +126,7 @@ (define do-nothing (compile '(lambda (n) (simple-format #f "FOO ~A\n" (+ n n))))) - + ;; Run test. (statprof-reset 0 50000 #t #f) (statprof-start) @@ -136,7 +137,7 @@ (loop (- x 1)) #t))) (statprof-stop) - + ;; Check result. (let ((proc-data (statprof-proc-call-data do-nothing))) (and proc-data |