From 02fdeb4e1ba99ccdcd0c15605dd38a5b037c2c83 Mon Sep 17 00:00:00 2001 From: Matt Decker Date: Sun, 26 Jun 2022 09:18:33 -0500 Subject: [PATCH] Delete scheme directory --- scheme/README.md | 18 ------------ scheme/assert.scm | 58 ------------------------------------- scheme/gilded-rose-test.scm | 7 ----- scheme/gilded-rose.scm | 46 ----------------------------- scheme/texttest-fixture.scm | 32 -------------------- 5 files changed, 161 deletions(-) delete mode 100644 scheme/README.md delete mode 100644 scheme/assert.scm delete mode 100644 scheme/gilded-rose-test.scm delete mode 100644 scheme/gilded-rose.scm delete mode 100644 scheme/texttest-fixture.scm diff --git a/scheme/README.md b/scheme/README.md deleted file mode 100644 index 0318ef54..00000000 --- a/scheme/README.md +++ /dev/null @@ -1,18 +0,0 @@ -# Scheme port of the Gilded-Rose Kata - -This is a (Gambit) R5RS Scheme port of the *Gilded-Rose-Kata*. - -## Building and Running - -```shell -gsi texttest-fixture.scm -``` - -## Unit Test - -`assert.scm` is a minimalist implementation of xUnit in Scheme style. -There are two assertions available, e.g. `(assert=)` and `(assert-string=)`. - -```shell -gsi gilded-rose-test.scm -``` diff --git a/scheme/assert.scm b/scheme/assert.scm deleted file mode 100644 index 99828669..00000000 --- a/scheme/assert.scm +++ /dev/null @@ -1,58 +0,0 @@ -;;; -;;; Unit test framework for Scheme -;;; Copyright (c) 2018, Peter Kofler, http://www.code-cop.org/ -;;; BSD licensed. -;;; -;;; Non S5RS used functions: -;;; * (error) from R6RS -;;; - -;; SchemeUnit from http://c2.com/cgi/wiki?SchemeUnit - -(define (fail msg) - (error (string-append "AssertionError" ": " msg))) - -(define (check msg condition) - (if (not condition) - (fail msg) - #t)) - -(define (assert msg condition) - (lambda () (check msg condition))) - -;; extensions - -;; private -(define (make-string-message prefix to-string expected actual) - (make-message prefix - (to-string expected) - (to-string actual))) - -;; private -(define (make-message prefix expected actual) - (string-append prefix "expected:<" expected "> but was:<" actual ">")) - -(define (assert-equal to-string eq-op expected actual) - (assert (make-string-message "" to-string expected actual) - (eq-op expected actual))) - -(define (assert= expected actual) - (assert-equal number->string = expected actual)) - -(define (assert-string= expected actual) - (assert-equal values string=? expected actual)) - -;; private -(define (test-case-name name) - (display name) - (display " ... ")) - -;; private -(define (test-case-success) - (display "OK") - (newline)) - -(define (test-case name . assertions) - (test-case-name name) - (for-each (lambda (a) (a)) assertions) - (test-case-success)) diff --git a/scheme/gilded-rose-test.scm b/scheme/gilded-rose-test.scm deleted file mode 100644 index b0d67e09..00000000 --- a/scheme/gilded-rose-test.scm +++ /dev/null @@ -1,7 +0,0 @@ -(include "assert.scm") -(include "gilded-rose.scm") - -(test-case "foo" - (let ((items (list (make-item "foo" 0 0)))) - (update-quality items) - (assert-string= "fixme" (item-name (car items))))) diff --git a/scheme/gilded-rose.scm b/scheme/gilded-rose.scm deleted file mode 100644 index dac984fa..00000000 --- a/scheme/gilded-rose.scm +++ /dev/null @@ -1,46 +0,0 @@ -;;; Class ITEM - -(define-record-type item (make-item name sell-in quality) item? name sell-in quality) -;; define-record-type ... SRFI-9 -;; creates make-item, item?, item-name, item-sell-in, item-quality, item-name-set!, item-sell-in-set!, item-quality-set! - -(define (item-to-string item) - (string-append (item-name item) - ", " - (number->string (item-sell-in item)) - ", " - (number->string (item-quality item)))) - -;;; GILDED-ROSE - -(define (update-quality items) - (for-each - (lambda (item) - (if (and (not (string=? (item-name item) "Aged Brie")) - (not (string=? (item-name item) "Backstage passes to a TAFKAL80ETC concert"))) - (if (> (item-quality item) 0) - (if (not (string=? (item-name item) "Sulfuras, Hand of Ragnaros")) - (item-quality-set! item (- (item-quality item) 1)))) - (cond ((< (item-quality item) 50) - (item-quality-set! item (+ (item-quality item) 1)) - (if (string=? (item-name item) "Backstage passes to a TAFKAL80ETC concert") - (if (< (item-sell-in item) 11) - (cond ((< (item-quality item) 50) - (item-quality-set! item (+ (item-quality item) 1)) - (if (< (item-sell-in item) 6) - (if (< (item-quality item) 50) - (item-quality-set! item (+ (item-quality item) 1))))))))))) - - (if (not (string=? (item-name item) "Sulfuras, Hand of Ragnaros")) - (item-sell-in-set! item (- (item-sell-in item) 1))) - - (if (< (item-sell-in item) 0) - (if (not (string=? (item-name item) "Aged Brie")) - (if (not (string=? (item-name item) "Backstage passes to a TAFKAL80ETC concert")) - (if (> (item-quality item) 0) - (if (not (string=? (item-name item) "Sulfuras, Hand of Ragnaros")) - (item-quality-set! item (- (item-quality item) 1)))) - (item-quality-set! item (- (item-quality item) (item-quality item)))) - (if (< (item-quality item) 50) - (item-quality-set! item (+ (item-quality item) 1)))))) - items)) diff --git a/scheme/texttest-fixture.scm b/scheme/texttest-fixture.scm deleted file mode 100644 index ee15981e..00000000 --- a/scheme/texttest-fixture.scm +++ /dev/null @@ -1,32 +0,0 @@ -(include "gilded-rose.scm") - -(display "OMGHAI!") -(newline) - -(let ((items (list (make-item "+5 Dexterity Vest" 10 20) - (make-item "Aged Brie" 2 0) - (make-item "Elixir of the Mongoose" 5 7) - (make-item "Sulfuras, Hand of Ragnaros" 0 80) - (make-item "Sulfuras, Hand of Ragnaros" -1 80) - (make-item "Backstage passes to a TAFKAL80ETC concert" 15 20) - (make-item "Backstage passes to a TAFKAL80ETC concert" 10 49) - (make-item "Backstage passes to a TAFKAL80ETC concert" 5 49) - ;; this conjured item does not work properly yet - (make-item "Conjured Mana Cake" 3 6))) - (days 2)) - - (define (loop day) - (cond ((< day days) - (display (string-append "-------- day " (number->string day) " --------")) - (newline) - (display "name, sell-in, quality") - (newline) - (for-each - (lambda (item) - (display (item-to-string item)) - (newline)) - items) - (newline) - (update-quality items) - (loop (+ day 1))))) - (loop 0))