108 lines
4.7 KiB
Common Lisp
108 lines
4.7 KiB
Common Lisp
;;;; SPDX-License-Identifier AGPL-3.0-or-later
|
|
|
|
;;;; compound.lisp Compound artifact implementation
|
|
;;;; Copyright (C) 2022 Alejandro "HiPhish" Sanchez
|
|
;;;;
|
|
;;;; This file is part of CL-HSSG.
|
|
;;;;
|
|
;;;; CL-HSSG is free software: you can redistribute it and/or modify it under
|
|
;;;; the terms of the GNU Affero General Public License as published by the
|
|
;;;; Free Software Foundation, either version 3 of the License, or (at your
|
|
;;;; option) any later version.
|
|
;;;;
|
|
;;;; CL-HSSG 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 Affero General Public License for
|
|
;;;; more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Affero General Public License
|
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>
|
|
(defpackage #:hssg/test/artifact/compound
|
|
(:use #:cl)
|
|
(:import-from #:clunit
|
|
#:defsuite #:deffixture #:deftest #:assert-equal #:assert-true #:assert-eql)
|
|
(:import-from #:hssg #:make-compound-artifact)
|
|
(:import-from #:hssg.filesystem))
|
|
(in-package #:hssg/test/artifact/compound)
|
|
|
|
;;; Compound artifact implementation tests
|
|
(clunit:defsuite hssg.artifact.compound (hssg/test:hssg))
|
|
(clunit:defsuite hssg.artifact.compound.constructor (hssg.artifact.compound))
|
|
(clunit:defsuite hssg.artifact.compound.mutation (hssg.artifact.compound))
|
|
(clunit:defsuite hssg.artifact.compound.derivation (hssg.artifact.compound))
|
|
|
|
|
|
;;; --- FAKES -----------------------------------------------------------------
|
|
(defclass dummy-artifact ()
|
|
()
|
|
(:documentation "A fake artifact"))
|
|
|
|
(defclass dummy-instruction ()
|
|
((artifact :initarg :artifact :reader dummy-artifact))
|
|
(:documentation "A fake instruction"))
|
|
|
|
(defmethod hssg.artifact:derive-artifact ((artifact dummy-artifact))
|
|
"Attach the artifact to the instruction so we can check it was called."
|
|
(make-instance 'dummy-instruction :artifact artifact))
|
|
|
|
|
|
;;; --- CONSTRUCTOR -----------------------------------------------------------
|
|
(deftest make-empty-compound-artifact (hssg.artifact.compound.constructor)
|
|
"An empty artifact has no children."
|
|
(let ((compound (hssg:make-compound-artifact)))
|
|
(with-slots ((artifacts hssg.artifact:artifacts))
|
|
compound
|
|
(clunit:assert-false artifacts))))
|
|
|
|
(deftest make-nonempty-compound-artifact (hssg.artifact.compound.constructor)
|
|
"A nonempty artifact has children."
|
|
(let* ((dummy1 (make-instance 'dummy-artifact))
|
|
(dummy2 (make-instance 'dummy-artifact))
|
|
(compound (hssg:make-compound-artifact dummy1 dummy2)))
|
|
(with-slots ((artifacts hssg.artifact:artifacts))
|
|
compound
|
|
(assert-eql 2 (length artifacts))
|
|
(loop for artifact in artifacts
|
|
for dummy in (list dummy1 dummy2)
|
|
do (assert-true (eq dummy artifact))))))
|
|
|
|
|
|
;;; --- MUTATION --------------------------------------------------------------
|
|
(deftest compound-artifact-push (hssg.artifact.compound.mutation)
|
|
"Push a new artifact onto the list of wrapped artifacts"
|
|
(let ((compound (hssg:make-compound-artifact))
|
|
(dummy1 (make-instance 'dummy-artifact))
|
|
(dummy2 (make-instance 'dummy-artifact)))
|
|
(hssg:compound-artifact-push compound dummy2)
|
|
(hssg:compound-artifact-push compound dummy1)
|
|
(with-slots ((artifacts hssg.artifact:artifacts))
|
|
compound
|
|
(assert-eql 2 (length artifacts))
|
|
(loop for artifact in artifacts
|
|
for dummy in (list dummy1 dummy2)
|
|
do (assert-true (eq dummy artifact))))))
|
|
|
|
|
|
;;; --- DERIVATIVES -----------------------------------------------------------
|
|
(deftest derive-empty-compound-artifact (hssg.artifact.compound.derivation)
|
|
"Deriving an empty artifact yields and empty struction."
|
|
(let* ((artifact (hssg:make-compound-artifact))
|
|
(instruction (hssg.artifact:derive-artifact artifact)))
|
|
(assert-true (typep instruction 'hssg.filesystem:compound-instruction))
|
|
(with-slots ((instructions hssg.filesystem::instructions))
|
|
instruction
|
|
(null instructions))))
|
|
|
|
(deftest derive-nonempty-compound-artifact (hssg.artifact.compound.derivation)
|
|
"Deriving a non-empty artifact in turn derives each of the children."
|
|
(let* ((dummy1 (make-instance 'dummy-artifact))
|
|
(dummy2 (make-instance 'dummy-artifact))
|
|
(artifact (hssg:make-compound-artifact dummy1 dummy2))
|
|
(instruction (hssg.artifact:derive-artifact artifact)))
|
|
(assert-true (typep instruction 'hssg.filesystem:compound-instruction))
|
|
(with-slots ((instructions hssg.filesystem::instructions))
|
|
instruction
|
|
(assert-eql 2 (length instructions))
|
|
(loop for instruction in instructions
|
|
for dummy in (list dummy1 dummy2)
|
|
do (assert-true (eq dummy (dummy-artifact instruction)))))))
|