mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 05:21:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

Add test suite for new interface

Browse source
This commit is contained in:
Daniel Kochmański 2016-11-09 18:07:55 +01:00
parent 36b1b1d3cc
commit 338be8b488
3 changed files with 88 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/tests/ecl-tests.asd
View file

@ -14,21 +14,16 @@
((:file "ansi")
(:file "mixed")
(:file "compiler")
#-ecl-bytecmp
(:file "embedding")
#+ffi
(:file "foreign-interface")
#+clos
(:file "metaobject-protocol")
#+threads
(:file "multiprocessing")))
(:file "embedding" :if-feature (:not :ecl-bytecmp))
(:file "foreign-interface" :if-feature :ffi)
(:file "metaobject-protocol" :if-feature :clos)
(:file "multiprocessing" :if-feature :threads)))
(:module features
:default-component-class asdf:cl-source-file.lsp
:components
(#+unicode
(:file "external-formats")
#+ieee-floating-point
(:file "ieee-fp")
((:file "external-formats" :if-feature :unicode)
(:file "ieee-fp" :if-feature :ieee-floating-point)
(:file "package-locks" :if-feature :package-locks)
(:file "external-process")
(:file "multiprocessing")))))

1
src/tests/ecl-tests.lisp
View file

@ -28,6 +28,7 @@
'(features/eformat
features/ieee-fp
features/eprocess
features/package-locks
regressions/ansi+
regressions/mixed
regressions/cmp

80
src/tests/features/package-locks.lsp Normal file
View file

@ -0,0 +1,80 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
;;;; Author: Daniel Kochmański
;;;; Created: 2016-11-09
;;;; Contains: PACKAGE-LOCKS interface tests
;;;; Easter: Trump won the election today, we're doomed...
(in-package :cl-test)
(suite 'features/package-locks)
(defmacro with-fresh-package (name &body body)
`(progn
(defpackage ,name)
,@body
(ext:unlock-package ',name)
(delete-package ',name)))
(test package-locks.trivial
(is-true (ext:package-locked-p "CL"))
(is-false (ext:package-locked-p "CL-USER")))
(test package-locks.coerce
(is-true (ext:package-locked-p :CL))
(is-true (ext:package-locked-p (find-package "CL")))
(is-true (ext:package-locked-p "CL"))
(signals error (ext:package-locked-p "CL1"))
(signals error (ext:package-locked-p :CL1))
(signals error (ext:package-locked-p 'CL1))
(signals error (ext:package-locked-p 3)))
(test package-locks.lock/unlock
(defpackage test-pack-locks)
(finishes (ext:unlock-package 'test-pack-locks))
(is-false (ext:package-locked-p 'test-pack-locks))
(finishes (ext:lock-package 'test-pack-locks))
(is-true (ext:package-locked-p 'test-pack-locks))
(signals package-error (delete-package 'test-pack-locks))
(ext:unlock-package 'test-pack-locks)
(finishes (delete-package 'test-pack-locks)))
(test package-locks.intern-locked/without-package-locks
(with-fresh-package test-pack
(ext:lock-package 'test-pack)
(signals package-error (intern "BAH" 'test-pack))
(ext:unlock-package 'test-pack)
(finishes (intern "BAH" 'test-pack))
(ext:lock-package 'test-pack)
(ext:without-package-locks
(is-true (ext:package-locked-p 'test-pack))
(finishes (intern "BAH2" 'test-pack)))
(signals package-error (intern "BAH3" 'test-pack))))
(test package-locks.with-unlocked-packages
(with-fresh-package test-pack
(with-fresh-package test-pack2
(with-fresh-package test-pack3
(ext:lock-package 'test-pack)
(ext:lock-package 'test-pack2)
(is-true (ext:package-locked-p 'test-pack))
(is-true (ext:package-locked-p 'test-pack2))
(is-false (ext:package-locked-p 'test-pack3))
(ext:with-unlocked-packages (test-pack test-pack2 test-pack3)
(is-false (ext:package-locked-p 'test-pack))
(is-false (ext:package-locked-p 'test-pack2))
(is-false (ext:package-locked-p 'test-pack3)))
(is-true (ext:package-locked-p 'test-pack))
(is-true (ext:package-locked-p 'test-pack2))
(is-false (ext:package-locked-p 'test-pack3))
(signals error
(ext:with-unlocked-packages (test-pack test-pack2 test-pack3)
(is-false (ext:package-locked-p 'test-pack))
(is-false (ext:package-locked-p 'test-pack2))
(is-false (ext:package-locked-p 'test-pack3))
(error "bah")))
(is-true (ext:package-locked-p 'test-pack))
(is-true (ext:package-locked-p 'test-pack2))
(is-false (ext:package-locked-p 'test-pack3))))))