Merge pull request #459 from NicoSimoski/common-lisp-parachute

Added implementation in common lisp with unit-test

common-lisp-parachute/README.md

@@ -0,0 +1,57 @@
+# gilded rose
+
+The requirements of gilded rose can be found here:
+https://github.com/emilybache/GildedRose-Refactoring-Kata/blob/main/GildedRoseRequirements.txt
+
+# Setup
+
+## Install quicklisp
+
+To run this project install quicklisp (if not already done): 
+ - download https://beta.quicklisp.org/quicklisp.lisp
+ - load it with your common lisp implementation. The example with sbcl: 
+   > sbcl --load quicklisp.lisp
+ - run the command 
+   > (quicklisp-quickstart:install) 
+   in your common lisp implementation
+ - run the command 
+   > (ql:add-to-init-file) 
+   in your common lisp implementation
+
+## Install project
+Copy the project-folder containing this file into /quicklisp/local-projects/ that has been created when installing quicklisp.
+This is the root directory for quicklisp to search for the gilded-rose.asd file which defines the system (project) and its dependencies.
+The quicklisp-folder is usually created in your home-directory.
+
+## Working with the project
+
+Now you can load the project with 
+> (ql:quickload "gilded-rose") 
+in the common lisp implementation of your choice and run the tests with 
+> (asdf:test-system "gilded-rose")
+.
+
+If you just want to run the tests
+> (asdf:test-system "gilded-rose")
+is sufficient.
+
+You can mock functions and methods with the cl-mock-library which is already included in the system definition of the test-system:
+
+(with-mocks ()
+  (answer <your-method> (call-previous))
+  (<your-method> <argument-list>)
+  (is <your-testcase> (invocations '<your-method>)))
+  
+If you just want to stub functions you can replace 
+(call-previous) 
+with a return value of your choice and your test does not depend on 
+(invocations '<your-method>)
+
+## Running the texttest-fixture
+
+If you don't want to work with the unit-tests you can test your program with the texttest-fixture.
+After loading the project in the common lisp implementation of your choice with
+> (ql:quickload "gilded-rose")
+you can run the texttest-fixture with
+> (gilded-rose::run-gilded-rose <number-of-days>)
+where <number-of-days> is the number of days you want to simulate.

common-lisp-parachute/gilded-rose.asd

@@ -0,0 +1,20 @@
+;;;; gilded-rose.asd
+
+(defsystem "gilded-rose"
+  :description "Gilded Rose is a small inn selling the finest goods."
+  :author "Leeroy <leeroy@gilded-rose.com>"
+  :version "1.0.0"
+  :pathname "source/"
+  :components ((:file "package")
+               (:file "gilded-rose" :depends-on ("package")))
+  :in-order-to ((test-op (test-op "gilded-rose/tests"))))
+
+(defsystem "gilded-rose/tests"
+  :description "Unit tests for gilded-rose-package"
+  :author "Leeroy <leeroy@gilded-rose.com>"
+  :version "1.0.0"
+  :depends-on ("gilded-rose" "parachute" "cl-mock")
+  :pathname "tests/"
+  :components ((:file "package")
+	       (:file "tests" :depends-on ("package")))
+  :perform (test-op (o c) (symbol-call :parachute :test :gilded-rose-tests)))

common-lisp-parachute/source/gilded-rose.lisp

@@ -0,0 +1,90 @@
+;; https://github.com/emilybache/GildedRose-Refactoring-Kata
+
+;; Common Lisp version: Rainer Joswig, joswig@lisp.de, 2016
+;; Minor modifications (independent of CL impl.): Manfred Bergmann, 2022
+;; Adaption to asdf: Nico Simoski, 2023
+
+;;; ================================================================
+;;; Code
+
+(in-package :gilded-rose)
+
+;;; Class ITEM
+
+(defclass item ()
+  ((name    :initarg :name    :type string)
+   (sell-in :initarg :sell-in :type integer)
+   (quality :initarg :quality :type integer)))
+
+(defmethod to-string ((i item))
+  (with-slots (name quality sell-in) i
+    (format nil "~a, ~a, ~a" name sell-in quality)))
+
+;;; Class gilded-rose
+
+(defclass gilded-rose ()
+  ((items :initarg :items)))
+
+(defmethod update-quality ((gr gilded-rose))
+  (with-slots (items) gr
+    (dotimes (i (length items))
+      (with-slots (name quality sell-in)
+          (elt items i)
+        (if (and (not (equalp name "Aged Brie"))
+                 (not (equalp name "Backstage passes to a TAFKAL80ETC concert")))
+            (if (> quality 0)
+                (if (not (equalp name "Sulfuras, Hand of Ragnaros"))
+                    (setf quality (- quality 1))))
+          (when (< quality 50)
+            (setf quality (+ quality 1))
+            (when (equalp name "Backstage passes to a TAFKAL80ETC concert")
+              (if (< sell-in 11)
+                  (if (< quality 50)
+                      (setf quality (+ quality 1))))
+              (if (< sell-in 6)
+                  (if (< quality 50)
+                      (setf quality (+ quality 1)))))))
+
+        (if (not (equalp name "Sulfuras, Hand of Ragnaros"))
+            (setf sell-in (- sell-in 1)))
+
+        (if (< sell-in 0)
+            (if (not (equalp name "Aged Brie"))
+                (if (not (equalp name "Backstage passes to a TAFKAL80ETC concert"))
+                    (if (> quality 0)
+                        (if (not (equalp name "Sulfuras, Hand of Ragnaros"))
+                            (setf quality (- quality 1))))
+                  (setf quality (- quality quality)))
+              (if (< quality 50)
+                  (setf quality (+ quality 1)))))))))
+
+;;; Example
+
+(defun run-gilded-rose (days)
+  (write-line "OMGHAI!")
+  (let* ((descriptions '(("+5 Dexterity Vest"                         10 20)
+                         ("Aged Brie"                                  2  0)
+                         ("Elixir of the Mongoose"                     5  7)
+                         ("Sulfuras, Hand of Ragnaros"                 0 80)
+                         ("Sulfuras, Hand of Ragnaros"                -1 80)
+                         ("Backstage passes to a TAFKAL80ETC concert" 15 20)
+                         ("Backstage passes to a TAFKAL80ETC concert" 10 49)
+                         ("Backstage passes to a TAFKAL80ETC concert"  5 49)
+                         ;; this conjured item does not work properly yet
+                         ("Conjured Mana Cake"                         3  6)))
+         (items (loop :for (name sell-in quality) :in descriptions
+                      :collect (make-instance 'item
+                                              :name name
+                                              :sell-in sell-in
+                                              :quality quality)))
+         (app (make-instance 'gilded-rose :items items)))
+    (dotimes (i days)
+      (format t "-------- day ~a --------~%" i)
+      (format t "name, sell-in, quality~%")
+      (dolist (item items)
+        (write-line (to-string item)))
+      (terpri)
+      (update-quality app))))
+
+;;; ================================================================
+;;; EOF

common-lisp-parachute/source/package.lisp

@@ -0,0 +1,14 @@
+;;;; package.lisp
+
+(defpackage :gilded-rose
+  (:use :cl)
+  (:export :run-gilded-rose
+	   :gilded-rose
+	   :update-quality
+	   :items
+	   :item
+           :name
+	   :sell-in
+	   :quality))
+	   
+           

common-lisp-parachute/tests/package.lisp

@@ -0,0 +1,12 @@
+;;;; package.lisp
+
+(defpackage :gilded-rose-tests
+  (:use :cl :gilded-rose)
+  (:import-from :parachute
+   :define-test
+   :is)
+  (:import-from :cl-mock
+   :with-mocks
+   :answer
+   :call-previous
+   :invocations))

common-lisp-parachute/tests/tests.lisp

@@ -0,0 +1,12 @@
+(in-package :gilded-rose-tests)
+
+(define-test gilded-rose-testsuite)
+
+(define-test "Test foo."
+  :parent gilded-rose-testsuite
+  (let* ((an-item (make-instance 'item :name "foo" :sell-in 0 :quality 0))
+	 (some-items (list an-item))
+	 (my-app (make-instance 'gilded-rose :items some-items)))
+    (update-quality my-app)
+    (is equal (slot-value (first (slot-value my-app 'items)) 'name) "fixme")))
+