From 338be8b48834087ba374d1b2aa017ee5319837ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 9 Nov 2016 18:07:55 +0100
Subject: [PATCH] Add test suite for new interface

---
 src/tests/ecl-tests.asd              | 19 +++----
 src/tests/ecl-tests.lisp             |  1 +
 src/tests/features/package-locks.lsp | 80 ++++++++++++++++++++++++++++
 3 files changed, 88 insertions(+), 12 deletions(-)
 create mode 100644 src/tests/features/package-locks.lsp

diff --git a/src/tests/ecl-tests.asd b/src/tests/ecl-tests.asd
index 11cf56d6e..24fa6fdbb 100644
--- a/src/tests/ecl-tests.asd
+++ b/src/tests/ecl-tests.asd
@@ -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")))))
 
diff --git a/src/tests/ecl-tests.lisp b/src/tests/ecl-tests.lisp
index fc31f44ef..094fbb27c 100644
--- a/src/tests/ecl-tests.lisp
+++ b/src/tests/ecl-tests.lisp
@@ -28,6 +28,7 @@
        '(features/eformat
          features/ieee-fp
          features/eprocess
+         features/package-locks
          regressions/ansi+
          regressions/mixed
          regressions/cmp
diff --git a/src/tests/features/package-locks.lsp b/src/tests/features/package-locks.lsp
new file mode 100644
index 000000000..d582083d4
--- /dev/null
+++ b/src/tests/features/package-locks.lsp
@@ -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))))))