Browse code
Add test suite skeleton.
Andrew Alderwick authored on 22/03/2021 09:21:19
Showing 1 changed files
| 1 | 1 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,90 @@ |
| 1 |
+|0100 ;Console { pad 8 char 1 byte 1 short 2 }
|
|
| 2 |
+|0110 ;Screen { width 2 height 2 pad 4 x 2 y 2 color 1 }
|
|
| 3 |
+|0120 ;Sprite { pad 8 x 2 y 2 addr 2 color 1 }
|
|
| 4 |
+|0130 ;Controller { buttons 1 }
|
|
| 5 |
+|0140 ;Keys { key 1 }
|
|
| 6 |
+|0150 ;Mouse { x 2 y 2 state 1 chord 1 }
|
|
| 7 |
+|0160 ;File { pad 8 name 2 length 2 load 2 save 2 }
|
|
| 8 |
+|01F0 .RESET .FRAME .ERROR ( vectors ) |
|
| 9 |
+|01F8 [ f07c f0e2 f0c2 ] ( palette ) |
|
| 10 |
+ |
|
| 11 |
+%TEST { BRK2?r LITr EOR2? DUP? }
|
|
| 12 |
+ |
|
| 13 |
+%PASS { #01 ,result JSR2 }
|
|
| 14 |
+%FAIL { #00 ,result JSR2 }
|
|
| 15 |
+%PASS? { ,result JSR2 }
|
|
| 16 |
+ |
|
| 17 |
+|0200 |
|
| 18 |
+ |
|
| 19 |
+@tests |
|
| 20 |
+ TEST ADD FAIL [ add-needs-two ] |
|
| 21 |
+ TEST #01 ADD FAIL [ add-needs-two ] |
|
| 22 |
+ TEST #01 #02 ADD #03 EQU PASS? [ add-result ] |
|
| 23 |
+ TEST #01 #02 ADD #ff EQU PASS? [ this-test-fails ] |
|
| 24 |
+ |
|
| 25 |
+ ( infinite loop: change to HCF when implemented ) |
|
| 26 |
+ TEST #fd JMP |
|
| 27 |
+ |
|
| 28 |
+@RESET |
|
| 29 |
+ ,tests #0001 SUB2 =current-test |
|
| 30 |
+ BRK |
|
| 31 |
+ |
|
| 32 |
+@ERROR BRK |
|
| 33 |
+ |
|
| 34 |
+@FRAME |
|
| 35 |
+ ~current-test |
|
| 36 |
+ |
|
| 37 |
+ $search |
|
| 38 |
+ #0001 ADD2 |
|
| 39 |
+ DUP2 LDR LIT BRK2?r NEQ ,$search ROT JMP2? |
|
| 40 |
+ DUP2 #0001 ADD2 LDR LIT LITr NEQ ,$search ROT JMP2? |
|
| 41 |
+ DUP2 #0002 ADD2 LDR LIT EOR2? NEQ ,$search ROT JMP2? |
|
| 42 |
+ DUP2 #0003 ADD2 LDR LIT DUP? NEQ ,$search ROT JMP2? |
|
| 43 |
+ #0004 ADD2 DUP2 =current-test |
|
| 44 |
+ JMP2 |
|
| 45 |
+ |
|
| 46 |
+@result |
|
| 47 |
+ ,strings-test ^print-string JSR |
|
| 48 |
+ #00 SWP ,strings-pass ,strings-fail SUB2 MUL2 ,strings-fail ADD2 ^print-string JSR |
|
| 49 |
+ STH2r DUP2 ^print-short JSR |
|
| 50 |
+ ,strings-colon ^print-string JSR |
|
| 51 |
+ ^print-string JSR |
|
| 52 |
+ #0a =Console.char |
|
| 53 |
+ BRK |
|
| 54 |
+ |
|
| 55 |
+@print-string ( stringâ‚‚ -- ) |
|
| 56 |
+ DUP2 LDR DUP |
|
| 57 |
+ ,$not-end ROT JMP2? |
|
| 58 |
+ |
|
| 59 |
+ $end |
|
| 60 |
+ POP POP2 JMP2r |
|
| 61 |
+ |
|
| 62 |
+ $not-end |
|
| 63 |
+ DUP LIT BRK2?r EQU ,$end ROT JMP2? |
|
| 64 |
+ =Console.char |
|
| 65 |
+ #0001 ADD2 ^print-string JMP |
|
| 66 |
+ |
|
| 67 |
+@print-short ( shortâ‚‚ -- ) |
|
| 68 |
+ #30 =Console.char |
|
| 69 |
+ #78 =Console.char |
|
| 70 |
+ DUP2 #000c SFT2 ^$digit JSR |
|
| 71 |
+ DUP2 #0008 SFT2 ^$digit JSR |
|
| 72 |
+ DUP2 #0004 SFT2 ^$digit JSR |
|
| 73 |
+ ^$digit JSR |
|
| 74 |
+ JMP2r |
|
| 75 |
+ |
|
| 76 |
+ $digit |
|
| 77 |
+ #0f AND DUP #0a LTH #03 SWP JMP? |
|
| 78 |
+ #27 ADD |
|
| 79 |
+ #30 ADD =Console.char |
|
| 80 |
+ POP |
|
| 81 |
+ JMP2r |
|
| 82 |
+ |
|
| 83 |
+@strings |
|
| 84 |
+ $test [ Test 20 00 ] |
|
| 85 |
+ $fail [ FAIL 20 at 20 00 ] |
|
| 86 |
+ $pass [ pass 20 at 20 00 ] |
|
| 87 |
+ $colon [ : 20 00 ] |
|
| 88 |
+ |
|
| 89 |
+;current-test { short 2 }
|
|
| 90 |
+ |