lazyboy-0.2.1.1: test/Spec.hs
{-|
Module : Main (Test)
Description : Test suite for Lazyboy
Copyright : (c) Rose 2019
License : BSD3
Maintainer : rose@lain.org.uk
Stability : experimental
Portability : POSIX
A test suite for Lazyboy.
-}
import Control.Exception (evaluate)
import Data.Word
import Lazyboy
import Lazyboy.Target.ASM
import Test.Hspec
disallow cmd = evaluate cmd `shouldThrow` anyException
main :: IO ()
main = hspec $ do
describe "Lazyboy.IO" $ do
context "when asked to pack an LCDControl" $ do
it "packs an LCDControl of all False values to 0" $ do
pack defaultLCDControl `shouldBe` 0
it "packs an LCDControl with background and display enabled to 129" $ do
pack (LCDControl True False False False False False False True) `shouldBe` 129
it "packs other LCDControls correctly" $ do
pack (defaultLCDControl { lcdEnableObjects = True }) `shouldBe` 2
context "when asked to pack a BackgroundPalette" $ do
it "packs a BackgroundPalette of all-black to 255" $ do
pack (BackgroundPalette Black Black Black Black) `shouldBe` 255
it "packs a BackgroundPalette of all-white to 0" $ 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
let sequence = execLazyboy $ do
write (Address 0x2000) 0x97
write (Address 0x1000) 0x98
sequence `shouldBe` [LDrrnn HL (Address 0x2000), LDHLn 0x97, LDrrnn HL (Address 0x1000), LDHLn 0x98]
describe "Lazyboy.Control" $ do
describe "cond" $ do
it "correctly implements conditionals" $ do
let program = execLazyboy $ do
cond NonZero $ do
freeze
program `shouldBe` [JPif NonZero $ Name $ Local 1, LABEL $ Global 2, DI, HALT, JP $ Name $ Global 2, LABEL $ Local 1]
it "handles nested conditionals correctly" $ do
let program = execLazyboy $ do
cond Zero $ do
cond NonZero $ do
freeze
program `shouldBe` [ JPif Zero $ Name $ Local 1
, JPif NonZero $ Name $ Local 2
, LABEL $ Global 3
, DI
, HALT
, JP $ Name $ Global 3
, LABEL $ Local 2
, LABEL $ Local 1
]
describe "withLabel" $ do
it "creates an appropriately formatted global label" $ do
let program = map show $ execLazyboy $ do
withLabel $ \label -> do
write (Address 0xC000) 0x97
program `shouldBe` [ "L1:"
, "ld HL, $C000"
, "ld [HL], 151"
]
describe "withLocalLabel" $ do
it "creates an appropriately formatted local label" $ do
let program = map show $ execLazyboy $ do
withLocalLabel $ \label -> do
write (Address 0xC000) 0x97
program `shouldBe` [ ".L1:"
, "ld HL, $C000"
, "ld [HL], 151"
]
describe "embedImage" $ do
it "leverages RGBASM to include a binary" $ do
let program = execLazyboy $ embedImage "test.bin"
program `shouldBe` [JP $ Name $ Global 2, LABEL $ Global 1, INCLUDE "test.bin", LABEL $ Global 2]
describe "embedBytes" $ do
it "defines a raw sequence of bytes" $ do
let program = execLazyboy $ embedBytes [0x00, 0x01, 0x02]
program `shouldBe` [JP $ Name $ Global 2, LABEL $ Global 1, BYTES [0x00, 0x01, 0x02], LABEL $ Global 2]
describe "not" $ do
it "inverts a given condition flag" $ do
let flags = map ((\f -> fst $ evalRWS f () 1) . Lazyboy.not . return) [Zero, NonZero, Carry, NoCarry]
flags `shouldBe` [NonZero, Zero, NoCarry, Carry]
describe "equalTo" $ do
it "checks equality between two values" $ do
let ab = map show $ execLazyboy $ A `equalTo` B
let bc = map show $ execLazyboy $ B `equalTo` C
let an = map show $ execLazyboy $ A `equalTo` (5 :: Word8)
let nc = map show $ execLazyboy $ (100 :: Word8) `equalTo` C
ab `shouldBe` ["cp A, B"]
bc `shouldBe` ["ld A, B", "cp A, C"]
an `shouldBe` ["cp A, 5"]
nc `shouldBe` ["ld A, C", "cp A, 100"]
describe "notEqualTo" $ do
it "checks inequality between two values" $ do
let ab = map show $ execLazyboy $ A `notEqualTo` B
let bc = map show $ execLazyboy $ B `notEqualTo` C
let an = map show $ execLazyboy $ A `notEqualTo` (5 :: Word8)
let nc = map show $ execLazyboy $ (100 :: Word8) `notEqualTo` C
ab `shouldBe` ["cp A, B"]
bc `shouldBe` ["ld A, B", "cp A, C"]
an `shouldBe` ["cp A, 5"]
nc `shouldBe` ["ld A, C", "cp A, 100"]
describe "greaterThan" $ do
it "checks greater of two values" $ do
let ab = map show $ execLazyboy $ A `greaterThan` B
let bc = map show $ execLazyboy $ B `greaterThan` C
let an = map show $ execLazyboy $ A `greaterThan` (5 :: Word8)
let nc = map show $ execLazyboy $ (100 :: Word8) `greaterThan` C
ab `shouldBe` ["cp A, B"]
bc `shouldBe` ["ld A, B", "cp A, C"]
an `shouldBe` ["cp A, 5"]
nc `shouldBe` ["ld A, C", "cp A, 100"]
describe "lessThan" $ do
it "checks lesser of two values" $ do
let ab = map show $ execLazyboy $ A `lessThan` B
let bc = map show $ execLazyboy $ B `lessThan` C
let an = map show $ execLazyboy $ A `lessThan` (5 :: Word8)
let nc = map show $ execLazyboy $ (100 :: Word8) `lessThan` C
ab `shouldBe` ["cp A, B"]
bc `shouldBe` ["ld A, B", "cp A, C"]
an `shouldBe` ["cp A, 5"]
nc `shouldBe` ["ld A, C", "cp A, 100"]
describe "if'" $ do
it "provides conditional execution for more complex conditions" $ do
let program = map show $ execLazyboy $ if' (A `lessThan` B) $ return ()
program `shouldBe` ["cp A, B", "jr c, .L1", ".L1:"]
describe "and" $ do
it "implements boolean AND for conditionals" $ do
let program = map show $ execLazyboy $ if' ((B `greaterThan` C) `Lazyboy.and` (A `equalTo` B)) $ return ()
program `shouldBe` [ "ld A, B"
, "cp A, C"
, "jr nc, .L1"
, "ld L, 1"
, ".L1:"
, "cp A, B"
, "jr nz, .L2"
, "ld A, 1"
, ".L2:"
, "and A, L"
, "jr z, .L3"
, ".L3:" ]
describe "or" $ do
it "implements boolean OR for conditionals" $ do
let program = map show $ execLazyboy $ if' ((C `greaterThan` (5 :: Word8)) `Lazyboy.or` (A `equalTo` C)) $ return ()
program `shouldBe` [ "ld A, C"
, "cp A, 5"
, "jr nc, .L1"
, "ld L, 1"
, ".L1:"
, "cp A, C"
, "jr nz, .L2"
, "ld A, 1"
, ".L2:"
, "or A, L"
, "jr z, .L3"
, ".L3:" ]
describe "Lazyboy.Target.ASM" $ do
describe "show" $ do
it "disallows loading [AF] into A" $ do
disallow (show $ LDArr AF)
it "disallows loading [SP] into A" $ do
disallow (show $ LDArr SP)
it "disallows loading [PC] into A" $ do
disallow (show $ LDArr PC)
it "disallows loading A into [AF]" $ do
disallow (show $ LDrrA AF)
it "disallows loading A into [SP]" $ do
disallow (show $ LDrrA SP)
it "disallows loading A into [PC]" $ do
disallow (show $ LDrrA PC)
it "disallows loading a 16 bit value into AF" $ do
disallow $ show $ LDrrnn AF $ Address 0x00
it "disallows loading a 16 bit value into PC" $ do
disallow $ show $ LDrrnn PC $ Address 0x00
it "disallows pushing stack pointer" $ do
disallow (show $ PUSH SP)
it "disallows pushing program counter" $ do
disallow (show $ PUSH PC)
it "disallows popping stack pointer" $ do
disallow (show $ POP SP)
it "disallows popping program counter" $ do
disallow (show $ POP PC)
it "disallows an invalid RST vector value" $ do
disallow (show $ RST 0x02)
it "disallows adding AF to HL" $ do
disallow (show $ ADDHLrr AF)
it "disallows adding PC to HL" $ do
disallow (show $ ADDHLrr PC)
it "disallows incrementing AF" $ do
disallow (show $ INCrr AF)
it "disallows incrementing PC" $ do
disallow (show $ INCrr PC)
it "disallows decrementing AF" $ do
disallow (show $ DECrr AF)
it "disallows decrementing PC" $ do
disallow (show $ DECrr PC)
it "enforces only 3-bit values can be passed to BIT instructions" $ do
disallow (show $ BITnr 0x80 A)
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