summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests')
-rw-r--r--test-suite/tests/asyncs.test5
-rw-r--r--test-suite/tests/signals.test76
-rw-r--r--test-suite/tests/statprof.test15
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
View Lorry Controller Status