From 23fba43d931b6f0af3e3eec3b519058869dfc476 Mon Sep 17 00:00:00 2001 From: Matt Decker Date: Sun, 26 Jun 2022 09:17:08 -0500 Subject: [PATCH] Delete pascal directory --- pascal/.gitignore | 11 ---- pascal/README.md | 19 ------ pascal/ROSE.PAS | 137 -------------------------------------------- pascal/ROSE_T.PAS | 29 ---------- pascal/TEXTTEST.PAS | 60 ------------------- pascal/TPUNIT.PAS | 129 ----------------------------------------- 6 files changed, 385 deletions(-) delete mode 100644 pascal/.gitignore delete mode 100644 pascal/README.md delete mode 100644 pascal/ROSE.PAS delete mode 100644 pascal/ROSE_T.PAS delete mode 100644 pascal/TEXTTEST.PAS delete mode 100644 pascal/TPUNIT.PAS diff --git a/pascal/.gitignore b/pascal/.gitignore deleted file mode 100644 index 76fb8f67..00000000 --- a/pascal/.gitignore +++ /dev/null @@ -1,11 +0,0 @@ - -syntax: glob -*.bak -*.BAK -*.tpu -*.TPU -*.exe -*.EXE -*.$$$ -*.DSK -*.TP diff --git a/pascal/README.md b/pascal/README.md deleted file mode 100644 index ef3e3985..00000000 --- a/pascal/README.md +++ /dev/null @@ -1,19 +0,0 @@ -# Pascal port of the Gilded-Rose Kata - -This is a (Turbo) Pascal port of the *Gilded-Rose-Kata*. - -## Building and Running - -* Compile the unit `ROSE.PAS`, this is the Gilded Rose Logic. -* Compile the application `TEXTTEST.PAS` for the Texttest fixture. -* Run `TEXTTEST`. - -## Unit Test - -`TPUNIT.PAS` is a minimalist implementation of xUnit in Pascal style. -There are several assertions available, e.g. `AssertEquals`, `AssertEqualsStr`, `AssertTrue` etc. -It needs _Far Calls_ enabled in compiler options. - -* First compile the unit `TPUNIT.PAS`. -* Then compile application `ROSE_T.PAS`. -* Run `ROSE_T` to run the tests. diff --git a/pascal/ROSE.PAS b/pascal/ROSE.PAS deleted file mode 100644 index f78f3057..00000000 --- a/pascal/ROSE.PAS +++ /dev/null @@ -1,137 +0,0 @@ -unit Rose; - -interface - -type - Item = record { 260b memory } - Name: string; - SellIn: Integer; - Quality: Integer; - end; - - Items = array [0..251] of Item; { 64kb memory } - - ListOfItems = record - Elements: ^Items; - Length: Word; - end; - -procedure ResizeList(var List: ListOfItems; Size: Word); - -procedure ClearList(var List: ListOfItems); - -procedure InitItem(var Item: Item; Name: string; SellIn: Integer; Quality: Integer); - -function StrItem(Item: Item): string; - -procedure UpdateQuality(Items: ListOfItems); - -implementation - -procedure ResizeList(var List: ListOfItems; Size: Word); -begin - List.Length := Size; - GetMem(List.Elements, Size * SizeOf(Item)); -end; - -procedure ClearList(var List: ListOfItems); -begin - FreeMem(List.Elements, List.Length * SizeOf(Item)); - List.Length := 0; -end; - -procedure InitItem(var Item: Item; Name: string; SellIn: Integer; Quality: Integer); -begin - Item.Name := Name; - Item.SellIn := SellIn; - Item.Quality := Quality; -end; - -function StrItem(Item: Item): string; -var SellInStr: string; - QualityStr: string; -begin - Str(Item.SellIn, SellInStr); - Str(Item.Quality, QualityStr); - StrItem := Item.Name + ', ' + SellInStr + ', ' + QualityStr; -end; - -procedure UpdateQuality(Items: ListOfItems); -var I: Word; -begin - for I := 0 to Items.Length-1 do - begin - if (Items.Elements^[I].Name <> 'Aged Brie') and - (Items.Elements^[I].Name <> 'Backstage passes to a TAFKAL80ETC concert') then - begin - if Items.Elements^[I].Quality > 0 then - begin - if Items.Elements^[I].Name <> 'Sulfuras, Hand of Ragnaros' then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality - 1; - end; - end; - end - else - begin - if Items.Elements^[I].Quality < 50 then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality + 1; - - if Items.Elements^[I].Name = 'Backstage passes to a TAFKAL80ETC concert' then - begin - if Items.Elements^[I].SellIn < 11 then - begin - if Items.Elements^[I].Quality < 50 then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality + 1; - end; - end; - - if Items.Elements^[I].SellIn < 6 then - begin - if Items.Elements^[I].Quality < 50 then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality + 1; - end; - end; - end; - end; - end; - - if Items.Elements^[I].Name <> 'Sulfuras, Hand of Ragnaros' then - begin - Items.Elements^[I].SellIn := Items.Elements^[I].SellIn - 1; - end; - - if Items.Elements^[I].SellIn < 0 then - begin - if Items.Elements^[I].Name <> 'Aged Brie' then - begin - if Items.Elements^[I].Name <> 'Backstage passes to a TAFKAL80ETC concert' then - begin - if Items.Elements^[I].Quality > 0 then - begin - if Items.Elements^[I].Name <> 'Sulfuras, Hand of Ragnaros' then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality - 1; - end; - end; - end - else - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality - Items.Elements^[I].Quality; - end; - end - else - begin - if Items.Elements^[I].Quality < 50 then - begin - Items.Elements^[I].Quality := Items.Elements^[I].Quality + 1; - end; - end; - end; - end; -end; - -end. diff --git a/pascal/ROSE_T.PAS b/pascal/ROSE_T.PAS deleted file mode 100644 index 87b6679e..00000000 --- a/pascal/ROSE_T.PAS +++ /dev/null @@ -1,29 +0,0 @@ -{F+} { need to set Far Calls in Compiler Options too } -program Rose_T; - -uses TPUnit, Rose; - -var Items: ListOfItems; - -procedure CreateItem; -begin - ResizeList(Items, 1); -end; - -procedure DisposeItem; -begin - ClearList(Items); -end; - -procedure Foo; -begin - InitItem(Items.Elements^[0], 'foo', 0, 0); - - UpdateQuality(Items); - - AssertEqualsStr('name', 'fixme', Items.Elements^[0].Name); -end; - -begin - RunFixtures('foo', CreateItem, Foo, DisposeItem); -end. diff --git a/pascal/TEXTTEST.PAS b/pascal/TEXTTEST.PAS deleted file mode 100644 index dc06febc..00000000 --- a/pascal/TEXTTEST.PAS +++ /dev/null @@ -1,60 +0,0 @@ -program TextTests; - -uses Rose; - -var Items: ListOfItems; - Last: Word; - Days, Day: Integer; - ErrorCode: Integer; - DayStr: string; - I: Word; -begin - WriteLn('OMGHAI!'); - - ResizeList(Items, 9); - - Last := 0; - InitItem(Items.Elements^[Last], '+5 Dexterity Vest', 10, 20); - Inc(Last); - InitItem(Items.Elements^[Last], 'Aged Brie', 2, 0); - Inc(Last); - InitItem(Items.Elements^[Last], 'Elixir of the Mongoose', 5, 7); - Inc(Last); - InitItem(Items.Elements^[Last], 'Sulfuras, Hand of Ragnaros', 0, 80); - Inc(Last); - InitItem(Items.Elements^[Last], 'Sulfuras, Hand of Ragnaros', -1, 80); - Inc(Last); - InitItem(Items.Elements^[Last], 'Backstage passes to a TAFKAL80ETC concert', 15, 20); - Inc(Last); - InitItem(Items.Elements^[Last], 'Backstage passes to a TAFKAL80ETC concert', 10, 49); - Inc(Last); - InitItem(Items.Elements^[Last], 'Backstage passes to a TAFKAL80ETC concert', 5, 49); - Inc(Last); - { this Conjured item doesn't yet work properly } - InitItem(Items.Elements^[Last], 'Conjured Mana Cake', 3, 6); - Inc(Last); - Items.Length := Last; - - Days := 2; - if ParamCount > 0 then - begin - Val(ParamStr(1), Days, ErrorCode); - Inc(Days); - end; - - for Day := 0 to Days-1 do - begin - Str(Day, DayStr); - WriteLn('-------- day ' + DayStr + ' --------'); - WriteLn('name, sellIn, quality'); - for I := 0 to Items.Length-1 do - begin - WriteLn(StrItem(Items.Elements^[I])); - end; - WriteLn(''); - - UpdateQuality(Items); - end; - - ClearList(Items); -end. diff --git a/pascal/TPUNIT.PAS b/pascal/TPUNIT.PAS deleted file mode 100644 index 01235de4..00000000 --- a/pascal/TPUNIT.PAS +++ /dev/null @@ -1,129 +0,0 @@ -{F+} { need to set Far Calls in Compiler Options too } -(* ------------------------------------------------------------------ *) -(* Minimalist xUnit implementation for Turbo Pascal in TP style. *) -(* Version: 2.01 *) -(* Language: Turbo Pascal 6.01 *) -(* Copyright: (c) 2010 Peter Kofler, www.code-cop.org *) -(* License: BSD, http://www.opensource.org/licenses/bsd-license.php *) -(* ------------------------------------------------------------------ *) -unit TPUnit; - -interface - -{ - uses TPUnit; - - Tests are added as methods without arguments to the test - program as usual and use asserts provided by the unit. - The first failed assertion stops program execution. - - procedure TestAddition; - begin - AssertEquals('use asserts in tests', 2, 1 + 1); - end; - - Due to the lack of introspection each test has to - be called manually in the main body. - - begin - RunTest('TestAddition', TestAddition); - end. -} - -type - TestMethod = procedure; - -{ Asserts } -procedure AssertEquals(Message: string; Expected, Actual: Longint); -procedure AssertEqualsStr(Message: string; Expected, Actual: string); -procedure AssertNotNil(Message: string; Actual: Pointer); -procedure AssertNil(Message: string; Actual: Pointer); -procedure AssertTrue(Message: string; Actual: Boolean); -procedure AssertFalse(Message: string; Actual: Boolean); -procedure Fail(Message: string); - -{ Test Runner } -procedure RunTest(Name: string; Test: TestMethod); -procedure RunFixtures(Name: string; SetUp, Test, TearDown: TestMethod); -procedure Empty; - -implementation - -uses Crt; - -procedure AssertEquals(Message: string; Expected, Actual: Longint); -var ExpectedStr, ActualStr: string; -begin - if Expected <> Actual then - begin - Str(Expected, ExpectedStr); - Str(Actual, ActualStr); - Fail(Concat(Message, ' Expected ', ExpectedStr, ' but was ', ActualStr)); - end; -end; - -procedure AssertEqualsStr(Message: string; Expected, Actual: string); -begin - if Expected <> Actual then - begin - Fail(Concat(Message, ' Expected ', Expected, ' but was ', Actual)); - end; -end; - -procedure AssertNotNil(Message: string; Actual: Pointer); -begin - AssertFalse(Message, Actual = nil); -end; - -procedure AssertNil(Message: string; Actual: Pointer); -begin - AssertTrue(Message, Actual = nil); -end; - -procedure AssertTrue(Message: string; Actual: Boolean); -begin - if not Actual then - begin - Fail(Message); - end; -end; - -procedure AssertFalse(Message: string; Actual: Boolean); -begin - AssertTrue(Message, not Actual); -end; - -procedure Fail(Message: string); -begin - TextColor(Red); - WriteLn(' - FAILED'); - NormVideo; - WriteLn(Message); - - Halt(1); -end; - -procedure Empty; -begin -end; - -procedure RunTest(Name: string; Test: TestMethod); -begin - RunFixtures(Name, Empty, Test, Empty); -end; - -procedure RunFixtures(Name: string; SetUp, Test, TearDown: TestMethod); -begin - Write('TEST ', Name); - SetUp; - Test; - TearDown; - - TextColor(Green); - WriteLn(' - OK'); - NormVideo; -end; - -begin - Crt.ClrScr; -end.