Add expect-based PB tests and CI

.github/workflows/ci.yml

@@ -0,0 +1,26 @@
+name: CI
+
+on:
+  push:
+    branches: [ work ]
+  pull_request:
+
+jobs:
+  build:
+    strategy:
+      matrix:
+        racket-version: ["stable"]
+        arch: ["x64", "arm64"]
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - uses: Bogdanp/setup-racket@v1.12
+        with:
+          architecture: ${{ matrix.arch }}
+          distribution: full
+          variant: "CS"
+          version: ${{ matrix.racket-version }}
+      - name: Install package
+        run: raco pkg install --auto --no-docs
+      - name: Run tests
+        run: raco test tests/main.rkt

README.md

@@ -52,6 +52,17 @@ file:
 > (dump const "file.bin")
 ```
 
+To run the expect-based test suite locally:
+
+```
+raco test tests/main.rkt
+```
+
+The tests use the `recspecs` library to compare disassembly output.  If
+`nasm` is available, additional checks are run.  A GitHub Actions
+workflow automatically runs the same tests on both x64 and arm64
+architectures for every commit.
+
 Patches, uses, complaints, and suggestions are all welcome.
 
 The disassembly code (when not using NASM) is taken from Göran

info.rkt

@@ -2,8 +2,9 @@
 
 (define collection 'multi)
 (define version "1.0")
-(define deps '("base" 
+(define deps '("base"
                "r6rs-lib"
                "srfi-lib"
                "srfi-lite-lib"))
+(define build-deps '("rackunit-lib" "recspecs-lib"))
 (define license 'MIT)

tests/main.rkt

@@ -0,0 +1,93 @@
+#lang at-exp racket
+(require rackunit rackunit/text-ui recspecs
+         racket/unsafe/ops
+         "../disassemble/main.rkt" "../disassemble/pb.rkt")
+
+(define nasm-exe
+  (case (system-type)
+    [(windows) "ndisasm.exe"]
+    [else "ndisasm"]))
+(define nasm-available? (find-executable-path nasm-exe))
+(define x86-64? (eq? (system-type 'arch) 'x86_64))
+
+(define disassemble-tests
+  (test-suite
+   "disassemble-tests"
+   (test-case "disassemble-bytes x86-64"
+     @expect[(disassemble-bytes (bytes #x90 #xc3) #:arch 'x86-64)]{
+       0: 90                             (nop)
+       1: c3                             (ret)
+     })
+   (when nasm-available?
+     (test-case "disassemble-bytes nasm"
+       @expect[(disassemble-bytes (bytes #x90 #xc3)
+                                  #:arch 'x86-64
+                                  #:program 'nasm)]{
+         00000000  90                nop
+         00000001  C3                ret
+       }))
+   (test-case "pb-disassemble nop"
+     @expect[(pb-disassemble (bytes 0 0 0 0) (pb-config 32 'little #f) '())]{
+       0:	00000000	(nop)
+     })
+   (test-case "pb-disassemble return"
+     @expect[(pb-disassemble (bytes #xd5 0 0 0) (pb-config 32 'little #f) '())]{
+       0:	000000d5	(return)
+     })
+  (test-case "pb-disassemble adr"
+    @expect[(pb-disassemble (bytes #xd7 0 0 0) (pb-config 32 'little #f) '())]{
+      0:       000000d7        (adr %tc (imm #x0))
+    })
+  (test-case "pb-disassemble interp"
+    @expect[(pb-disassemble (bytes #xd6 0 0 0) (pb-config 32 'little #f) '())]{
+      0:       000000d6        (interp %tc)
+    })
+  (test-case "pb-disassemble literal"
+    @expect[(pb-disassemble (bytes #x01 #x01 0 0 0 0 0 0)
+                             (pb-config 32 'little #f) '())]{
+      0:       00000101        (literal %sfp)
+      4:       00000000        (data)		
+    })
+  (when x86-64?
+    (test-case "disassemble function"
+      (define (ret1) 1)
+      @expect[(disassemble ret1 #:arch 'x86-64)]{
+        0: 4883fd00                       (cmp rbp #x0)
+        4: 750b                           (jnz (+ rip #xb)) ; => 11
+        6: 48c7c508000000                 (mov rbp #x8)
+      })
+    (test-case "disassemble fx-add"
+      (define (fx-add x y)
+        (unsafe-fx+ x y))
+      @expect[(disassemble fx-add #:arch 'x86-64)]{
+        0: 4883fd02                       (cmp rbp #x2)
+        4: 7508                           (jnz (+ rip #x8)) ; => e
+        6: 4a8d2c07                       (lea rbp (mem+ rdi (* r8 #x1)))
+        a: 41ff6500                       (jmp (mem64+ r13 #x0))
+      })
+    (test-case "disassemble uses-const-string"
+      (define const-string "a constant string")
+      (define (uses-const-string)
+        (display const-string))
+      @expect[(disassemble uses-const-string #:arch 'x86-64)]{
+        0: 49836e6801                     (sub (mem64+ r14 #x68) #x1)
+        5: 0f8486000000                   (jz (+ rip #x86)) ; => 91
+        b: 4883fd00                       (cmp rbp #x0)
+        f: 7574                           (jnz (+ rip #x74)) ; => 85
+       11: 4d396e48                       (cmp (mem64+ r14 #x48) r13)
+       15: 7660                           (jbe (+ rip #x60)) ; => 77
+       17: 4d8b470b                       (mov r8 (mem64+ r15 #xb)) ; <=
+       1b: 4983c508                       (add r13 #x8)
+      })
+    (when nasm-available?
+      (test-case "disassemble function nasm"
+        (define (ret1) 1)
+        @expect[(disassemble ret1 #:arch 'x86-64 #:program 'nasm)]{
+          00000000  4883FD00          cmp rbp,byte +0x0
+          00000004  750B              jnz 0x11
+          00000006  48C7C508000000    mov rbp,0x8
+        })))
+   ))
+
+(module+ test
+  (run-tests disassemble-tests))