add a lot of tests and fix some small bugs

ix · Jun 2, 2019 · a817215 · a817215
1 parent 518499e
commit a817215
Show file tree

Hide file tree

Showing 5 changed files with 171 additions and 7 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -1,5 +1,8 @@
 # Changelog for Lazyboy
 
+# 0.2.1.1
+- Added a lot of instruction tests and fix some bugs.
+
 # 0.2.1.0
 - Added compound conditionals, including boolean AND, OR support.
 - Added tests for conditionals.

diff --git a/lazyboy.cabal b/lazyboy.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d0d039b69a551f40ce9cab9d6d51727d21bfeaaf2be3b1fe392501ec4f8eebd5
+-- hash: 4e2f866c2ce7b498a6ca6022a042bf2cacb83928127a1e6c802abd72499ef0d8
 
 name:           lazyboy
-version:        0.2.1.0
+version:        0.2.1.1
 synopsis:       An EDSL for programming the Game Boy.
 description:    An EDSL for programming the Nintendo Game Boy. <https://github.com/ix/lazyboy#readme>
 category:       DSL, Compiler

diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 name:                lazyboy
-version:             0.2.1.0
+version:             0.2.1.1
 github:              "ix/lazyboy"
 license:             BSD3
 author:              "Rose"

diff --git a/src/Lazyboy/Target/ASM.hs b/src/Lazyboy/Target/ASM.hs
@@ -82,7 +82,7 @@ instance Show Instruction where
     show (LDrrnn PC _) = throw AttemptedAFPCLoad
     show (LDrrnn r1 v1)  = printf "ld %s, %s" r1 v1
 
-    show (LDSPHL) = printf "%ld SP, HL"
+    show (LDSPHL) = printf "ld SP, HL"
 
     -- stack manipulation
     show (PUSH SP) = throw InvalidStackOperation
@@ -103,8 +103,8 @@ instance Show Instruction where
     show (JPif c v1@(Name (Local _))) = printf "jr %s, %s" c v1
 
     -- call and return
-    show (CALL v1) = printf "call $%X" v1
-    show (CALLif c v1) = printf "call %s, $%X" c v1
+    show (CALL v1) = printf "call %s" v1
+    show (CALLif c v1) = printf "call %s, %s" c v1
     show (RET) = printf "ret"
     show (RETif c) = printf "ret %s" c
     show (RETi) = printf "reti"

diff --git a/test/Spec.hs b/test/Spec.hs
@@ -35,6 +35,29 @@ main = hspec $ do
                 pack (BackgroundPalette White White White White) `shouldBe` 0
             it "correctly packs other BackgroundPalettes" $ do
                 pack (BackgroundPalette White Light White White) `shouldBe` 16
+        describe "disableLCD" $ do 
+            it "turns off the lcd" $ do
+                let program = map show $ execLazyboy disableLCD
+                program `shouldBe` ["ld HL, $FF40", "ld [HL], 0"]
+        describe "setLCDControl" $ do
+            it "sets the lcd status" $ do
+                let program = map show $ execLazyboy $ setLCDControl $ defaultLCDControl { lcdBackgroundEnable = True }
+                program `shouldBe` ["ld HL, $FF40", "ld [HL], 1"]
+        describe "byte" $ do
+            it "writes a byte into a register" $ do
+                let program = map show $ execLazyboy $ byte A 90
+                program `shouldBe` ["ld A, 90"] 
+        describe "setBackgroundPalette" $ do
+            it "sets the background palette" $ do
+                let def = map show $ execLazyboy $ setBackgroundPalette defaultPalette
+                let alt = map show $ execLazyboy $ setBackgroundPalette $ BackgroundPalette White Light Dark Black
+                def `shouldBe` ["ld HL, $FF47", "ld [HL], 228"]
+                alt `shouldBe` ["ld HL, $FF47", "ld [HL], 27"]
+        describe "onVblank" $ do
+            it "waits for vblank before calling some code" $ do
+                let program = map show $ execLazyboy $ onVblank $ return ()
+                program `shouldBe` [".L1:", "ld A, [$FF44]", "cp A, 145", "jr nz, .L1"]
+
 
     describe "Lazyboy.Types.execLazyboy" $ do
         it "compiles nested sequences in order" $ do
@@ -168,7 +191,6 @@ main = hspec $ do
                                    , "or A, L"
                                    , "jr z, .L3"
                                    , ".L3:" ]
-
 
     describe "Lazyboy.Target.ASM" $ do
         describe "show" $ do
@@ -215,3 +237,142 @@ main = hspec $ do
             it "formats embedded byte sequences correctly" $ do
                 let program = map show $ execLazyboy $ tell [BYTES [97, 98]]
                 program `shouldBe` ["db $61,$62" ]
+            it "formats all other instructions correctly" $ do
+                show (LDrr A B) `shouldBe` "ld A, B"
+                show (LDrn C 5) `shouldBe` "ld C, 5"
+                show (LDrHL A) `shouldBe` "ld A, [HL]"
+                show (LDHLr B) `shouldBe` "ld [HL], B"
+                show (LDHLn 1) `shouldBe` "ld [HL], 1"
+                show (LDArr BC) `shouldBe` "ld A, [BC]"
+                show (LDArr DE) `shouldBe` "ld A, [DE]"
+                show (LDArr HL) `shouldBe` "ld A, [HL]"
+                show (LDrrA BC) `shouldBe` "ld [BC], A"
+                show (LDrrA DE) `shouldBe` "ld [DE], A"
+                show (LDrrA HL) `shouldBe` "ld [HL], A"
+                show (LDAnn (Address 55)) `shouldBe` "ld A, [$37]" 
+                show (LDnnA (Address 55)) `shouldBe` "ld [$37], A"
+                show (LDAIO 0) `shouldBe` "ldh A, [$FF00+$0]"
+                show (LDIOA 1) `shouldBe` "ldh [$FF00+$1], A"
+                show (LDAIOC) `shouldBe` "ldh A, [$FF00+C]"
+                show (LDIOCA) `shouldBe` "ldh [$FF00+C], A"
+                show (LDHLAI) `shouldBe` "ld [HL+], A"
+                show (LDAHLI) `shouldBe` "ld A, [HL+]"
+                show (LDrrnn BC (Address 7)) `shouldBe` "ld BC, $7"
+                show (LDSPHL) `shouldBe` "ld SP, HL"
+                show (PUSH BC) `shouldBe` "PUSH BC"
+                show (POP HL) `shouldBe` "POP HL"
+                show (JP (Address 43)) `shouldBe` "jp $2B"
+                show (JP (Name (Global 1))) `shouldBe` "jp L1"
+                show (JP (Name (Local 40))) `shouldBe` "jr .L40"
+                show (JPHL) `shouldBe` "jp HL"
+                show (JPif Zero (Address 100)) `shouldBe` "jp z, $64"
+                show (JPif NoCarry (Name (Global 20))) `shouldBe` "jp nc, L20"
+                show (JPif NonZero (Name (Local 4))) `shouldBe` "jr nz, .L4"
+                show (CALL (Address 50)) `shouldBe` "call $32"
+                show (CALLif Zero (Address 50)) `shouldBe` "call z, $32"
+                show (RET) `shouldBe` "ret"
+                show (RETif NonZero) `shouldBe` "ret nz"
+                show (RETi) `shouldBe` "reti"
+                show (ADDAr C) `shouldBe` "add A, C"
+                show (ADDAn 25) `shouldBe` "add A, 25"
+                show (ADDHL) `shouldBe` "add A, [HL]"
+                show (ADCAr L) `shouldBe` "adc A, L"
+                show (ADCAn 4) `shouldBe` "adc A, 4"
+                show (ADCHL) `shouldBe` "adc A, [HL]"
+                show (SUBAr A) `shouldBe` "sub A, A"
+                show (SUBAn 9) `shouldBe` "sub A, 9"
+                show (SUBHL) `shouldBe` "sub A, [HL]"
+                show (SBCAr B) `shouldBe` "sbc A, B"
+                show (SBCAn 3) `shouldBe` "sbc A, 3"
+                show (SBCAHL) `shouldBe` "sbc A, [HL]"
+                show (ANDr C) `shouldBe` "and A, C"
+                show (ANDn 1) `shouldBe` "and A, 1"
+                show (ANDHL) `shouldBe` "and A, [HL]"
+                show (XORr A) `shouldBe` "xor A, A"
+                show (XORn 1) `shouldBe` "xor A, 1"
+                show (XORHL) `shouldBe` "xor A, [HL]"
+                show (ORr C) `shouldBe` "or A, C"
+                show (ORn 10) `shouldBe` "or A, 10"
+                show (ORHL) `shouldBe` "or A, [HL]"
+                show (CPr B) `shouldBe` "cp A, B"
+                show (CPn 9) `shouldBe` "cp A, 9"
+                show (CPHL) `shouldBe` "cp A, [HL]"
+                show (INCr A) `shouldBe` "inc A" 
+                show (INCHL) `shouldBe` "inc [HL]"
+                show (DECr C) `shouldBe` "dec C"
+                show (DECHL) `shouldBe` "dec [HL]"
+                show (DAA) `shouldBe` "daa"
+                show (CPL) `shouldBe` "cpl"
+                show (ADDHLrr BC) `shouldBe` "add HL, BC"
+                show (ADDHLrr DE) `shouldBe` "add HL, DE"
+                show (ADDHLrr HL) `shouldBe` "add HL, HL"
+                show (ADDHLrr SP) `shouldBe` "add HL, SP"
+                show (INCrr BC) `shouldBe` "inc BC"
+                show (INCrr DE) `shouldBe` "inc DE"
+                show (INCrr HL) `shouldBe` "inc HL"
+                show (INCrr SP) `shouldBe` "inc SP"
+                show (DECrr BC) `shouldBe` "dec BC"
+                show (DECrr DE) `shouldBe` "dec DE"
+                show (DECrr HL) `shouldBe` "dec HL"
+                show (DECrr SP) `shouldBe` "dec SP"
+                show (RLCA) `shouldBe` "rlca"
+                show (RLA) `shouldBe` "rla"
+                show (RRCA) `shouldBe` "rrca"
+                show (RRA) `shouldBe` "rra"
+                show (RLC A) `shouldBe` "rlc A"
+                show (RLCHL) `shouldBe` "rlc [HL]"
+                show (RL C) `shouldBe` "rl C"
+                show (RLHL) `shouldBe` "rl [HL]"
+                show (RRC A) `shouldBe` "rrc A"
+                show (RRCHL) `shouldBe` "rrc [HL]"
+                show (RR B) `shouldBe` "rr B"
+                show (RRHL) `shouldBe` "rr [HL]"
+                show (SLA B) `shouldBe` "sla B"
+                show (SLAHL) `shouldBe` "sla [HL]"
+                show (SWAP B) `shouldBe` "swap B"
+                show (SWAPHL) `shouldBe` "swap [HL]"
+                show (SRA B) `shouldBe` "sra B"
+                show (SRAHL) `shouldBe` "sra [HL]"
+                show (SRL B) `shouldBe` "srl B"
+                show (SRLHL) `shouldBe` "srl [HL]"
+                show (CCF) `shouldBe` "ccf"
+                show (SCF) `shouldBe` "scf"
+                show (NOP) `shouldBe` "nop"
+                show (HALT) `shouldBe` "halt"
+                show (STOP) `shouldBe` "stop"
+                show (DI) `shouldBe` "di"
+                show (EI) `shouldBe` "ei"
+
+                -- these throw
+                disallow $ show $ LDArr AF
+                disallow $ show $ LDrrA AF
+                disallow $ show $ LDrrnn AF $ Address 0
+                disallow $ show $ LDrrnn PC $ Name $ Local 1
+                disallow $ show $ PUSH SP
+                disallow $ show $ PUSH PC
+                disallow $ show $ POP SP
+                disallow $ show $ POP PC
+                disallow $ show $ ADDHLrr AF
+                disallow $ show $ INCrr AF
+                disallow $ show $ DECrr AF
+
+    describe "Lazyboy.Constants" $ do
+        it "has valid constants" $ do
+            wram0 `shouldBe` 0xC000
+            wram1 `shouldBe` 0xD000
+            joypad `shouldBe` 0xFF00
+            lcdc `shouldBe` 0xFF40
+            lcdstate `shouldBe` 0xFF41
+            scx `shouldBe` 0xFF42
+            scy `shouldBe` 0xFF43
+            ly `shouldBe` 0xFF44
+            lyc `shouldBe` 0xFF45
+            dma `shouldBe` 0xFF46
+            bgp `shouldBe` 0xFF47
+            vram `shouldBe` 0x8000
+            background1 `shouldBe` 0x9800
+            background2 `shouldBe` 0x9C00
+            hram `shouldBe` 0xFF80
+            oam `shouldBe` 0xFE00
+            screenWidth `shouldBe` 160
+            screenHeight `shouldBe` 144