From cad9d88a5cd357b4b7e4b557bc92ba49e1c96395 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@gmail.com> Date: Tue, 21 Jan 2014 16:48:20 -0600 Subject: [PATCH] Testing the new operation classes. --- test/test-operation-classes.script | 72 ++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 test/test-operation-classes.script diff --git a/test/test-operation-classes.script b/test/test-operation-classes.script new file mode 100644 index 00000000..152b7727 --- /dev/null +++ b/test/test-operation-classes.script @@ -0,0 +1,72 @@ +;;; -*- Lisp -*- + +;;;--------------------------------------------------------------------------- +;;; Test that we can successfully create new subclasses of OPERATION and that we +;;; can detect bad subclasses of OPERATION. +;;;--------------------------------------------------------------------------- + + +(in-package :asdf) +(use-package :asdf-test) + +(defparameter *good-classes* + '(build-op + prepare-source-op + prepare-op + prepare-fasl-op + load-op + monolithic-load-compiled-concatenated-source-op + prepare-fasl-op + load-source-op + load-compiled-concatenated-source-op + monolithic-load-concatenated-source-op + load-concatenated-source-op + load-fasl-op + compile-op + compile-concatenated-source-op + test-op + fasl-op + program-op + monolithic-compile-concatenated-source-op + monolithic-dll-op + monolithic-binary-op + monolithic-fasl-op + dll-op + concatenate-source-op + monolithic-lib-op + monolithic-concatenate-source-op + lib-op) + "All of these classes should be instantiable without error.") + +(defclass my-unupdated-operation (operation) + () + ) + +(defclass my-good-operation (downward-operation) + () + ) + +(defclass my-incoherent-operation (downward-operation non-propagating-operation) + () + ) + +(loop :for class :in *good-classes* + :do (assert (make-instance class))) + +(assert + (catch 'op-def-error + (handler-bind ((operation-definition-error #'(lambda (e) + (declare (ignore e)) + (throw 'op-def-error t)))) + (make-instance 'my-unupdated-operation) + nil))) + +(assert + (catch 'op-def-error + (handler-bind ((operation-definition-error #'(lambda (e) + (declare (ignore e)) + (throw 'op-def-error t)))) + (make-instance 'my-incoherent-operation) + nil))) + +(assert (make-instance 'my-good-operation)) -- GitLab