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

Test suite compile-and-eval tests run -O0 and -O2

Browse source 
* test-suite/test-suite/lib.scm (c&e): Test -O0 and -O2.
This commit is contained in:
Andy Wingo 2020-05-11 11:05:30 +02:00
parent 2e6f2feefc
commit 21885aa4ba
1 changed files with 22 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

33
test-suite/test-suite/lib.scm
View file

@ -1,5 +1,5 @@
;;;; test-suite/lib.scm --- generic support for testing
;;;; Copyright (C) 1999-2001,2004,2006-2007,2009-2014,2018
;;;; Copyright (C) 1999-2001,2004,2006-2007,2009-2014,2016,2018,2020
;;;; Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
@ -466,20 +466,31 @@
(c&e (pass-if "[unnamed test]" exp)))
((_ (pass-if test-name exp))
(begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp))
(pass-if (string-append test-name " (compile)")
(compile 'exp #:to 'value #:env (current-module)))))
(primitive-eval 'exp))
(pass-if (string-append test-name " (compile -O0)")
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 0))
(pass-if (string-append test-name " (compile -O2)")
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 2))))
((_ (pass-if-equal test-name val exp))
(begin (pass-if-equal (string-append test-name " (eval)") val
(primitive-eval 'exp))
(pass-if-equal (string-append test-name " (compile)") val
(compile 'exp #:to 'value #:env (current-module)))))
(pass-if-equal (string-append test-name " (compile -O0)") val
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 0))
(pass-if-equal (string-append test-name " (compile -O2)") val
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 2))))
((_ (pass-if-exception test-name exc exp))
(begin (pass-if-exception (string-append test-name " (eval)")
exc (primitive-eval 'exp))
(pass-if-exception (string-append test-name " (compile)")
exc (compile 'exp #:to 'value
#:env (current-module)))))))
(begin (pass-if-exception (string-append test-name " (eval)") exc
(primitive-eval 'exp))
(pass-if-exception (string-append test-name " (compile -O0)") exc
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 0))
(pass-if-exception (string-append test-name " (compile -O2)") exc
(compile 'exp #:to 'value #:env (current-module)
#:optimization-level 2))))))
;;; (with-test-prefix/c&e PREFIX BODY ...)
;;; Same as `with-test-prefix', but the enclosed tests are run both with