Merge branch 'main' into feature/codegen-testing

.gitignore

@@ -32,4 +32,8 @@ hie.yaml
 src/Grammar/Scanner.hs
 src/Grammar/Parser.hs
 src/Grammar/Parser.info
-src/Main
+src/Main
+*.class
+out/
+mine.txt
+ref.txt

Runner.java

@@ -0,0 +1 @@
+public class Runner { public static void main(String[] args) { FieldsTest f = new FieldsTest(); System.out.println(f.b); } }

src/Codegen/ClassFile.hs

@@ -3,13 +3,16 @@ module Codegen.ClassFile where
 import Codegen.ConstPool
   ( generateConstPool,
     lookupClassIndex,
+    lookupFieldRefIndex,
     lookupUtf8Index,
   )
 import Codegen.Types
+import Data.Bits (shiftR, (.&.))
 import Data.Word (Word16, Word32, Word8)
 import Grammar.AST (Type)
 import Grammar.TAST
   ( TypedClass (..),
+    TypedExpr (..),
     TypedFieldDecl (..),
     TypedMethodDecl (..),
   )
@@ -155,7 +158,53 @@ makeAttributes :: CP_Infos -> Attribute_Infos
 makeAttributes _ = []
 
 makeMethods :: CP_Infos -> TypedClass -> Method_Infos
-makeMethods constPool (Class _ _ methods) = map (makeMethod constPool) methods
+makeMethods constPool (Class _ fields methods) =
+  makeInitMethod constPool fields : map (makeMethod constPool) methods
+
+makeInitMethod :: CP_Infos -> [TypedFieldDecl] -> Method_Info
+makeInitMethod constPool fields =
+  Method_Info
+    { methodAccessFlags = AccessFlags [ACC_PUBLIC],
+      methodNameIndex = lookupUtf8Index constPool "<init>",
+      methodDescIndex = lookupUtf8Index constPool "()V",
+      methodAttributes = [makeInitCode constPool fields]
+    }
+
+makeInitCode :: CP_Infos -> [TypedFieldDecl] -> Attribute_Info
+makeInitCode constPool fields =
+  Code_Attribute
+    { codeNameIndex = lookupUtf8Index constPool "Code",
+      maxStack = if null initFields then 1 else 2,
+      maxLocals = 1,
+      codeBody = [0x2A, 0xB7, 0x00, 0x08] ++ fieldInits ++ [0xB1],
+      exceptionTable = [],
+      codeAttributes = []
+    }
+  where
+    initFields = [f | f@(Field _ _ (Just _)) <- fields]
+    fieldInits = concatMap (fieldInitBytes constPool) initFields
+
+fieldInitBytes :: CP_Infos -> TypedFieldDecl -> [Word8]
+fieldInitBytes constPool (Field _ name (Just expr)) =
+  let idx = lookupFieldRefIndex constPool ("field ref: " ++ name)
+   in [0x2A]
+        ++ pushExpr expr
+        ++ [0xB5, fromIntegral (idx `shiftR` 8 .&. 0xFF), fromIntegral (idx .&. 0xFF)]
+fieldInitBytes _ _ = []
+
+pushExpr :: TypedExpr -> [Word8]
+pushExpr (Integer n _) = pushInt (fromIntegral n)
+pushExpr (Bool True _) = [0x04]
+pushExpr (Bool False _) = [0x03]
+pushExpr (Char c _) = pushInt (fromEnum c)
+pushExpr _ = []
+
+pushInt :: Int -> [Word8]
+pushInt n
+  | n >= -1 && n <= 5 = [fromIntegral (0x03 + n)]
+  | n >= -128 && n <= 127 = [0x10, fromIntegral n]
+  | n >= -32768 && n <= 32767 = [0x11, fromIntegral (n `shiftR` 8 .&. 0xFF), fromIntegral (n .&. 0xFF)]
+  | otherwise = [0x10, 0]
 
 makeMethod :: CP_Infos -> TypedMethodDecl -> Method_Info
 makeMethod constPool (Method returnType name params _body) =

src/Codegen/ConstPool.hs

@@ -183,14 +183,39 @@ collectFromMethods (TAST.Method mType mName params body : ms) =
 
 generateConstPool :: TAST.TypedClass -> CP_Infos
 generateConstPool (TAST.Class cName fields methods) =
-  [ mkUtf8Info cName ("this class: " ++ cName),
-    mkUtf8Info "java/lang/Object" "super class",
-    mkClassInfo 0 ("this class: " ++ cName),
-    mkClassInfo 0 "super class"
+  [ mkUtf8Info cName ("this class: " ++ cName),         -- #1
+    mkUtf8Info "java/lang/Object" "super class",        -- #2
+    mkClassInfo 1 ("this class: " ++ cName),            -- #3 → #1
+    mkClassInfo 2 "super class",                        -- #4 → #2
+    mkUtf8Info "<init>" "<init>",                       -- #5
+    mkUtf8Info "()V" "init descriptor",                 -- #6
+    mkNameAndTypeInfo 5 6 "<init>:()V",                 -- #7
+    mkMethodRefInfo 4 7 "java/lang/Object.<init>:()V",  -- #8
+    mkUtf8Info "Code" "Code"                            -- #9
   ]
     ++ collectFromFields fields
+    ++ buildInitFieldPool fields (length fields)
     ++ collectFromMethods methods
 
+-- Build NameAndType + Fieldref entries for each field with an initializer.
+-- The base pool has 9 fixed entries; collectFromFields adds 2 per field.
+-- So for field at 0-based index i: name Utf8 = #(9 + 2i + 1), desc = #(9 + 2i + 2).
+-- NameAndType entries follow at #(9 + 2*numFields + 2j + 1) for j-th init field.
+buildInitFieldPool :: [TAST.TypedFieldDecl] -> Int -> CP_Infos
+buildInitFieldPool fields numFields = go 0 0 fields
+  where
+    go _ _ [] = []
+    go fieldIdx initIdx (TAST.Field _ _ Nothing : rest) =
+      go (fieldIdx + 1) initIdx rest
+    go fieldIdx initIdx (TAST.Field _ name _ : rest) =
+      let nameUtf8Idx = 9 + 2 * fieldIdx + 1
+          descUtf8Idx = 9 + 2 * fieldIdx + 2
+          natCpIdx    = 9 + 2 * numFields + 2 * initIdx + 1
+       in [ mkNameAndTypeInfo nameUtf8Idx descUtf8Idx ("field NameAndType: " ++ name),
+            mkFieldRefInfo 3 natCpIdx ("field ref: " ++ name)
+          ]
+            ++ go (fieldIdx + 1) (initIdx + 1) rest
+
 lookupClassIndex :: CP_Infos -> String -> IndexConstantPool
 lookupClassIndex pool name =
   case findIndex matches pool of
@@ -223,6 +248,16 @@ lookupNameAndTypeIndex pool name =
       NameAndTypeInfo {desc = descVal} -> descVal == name || isSuffixOf name descVal
       _ -> False
 
+lookupFieldRefIndex :: CP_Infos -> String -> IndexConstantPool
+lookupFieldRefIndex pool name =
+  case findIndex matches pool of
+    Just i -> i
+    Nothing -> 0
+  where
+    matches entry = case entry of
+      FieldRefInfo {desc = descVal} -> descVal == name || isSuffixOf name descVal
+      _ -> False
+
 findIndex :: (CP_Info -> Bool) -> CP_Infos -> Maybe IndexConstantPool
 findIndex predicate pool = go 1 pool
   where

src/Codegen/Lowerer.hs

@@ -1,7 +1,7 @@
 module Codegen.Lowerer where
 
 import Codegen.ClassFile
-import Codegen.Types (CP_Info (Utf8Info), CP_Infos)
+import Codegen.Types (CP_Info (..), CP_Infos)
 import Data.Word (Word8)
 import Numeric (showHex)
 

src/Codegen/Serializer.hs

@@ -1,7 +1,11 @@
 module Codegen.Serializer where
 
-import Data.Bits (shiftR, (.&.))
-import Data.Word (Word8)
+import Codegen.ClassFile
+import Codegen.Lowerer (BtcLine (..), BtcProgram (..), Instruction (..))
+import Codegen.Types
+import Data.Bits (shiftR, (.&.), (.|.))
+import Data.Char (ord)
+import Data.Word (Word16, Word32, Word8)
 
 -- Split a 16-bit Int into two bytes (big-endian), as JVM expects
 indexBytes :: Int -> [Word8]
@@ -77,3 +81,51 @@ serializeInstruction instr = case instr of
 serializeProgram :: BtcProgram -> [Word8]
 serializeProgram (BtcProgram lines) =
   concatMap (serializeInstruction . instruction) lines
+
+serializeClassFile :: ClassFile -> [Word8]
+serializeClassFile cf =
+  u4 (let Magic m = magic cf in m)
+    ++ u2 (let MinorVersion v = minorVersion cf in v)
+    ++ u2 (let MajorVersion v = majorVersion cf in v)
+    ++ u2 (length (constantPool cf) + 1)
+    ++ concatMap cpEntry (constantPool cf)
+    ++ aflags (accessFlags cf)
+    ++ u2 (let ThisClass i = thisClass cf in i)
+    ++ u2 (let SuperClass i = superClass cf in i)
+    ++ u2 (length (interfaces cf))
+    ++ concatMap (\i -> u2 (fromIntegral (i :: Word16) :: Int)) (interfaces cf)
+    ++ u2 (length (fields cf))    ++ concatMap fieldEntry (fields cf)
+    ++ u2 (length (methods cf))   ++ concatMap methodEntry (methods cf)
+    ++ u2 (length (attributes cf)) ++ concatMap attrEntry (attributes cf)
+  where
+    u2 :: Int -> [Word8]
+    u2 n   = [fromIntegral ((n `shiftR` 8) .&. 0xFF), fromIntegral (n .&. 0xFF)]
+    u4 :: (Integral a) => a -> [Word8]
+    u4 n   = let w = fromIntegral n :: Word32
+              in map (\s -> fromIntegral ((w `shiftR` s) .&. 0xFF)) [24,16,8,0]
+    aflags (AccessFlags fs) = u2 (foldr (\f a -> a .|. fval f) (0 :: Int) fs)
+    fval :: AccessFlag -> Int
+    fval ACC_PUBLIC    = 0x0001; fval ACC_PRIVATE   = 0x0002
+    fval ACC_PROTECTED = 0x0004; fval ACC_STATIC    = 0x0008
+    fval ACC_FINAL     = 0x0010; fval ACC_SUPER     = 0x0020
+    fval ACC_INTERFACE = 0x0200; fval ACC_ABSTRACT  = 0x0400
+    fval ACC_SYNTHETIC = 0x1000; fval ACC_ENUM      = 0x4000
+    cpEntry (Utf8Info _ _ s _)        = [1]  ++ u2 (length s) ++ map (fromIntegral . ord) s
+    cpEntry (ClassInfo _ i _)         = [7]  ++ u2 i
+    cpEntry (FieldRefInfo _ c n _)    = [9]  ++ u2 c ++ u2 n
+    cpEntry (MethodRefInfo _ c n _)   = [10] ++ u2 c ++ u2 n
+    cpEntry (StringInfo _ i _)        = [8]  ++ u2 i
+    cpEntry (IntegerInfo _ v _)       = [3]  ++ u4 v
+    cpEntry (NameAndTypeInfo _ n d _) = [12] ++ u2 n ++ u2 d
+    fieldEntry fi  = aflags (fieldAccessFlags fi)  ++ u2 (fieldNameIndex fi)
+                  ++ u2 (fieldDescIndex fi)  ++ u2 (0 :: Int)
+    methodEntry mi = aflags (methodAccessFlags mi) ++ u2 (methodNameIndex mi)
+                  ++ u2 (methodDescIndex mi) ++ u2 (length (methodAttributes mi))
+                  ++ concatMap attrEntry (methodAttributes mi)
+    attrEntry (Code_Attribute ni ms ml code exc ca) =
+      let body = u2 ms ++ u2 ml ++ u4 (length code) ++ code
+               ++ u2 (length exc) ++ concatMap excEntry exc
+               ++ u2 (length ca)  ++ concatMap attrEntry ca
+       in u2 ni ++ u4 (length body) ++ body
+    attrEntry (Generic_Attribute ni dat) = u2 ni ++ u4 (length dat) ++ dat
+    excEntry e = u2 (startPc e) ++ u2 (endPc e) ++ u2 (handlerPc e) ++ u2 (catchType e)

src/Main.hs

@@ -1,6 +1,8 @@
 module Main where
 
 import Codegen.ClassFile (ClassFile, generateClassFile)
+import Codegen.Serializer (serializeClassFile)
+import qualified Data.ByteString as BS
 import Grammar.AST (Program)
 import Grammar.Parser (parse)
 import Grammar.Scanner (Token, alexScanTokens)
@@ -22,8 +24,15 @@ runPipeline path = do
   let ast = parseProgram tokens
   let typedClasses = typeCheckProgram ast
   let classFiles = map generateClassFile typedClasses
+  mapM_ writeClassFile (zip typedClasses classFiles)
   reportSuccess ast typedClasses classFiles
 
+writeClassFile :: (TypedClass, ClassFile) -> IO ()
+writeClassFile (tc, cf) = do
+  let outPath = "out/" ++ className tc ++ ".class"
+  BS.writeFile outPath (BS.pack (serializeClassFile cf))
+  putStrLn ("Written: " ++ outPath)
+
 scan :: String -> [Token]
 scan = alexScanTokens
 

src/Testsuite/AbcFiles/ArithmeticTestABC.hs

@@ -0,0 +1,33 @@
+module Testsuite.AbcFiles.ArithmeticTestABC (expectedABC) where
+
+import Codegen.Lowerer (BtcLine (..), BtcProgram (..), Instruction (..))
+
+expectedABC :: [(String, BtcProgram)]
+expectedABC =
+  [
+    ( "basic",
+      BtcProgram
+        [ BtcLine {lineNumber = 0, instruction = ILoad 0},
+          BtcLine {lineNumber = 1, instruction = ILoad 1},
+          BtcLine {lineNumber = 2, instruction = IAdd},
+          BtcLine {lineNumber = 3, instruction = ILoad 2},
+          BtcLine {lineNumber = 4, instruction = ILoad 0},
+          BtcLine {lineNumber = 5, instruction = IMul},
+          BtcLine {lineNumber = 6, instruction = ILoad 1},
+          BtcLine {lineNumber = 7, instruction = ISub},
+          BtcLine {lineNumber = 8, instruction = ILoad 2},
+          BtcLine {lineNumber = 9, instruction = ISub},
+          BtcLine {lineNumber = 10, instruction = IReturn}
+        ]
+    ),
+    ( "logic",
+      BtcProgram
+        [ BtcLine {lineNumber = 0, instruction = ILoad 0},
+          BtcLine {lineNumber = 1, instruction = ILoad 2},
+          BtcLine {lineNumber = 2, instruction = ILoad 1},
+          BtcLine {lineNumber = 3, instruction = IAdd},
+          BtcLine {lineNumber = 4, instruction = IAdd},
+          BtcLine {lineNumber = 5, instruction = IReturn}
+        ]
+    )
+  ]

src/Testsuite/AbcFiles/EmptyTestABC.hs

@@ -0,0 +1,15 @@
+module Testsuite.AbcFiles.EmptyTestABC (expectedABC) where
+
+import Codegen.Lowerer (BtcLine (..), BtcProgram (..), Instruction (..))
+
+expectedABC :: [(String, BtcProgram)]
+expectedABC =
+  [
+    ( "<init>",
+      BtcProgram
+        [ BtcLine {lineNumber = 0, instruction = ALoad0},
+          BtcLine {lineNumber = 1, instruction = InvokeSpecial 1},
+          BtcLine {lineNumber = 4, instruction = Return}
+        ]
+    )
+  ]

src/Testsuite/AstFiles/EmptyTest.ast

@@ -1,3 +0,0 @@
-[
-  Class "EmptyTest" [] []
-]

src/Testsuite/AstFiles/EmptyTestAST.hs

@@ -0,0 +1,10 @@
+module Testsuite.AstFiles.EmptyTestAST (expectedAST) where
+
+import Grammar.AST
+
+expectedAST =
+  [ Class
+      "EmptyTest"
+      []
+      []
+  ]

src/Testsuite/CodegenSmokeTest.hs

@@ -1,95 +0,0 @@
-module Main where
-
-import Codegen.Assemble (assembleProgram)
-import Codegen.ClassFile (ClassFile(..), ClassFileMethod(..))
-import Codegen.Errors (CodegenError(..))
-import Codegen.IR
-  ( ClassDef(..)
-  , Expr(..)
-  , Literal(..)
-  , MethodDef(..)
-  , Program(..)
-  , Stmt(..)
-  , Type(..)
-  )
-import Data.List (isInfixOf)
-import System.Exit (exitFailure)
-
-main :: IO ()
-main = do
-  testVerticalSliceReturnInt
-  testUnsupportedStatementFails
-  putStrLn "Codegen smoke tests passed."
-
-testVerticalSliceReturnInt :: IO ()
-testVerticalSliceReturnInt =
-  case assembleProgram program of
-    Left err -> failTest ("Expected successful assemble, got error: " ++ show err)
-    Right [classFile] -> do
-      assertEqual "class name" "Main" (cfClassName classFile)
-      case cfMethods classFile of
-        [method] -> do
-          assertEqual "method name" "constSeven" (cfmName method)
-          assertEqual "method descriptor" "()I" (cfmDescriptor method)
-          assertEqual "method instructions" ["iconst 7", "ireturn"] (cfmCode method)
-        _ -> failTest "Expected exactly one method in generated class"
-    Right _ -> failTest "Expected exactly one generated class"
-  where
-    program =
-      Program
-        [ ClassDef
-            { className = "Main"
-            , classFields = []
-            , classMethods =
-                [ MethodDef
-                    { methodName = "constSeven"
-                    , methodParams = []
-                    , methodReturnType = IntType
-                    , methodBody = Return (Literal (IntLit 7))
-                    }
-                ]
-            }
-        ]
-
-testUnsupportedStatementFails :: IO ()
-testUnsupportedStatementFails =
-  case assembleProgram program of
-    Left (LoweringError msg)
-      | "Unsupported statement" `isInfixOf` msg -> pure ()
-      | otherwise -> failTest ("Lowering failed with unexpected message: " ++ msg)
-    Left err -> failTest ("Expected LoweringError, got: " ++ show err)
-    Right _ -> failTest "Expected lowering to fail for unsupported statement"
-  where
-    program =
-      Program
-        [ ClassDef
-            { className = "Main"
-            , classFields = []
-            , classMethods =
-                [ MethodDef
-                    { methodName = "badMethod"
-                    , methodParams = []
-                    , methodReturnType = IntType
-                    , methodBody = While (Literal (BoolLit True)) (Return (Literal (IntLit 0)))
-                    }
-                ]
-            }
-        ]
-
-assertEqual :: (Eq a, Show a) => String -> a -> a -> IO ()
-assertEqual label expected actual
-  | expected == actual = pure ()
-  | otherwise =
-      failTest
-        ( "Assertion failed for "
-            ++ label
-            ++ ": expected "
-            ++ show expected
-            ++ ", got "
-            ++ show actual
-        )
-
-failTest :: String -> IO ()
-failTest message = do
-  putStrLn ("[FAIL] " ++ message)
-  exitFailure

src/Testsuite/ExecutableTests/AllHarness.hs

@@ -0,0 +1,63 @@
+import Control.Exception (throwIO)
+import Control.Monad (unless)
+import Data.List (sort, isSuffixOf)
+import System.Directory (doesDirectoryExist, listDirectory, doesFileExist)
+import System.Exit (ExitCode (..), exitFailure)
+import System.FilePath (takeExtension, takeFileName, (</>), isExtensionOf, takeDirectory)
+import System.Process (readProcessWithExitCode)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..), exitOnFailures, printTestResults, runNamedTests)
+
+main :: IO ()
+main = do
+  let executableTestsDir = "src/Testsuite/ExecutableTests"
+  directoryExists <- doesDirectoryExist executableTestsDir
+  unless directoryExists $ do
+    putStrLn ("ExecutableTests directory not found: " ++ executableTestsDir)
+    exitFailure
+
+  harnessFiles <- discoverHarnessFiles executableTestsDir
+  if null harnessFiles
+    then do
+      putStrLn "No harness files found to execute."
+      exitFailure
+    else do
+      let namedHarnesses =
+            [ (takeFileName harnessFile, runHarness harnessFile)
+              | harnessFile <- harnessFiles
+            ]
+      results <- runNamedTests namedHarnesses
+      printTestResults "Full Testsuite Harness" results
+      exitOnFailures results
+
+discoverHarnessFiles :: FilePath -> IO [FilePath]
+discoverHarnessFiles baseDir = do
+  entries <- listDirectory baseDir
+  harnessFiles <- concat <$> mapM (findHarnessesInDir baseDir) entries
+  pure (sort harnessFiles)
+
+findHarnessesInDir :: FilePath -> String -> IO [FilePath]
+findHarnessesInDir baseDir entry = do
+  let fullPath = baseDir </> entry
+  isDir <- doesDirectoryExist fullPath
+  if isDir && entry /= "." && entry /= ".."
+    then do
+      subEntries <- listDirectory fullPath
+      let harnesses =
+            [ fullPath </> file
+              | file <- subEntries,
+                takeExtension file == ".hs",
+                "Harness.hs" `isSuffixOf` file,
+                file /= "AllHarness.hs"
+            ]
+      pure harnesses
+    else pure []
+
+runHarness :: FilePath -> IO ()
+runHarness harnessPath = do
+  (exitCode, stdOut, stdErr) <- readProcessWithExitCode "runghc" ["-isrc", harnessPath] ""
+  putStrLn ("\n--- Output from " ++ takeFileName harnessPath ++ " ---")
+  unless (null stdOut) (putStrLn stdOut)
+  unless (null stdErr) (putStrLn stdErr)
+  case exitCode of
+    ExitSuccess -> pure ()
+    ExitFailure _ -> throwIO (TestFailure "")

src/Testsuite/ExecutableTests/Arithmetic/ArithmeticABCTest.hs

@@ -0,0 +1,30 @@
+module Testsuite.ExecutableTests.Arithmetic.ArithmeticABCTest where
+
+import Codegen.ClassFile (generateClassFile)
+import Codegen.Lowerer (BtcProgram, lowerClassFile)
+import Control.Exception (throwIO)
+import Grammar.TAST (TypedClass)
+import Testsuite.AbcFiles.ArithmeticTestABC (expectedABC)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+import Testsuite.TastFiles.ArithmeticTestTAST (expectedTAST)
+
+mainArithmeticABCTest :: IO ()
+mainArithmeticABCTest = do
+  let actualABC = generateABCProgram expectedTAST
+  if actualABC == expectedABC
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Actual ABC:",
+                  show actualABC,
+                  "Expected ABC:",
+                  show expectedABC
+                ]
+            )
+        )
+
+generateABCProgram :: [TypedClass] -> [(String, BtcProgram)]
+generateABCProgram [typedClass] = lowerClassFile (generateClassFile typedClass)
+generateABCProgram _ = error "Expected exactly one typed class for the ABC test"

src/Testsuite/ExecutableTests/Arithmetic/ArithmeticASTTest.hs

@@ -0,0 +1,27 @@
+module Testsuite.ExecutableTests.Arithmetic.ArithmeticASTTest where
+
+import Grammar.Parser
+import Grammar.Scanner
+import Control.Exception (throwIO)
+import Testsuite.AstFiles.ArithmeticTestAST (expectedAST)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+
+mainArithmeticASTTest :: IO ()
+mainArithmeticASTTest = do
+  let javaFilePath = "src/Testsuite/javaFiles/ArithmeticTest.java"
+  java <- readFile javaFilePath
+  let actualAST = parse . alexScanTokens $ java
+  if actualAST == expectedAST
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Arithmetic AST test failed.",
+                  "Actual AST:",
+                  show actualAST,
+                  "Expected AST:",
+                  show expectedAST
+                ]
+            )
+        )

src/Testsuite/ExecutableTests/Arithmetic/ArithmeticBytecodeBytesTest.hs

@@ -0,0 +1,227 @@
+module Testsuite.ExecutableTests.Arithmetic.ArithmeticBytecodeBytesTest where
+
+import Codegen.Lowerer (BtcProgram)
+import Codegen.Serializer (serializeProgram)
+import Control.Exception (throwIO)
+import Data.Bits ((.|.), shiftL)
+import qualified Data.ByteString as BS
+import qualified Data.Map.Strict as Map
+import Data.Word (Word16, Word32, Word8)
+import Testsuite.AbcFiles.ArithmeticTestABC (expectedABC)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+
+mainArithmeticBytecodeBytesTest :: IO ()
+mainArithmeticBytecodeBytesTest = do
+  let classFilePath = "src/Testsuite/classFiles/ArithmeticTest.class"
+  methodCodes <- parseMethodCodeBytesFromFile classFilePath
+  failures <- fmap concat (mapM (checkMethod methodCodes) expectedABC)
+  if null failures
+    then pure ()
+    else throwIO (TestFailure (unlines failures))
+
+checkMethod :: [(String, [Word8])] -> (String, BtcProgram) -> IO [String]
+checkMethod methodCodes (methodName, expectedProgram) = do
+  let expectedBytes = serializeProgram expectedProgram
+      maybeActualBytes = lookup methodName methodCodes
+  case maybeActualBytes of
+    Nothing ->
+      pure
+        [ "Method '" ++ methodName ++ "' not found in reference class file"
+        ]
+    Just actualBytes ->
+      if expectedBytes == actualBytes
+        then pure []
+        else
+          pure ["Method '" ++ methodName ++ "' bytecode mismatch"]
+
+newtype Parser a = Parser
+  { runParser :: [Word8] -> Either String (a, [Word8])
+  }
+
+instance Functor Parser where
+  fmap f p = Parser $ \input -> do
+    (value, rest) <- runParser p input
+    pure (f value, rest)
+
+instance Applicative Parser where
+  pure value = Parser $ \input -> Right (value, input)
+  pf <*> px = Parser $ \input -> do
+    (f, rest1) <- runParser pf input
+    (x, rest2) <- runParser px rest1
+    pure (f x, rest2)
+
+instance Monad Parser where
+  p >>= f = Parser $ \input -> do
+    (value, rest) <- runParser p input
+    runParser (f value) rest
+
+parseFail :: String -> Parser a
+parseFail msg = Parser $ \_ -> Left msg
+
+u1 :: Parser Word8
+u1 = Parser $ \input ->
+  case input of
+    [] -> Left "Unexpected end of input while reading u1"
+    (b : rest) -> Right (b, rest)
+
+u2 :: Parser Word16
+u2 = do
+  hi <- u1
+  lo <- u1
+  pure ((fromIntegral hi `shiftL` 8) .|. fromIntegral lo)
+
+u4 :: Parser Word32
+u4 = do
+  b1 <- u1
+  b2 <- u1
+  b3 <- u1
+  b4 <- u1
+  pure
+    ( (fromIntegral b1 `shiftL` 24)
+        .|. (fromIntegral b2 `shiftL` 16)
+        .|. (fromIntegral b3 `shiftL` 8)
+        .|. fromIntegral b4
+    )
+
+takeN :: Int -> Parser [Word8]
+takeN n
+  | n < 0 = parseFail "Negative takeN requested"
+  | otherwise = Parser $ \input ->
+      if length input < n
+        then Left ("Unexpected end of input while reading " ++ show n ++ " bytes")
+        else Right (splitAt n input)
+
+skipN :: Int -> Parser ()
+skipN n = do
+  _ <- takeN n
+  pure ()
+
+parseMethodCodeBytesFromFile :: FilePath -> IO [(String, [Word8])]
+parseMethodCodeBytesFromFile path = do
+  bytes <- BS.readFile path
+  case runParser parseClassFile (BS.unpack bytes) of
+    Left err -> error ("Failed parsing class file '" ++ path ++ "': " ++ err)
+    Right (methods, _) -> pure methods
+
+parseClassFile :: Parser [(String, [Word8])]
+parseClassFile = do
+  magic <- u4
+  if magic /= 0xCAFEBABE
+    then parseFail "Invalid class file magic"
+    else pure ()
+
+  _minorVersion <- u2
+  _majorVersion <- u2
+
+  cpCount <- fromIntegral <$> u2
+  utf8Map <- parseConstantPool cpCount 1 Map.empty
+
+  _accessFlags <- u2
+  _thisClass <- u2
+  _superClass <- u2
+
+  interfacesCount <- fromIntegral <$> u2
+  skipN (interfacesCount * 2)
+
+  fieldsCount <- fromIntegral <$> u2
+  skipMembers fieldsCount
+
+  methodsCount <- fromIntegral <$> u2
+  parseMethods utf8Map methodsCount
+
+parseConstantPool :: Int -> Int -> Map.Map Int String -> Parser (Map.Map Int String)
+parseConstantPool cpCount idx utf8Map
+  | idx >= cpCount = pure utf8Map
+  | otherwise = do
+      tag <- u1
+      case tag of
+        1 -> do
+          len <- fromIntegral <$> u2
+          bytes <- takeN len
+          let value = map (toEnum . fromIntegral) bytes
+          parseConstantPool cpCount (idx + 1) (Map.insert idx value utf8Map)
+        3 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        4 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        5 -> skipN 8 >> parseConstantPool cpCount (idx + 2) utf8Map
+        6 -> skipN 8 >> parseConstantPool cpCount (idx + 2) utf8Map
+        7 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        8 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        9 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        10 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        11 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        12 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        15 -> skipN 3 >> parseConstantPool cpCount (idx + 1) utf8Map
+        16 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        17 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        18 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        19 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        20 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        _ -> parseFail ("Unknown constant pool tag " ++ show tag)
+
+skipMembers :: Int -> Parser ()
+skipMembers 0 = pure ()
+skipMembers n = do
+  _accessFlags <- u2
+  _nameIndex <- u2
+  _descriptorIndex <- u2
+  attrCount <- fromIntegral <$> u2
+  skipAttributes attrCount
+  skipMembers (n - 1)
+
+skipAttributes :: Int -> Parser ()
+skipAttributes 0 = pure ()
+skipAttributes n = do
+  _attrNameIndex <- u2
+  attrLen <- fromIntegral <$> u4
+  skipN attrLen
+  skipAttributes (n - 1)
+
+parseMethods :: Map.Map Int String -> Int -> Parser [(String, [Word8])]
+parseMethods _ 0 = pure []
+parseMethods utf8Map n = do
+  _accessFlags <- u2
+  nameIndex <- fromIntegral <$> u2
+  _descriptorIndex <- u2
+  attrCount <- fromIntegral <$> u2
+
+  let methodName = Map.findWithDefault ("<unknown-" ++ show nameIndex ++ ">") nameIndex utf8Map
+
+  maybeCode <- parseMethodAttributes utf8Map attrCount
+  rest <- parseMethods utf8Map (n - 1)
+  case maybeCode of
+    Nothing -> pure rest
+    Just code -> pure ((methodName, code) : rest)
+
+parseMethodAttributes :: Map.Map Int String -> Int -> Parser (Maybe [Word8])
+parseMethodAttributes _ 0 = pure Nothing
+parseMethodAttributes utf8Map n = do
+  attrNameIndex <- fromIntegral <$> u2
+  attrLen <- fromIntegral <$> u4
+  let attrName = Map.findWithDefault "" attrNameIndex utf8Map
+
+  current <-
+    if attrName == "Code"
+      then parseCodeAttribute attrLen
+      else skipN attrLen >> pure Nothing
+
+  next <- parseMethodAttributes utf8Map (n - 1)
+  pure (pickFirst current next)
+
+pickFirst :: Maybe a -> Maybe a -> Maybe a
+pickFirst (Just x) _ = Just x
+pickFirst Nothing y = y
+
+parseCodeAttribute :: Int -> Parser (Maybe [Word8])
+parseCodeAttribute _declaredLength = do
+  _maxStack <- u2
+  _maxLocals <- u2
+  codeLen <- fromIntegral <$> u4
+  codeBytes <- takeN codeLen
+
+  exceptionTableLength <- fromIntegral <$> u2
+  skipN (exceptionTableLength * 8)
+
+  nestedAttrCount <- fromIntegral <$> u2
+  skipAttributes nestedAttrCount
+
+  pure (Just codeBytes)

src/Testsuite/ExecutableTests/Arithmetic/ArithmeticHarness.hs

@@ -0,0 +1,19 @@
+module Testsuite.ExecutableTests.Arithmetic.ArithmeticHarness where
+
+import Testsuite.ExecutableTests.Arithmetic.ArithmeticABCTest (mainArithmeticABCTest)
+import Testsuite.ExecutableTests.Arithmetic.ArithmeticASTTest (mainArithmeticASTTest)
+import Testsuite.ExecutableTests.Arithmetic.ArithmeticBytecodeBytesTest (mainArithmeticBytecodeBytesTest)
+import Testsuite.ExecutableTests.Arithmetic.ArithmeticTASTTest (mainArithmeticTASTTest)
+import Testsuite.ExecutableTests.HarnessSupport
+
+main :: IO ()
+main = do
+  let tests =
+        [ ("Arithmetic AST", mainArithmeticASTTest),
+          ("Arithmetic TAST", mainArithmeticTASTTest),
+          ("Arithmetic ABC", mainArithmeticABCTest),
+          ("Arithmetic Bytecode Bytes", mainArithmeticBytecodeBytesTest)
+        ]
+  results <- runNamedTests tests
+  printTestResults "Arithmetic Harness" results
+  exitOnFailures results

src/Testsuite/ExecutableTests/Arithmetic/ArithmeticTASTTest.hs

@@ -0,0 +1,29 @@
+module Testsuite.ExecutableTests.Arithmetic.ArithmeticTASTTest where
+
+import Control.Exception (throwIO)
+import Grammar.AST (Class)
+import Grammar.TAST (TypedClass)
+import Testsuite.AstFiles.ArithmeticTestAST (expectedAST)
+import Testsuite.TastFiles.ArithmeticTestTAST (expectedTAST)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+import Typecheck.SemanticChecker (typeCheckClass)
+
+mainArithmeticTASTTest :: IO ()
+mainArithmeticTASTTest = do
+  let actualTAST = typeCheckProgram expectedAST
+  if actualTAST == expectedTAST
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Actual TAST:",
+                  show actualTAST,
+                  "Expected TAST:",
+                  show expectedTAST
+                ]
+            )
+        )
+
+typeCheckProgram :: [Class] -> [TypedClass]
+typeCheckProgram classes = map (\cls -> typeCheckClass cls [] classes) classes

src/Testsuite/ExecutableTests/ArithmeticASTTest.hs

@@ -1,14 +0,0 @@
-module TestSuite.ExecutableTests.ArithmeticASTTest where
-
-import Grammar.Parser
-import Grammar.Scanner
-import Testsuite.AstFiles.ArithmeticTestAST (expectedAST)
-
-mainArithemticASTTest :: IO ()
-mainArithemticASTTest = do
-  let javaFilePath = "Testsuite/javaFiles/ArithmeticTest.java"
-  java <- readFile javaFilePath
-  let actualAST = parse . alexScanTokens $ java
-  print $ actualAST == expectedAST
-  print actualAST
-  print expectedAST

src/Testsuite/ExecutableTests/Empty/EmptyABCTest.hs

@@ -0,0 +1,30 @@
+module Testsuite.ExecutableTests.Empty.EmptyABCTest where
+
+import Codegen.ClassFile (generateClassFile)
+import Codegen.Lowerer (BtcProgram, lowerClassFile)
+import Control.Exception (throwIO)
+import Grammar.TAST (TypedClass)
+import Testsuite.AbcFiles.EmptyTestABC (expectedABC)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+import Testsuite.TastFiles.EmptyTestTAST (expectedTAST)
+
+mainEmptyABCTest :: IO ()
+mainEmptyABCTest = do
+  let actualABC = generateABCProgram expectedTAST
+  if actualABC == expectedABC
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Actual ABC:",
+                  show actualABC,
+                  "Expected ABC:",
+                  show expectedABC
+                ]
+            )
+        )
+
+generateABCProgram :: [TypedClass] -> [(String, BtcProgram)]
+generateABCProgram [typedClass] = lowerClassFile (generateClassFile typedClass)
+generateABCProgram _ = error "Expected exactly one typed class for the ABC test"

src/Testsuite/ExecutableTests/Empty/EmptyASTTest.hs

@@ -0,0 +1,27 @@
+module Testsuite.ExecutableTests.Empty.EmptyASTTest where
+
+import Control.Exception (throwIO)
+import Grammar.Parser
+import Grammar.Scanner
+import Testsuite.AstFiles.EmptyTestAST (expectedAST)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+
+mainEmptyASTTest :: IO ()
+mainEmptyASTTest = do
+  let javaFilePath = "src/Testsuite/javaFiles/EmptyTest.java"
+  java <- readFile javaFilePath
+  let actualAST = parse . alexScanTokens $ java
+  if actualAST == expectedAST
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Empty AST test failed.",
+                  "Actual AST:",
+                  show actualAST,
+                  "Expected AST:",
+                  show expectedAST
+                ]
+            )
+        )

src/Testsuite/ExecutableTests/Empty/EmptyBytecodeBytesTest.hs

@@ -0,0 +1,224 @@
+module Testsuite.ExecutableTests.Empty.EmptyBytecodeBytesTest where
+
+import Codegen.Lowerer (BtcProgram)
+import Codegen.Serializer (serializeProgram)
+import Control.Exception (throwIO)
+import Data.Bits ((.|.), shiftL)
+import qualified Data.ByteString as BS
+import qualified Data.Map.Strict as Map
+import Data.Word (Word16, Word32, Word8)
+import Testsuite.AbcFiles.EmptyTestABC (expectedABC)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+
+mainEmptyBytecodeBytesTest :: IO ()
+mainEmptyBytecodeBytesTest = do
+  let classFilePath = "src/Testsuite/classFiles/EmptyTest.class"
+  methodCodes <- parseMethodCodeBytesFromFile classFilePath
+  failures <- fmap concat (mapM (checkMethod methodCodes) expectedABC)
+  if null failures
+    then pure ()
+    else throwIO (TestFailure (unlines failures))
+
+checkMethod :: [(String, [Word8])] -> (String, BtcProgram) -> IO [String]
+checkMethod methodCodes (methodName, expectedProgram) = do
+  let expectedBytes = serializeProgram expectedProgram
+      maybeActualBytes = lookup methodName methodCodes
+  case maybeActualBytes of
+    Nothing ->
+      pure
+        [ "Method '" ++ methodName ++ "' not found in reference class file"
+        ]
+    Just actualBytes ->
+      if expectedBytes == actualBytes
+        then pure []
+        else
+          pure ["Method '" ++ methodName ++ "' bytecode mismatch"]
+
+newtype Parser a = Parser
+  { runParser :: [Word8] -> Either String (a, [Word8])
+  }
+
+instance Functor Parser where
+  fmap f p = Parser $ \input -> do
+    (value, rest) <- runParser p input
+    pure (f value, rest)
+
+instance Applicative Parser where
+  pure value = Parser $ \input -> Right (value, input)
+  pf <*> px = Parser $ \input -> do
+    (f, rest1) <- runParser pf input
+    (x, rest2) <- runParser px rest1
+    pure (f x, rest2)
+
+instance Monad Parser where
+  p >>= f = Parser $ \input -> do
+    (value, rest) <- runParser p input
+    runParser (f value) rest
+
+parseFail :: String -> Parser a
+parseFail msg = Parser $ \_ -> Left msg
+
+u1 :: Parser Word8
+u1 = Parser $ \input ->
+  case input of
+    [] -> Left "Unexpected end of input while reading u1"
+    (b : rest) -> Right (b, rest)
+
+u2 :: Parser Word16
+u2 = do
+  hi <- u1
+  lo <- u1
+  pure ((fromIntegral hi `shiftL` 8) .|. fromIntegral lo)
+
+u4 :: Parser Word32
+u4 = do
+  b1 <- u1
+  b2 <- u1
+  b3 <- u1
+  b4 <- u1
+  pure
+    ( (fromIntegral b1 `shiftL` 24)
+        .|. (fromIntegral b2 `shiftL` 16)
+        .|. (fromIntegral b3 `shiftL` 8)
+        .|. fromIntegral b4
+    )
+
+takeN :: Int -> Parser [Word8]
+takeN n
+  | n < 0 = parseFail "Negative takeN requested"
+  | otherwise = Parser $ \input ->
+      if length input < n
+        then Left ("Unexpected end of input while reading " ++ show n ++ " bytes")
+        else Right (splitAt n input)
+
+skipN :: Int -> Parser ()
+skipN n = do
+  _ <- takeN n
+  pure ()
+
+parseMethodCodeBytesFromFile :: FilePath -> IO [(String, [Word8])]
+parseMethodCodeBytesFromFile path = do
+  bytes <- BS.readFile path
+  case runParser parseClassFile (BS.unpack bytes) of
+    Left err -> error ("Failed parsing class file '" ++ path ++ "': " ++ err)
+    Right (methods, _) -> pure methods
+
+parseClassFile :: Parser [(String, [Word8])]
+parseClassFile = do
+  magic <- u4
+  if magic /= 0xCAFEBABE
+    then parseFail "Invalid class file magic"
+    else pure ()
+
+  _minorVersion <- u2
+  _majorVersion <- u2
+
+  cpCount <- fromIntegral <$> u2
+  utf8Map <- parseConstantPool cpCount 1 Map.empty
+
+  _accessFlags <- u2
+  _thisClass <- u2
+  _superClass <- u2
+
+  interfacesCount <- fromIntegral <$> u2
+  skipN (interfacesCount * 2)
+
+  fieldsCount <- fromIntegral <$> u2
+  skipMembers fieldsCount
+
+  methodsCount <- fromIntegral <$> u2
+  parseMethods utf8Map methodsCount
+
+parseConstantPool :: Int -> Int -> Map.Map Int String -> Parser (Map.Map Int String)
+parseConstantPool cpCount idx utf8Map
+  | idx >= cpCount = pure utf8Map
+  | otherwise = do
+      tag <- u1
+      case tag of
+        1 -> do
+          len <- fromIntegral <$> u2
+          bytes <- takeN len
+          let value = map (toEnum . fromIntegral) bytes
+          parseConstantPool cpCount (idx + 1) (Map.insert idx value utf8Map)
+        3 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        4 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        5 -> skipN 8 >> parseConstantPool cpCount (idx + 2) utf8Map
+        6 -> skipN 8 >> parseConstantPool cpCount (idx + 2) utf8Map
+        7 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        8 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        9 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        10 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        11 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        12 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        15 -> skipN 3 >> parseConstantPool cpCount (idx + 1) utf8Map
+        16 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        17 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        18 -> skipN 4 >> parseConstantPool cpCount (idx + 1) utf8Map
+        19 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        20 -> skipN 2 >> parseConstantPool cpCount (idx + 1) utf8Map
+        _ -> parseFail ("Unknown constant pool tag " ++ show tag)
+
+skipMembers :: Int -> Parser ()
+skipMembers 0 = pure ()
+skipMembers n = do
+  _accessFlags <- u2
+  _nameIndex <- u2
+  _descriptorIndex <- u2
+  attrCount <- fromIntegral <$> u2
+  skipAttributes attrCount
+  skipMembers (n - 1)
+
+skipAttributes :: Int -> Parser ()
+skipAttributes 0 = pure ()
+skipAttributes n = do
+  _attrNameIndex <- u2
+  attrLen <- fromIntegral <$> u4
+  skipN attrLen
+  skipAttributes (n - 1)
+
+parseMethods :: Map.Map Int String -> Int -> Parser [(String, [Word8])]
+parseMethods _ 0 = pure []
+parseMethods utf8Map n = do
+  _accessFlags <- u2
+  nameIndex <- fromIntegral <$> u2
+  _descriptorIndex <- u2
+  attrCount <- fromIntegral <$> u2
+
+  let methodName = Map.findWithDefault ("<unknown-" ++ show nameIndex ++ ">") nameIndex utf8Map
+
+  maybeCode <- parseMethodAttributes utf8Map attrCount
+  rest <- parseMethods utf8Map (n - 1)
+  case maybeCode of
+    Nothing -> pure rest
+    Just code -> pure ((methodName, code) : rest)
+
+parseMethodAttributes :: Map.Map Int String -> Int -> Parser (Maybe [Word8])
+parseMethodAttributes _ 0 = pure Nothing
+parseMethodAttributes utf8Map n = do
+  attrNameIndex <- fromIntegral <$> u2
+  attrLen <- fromIntegral <$> u4
+  let attrName = Map.findWithDefault "" attrNameIndex utf8Map
+
+  current <-
+    if attrName == "Code"
+      then parseCodeAttribute attrLen
+      else skipN attrLen >> pure Nothing
+
+  next <- parseMethodAttributes utf8Map (n - 1)
+  pure (pickFirst current next)
+
+pickFirst :: Maybe a -> Maybe a -> Maybe a
+pickFirst (Just x) _ = Just x
+pickFirst Nothing y = y
+
+parseCodeAttribute :: Int -> Parser (Maybe [Word8])
+parseCodeAttribute _declaredLength = do
+  _maxStack <- u2
+  _maxLocals <- u2
+  codeLen <- fromIntegral <$> u4
+  codeBytes <- takeN codeLen
+  exceptionTableLen <- fromIntegral <$> u2
+  skipN (exceptionTableLen * 8)
+  attrCount <- fromIntegral <$> u2
+  skipAttributes attrCount
+  pure (Just codeBytes)

src/Testsuite/ExecutableTests/Empty/EmptyHarness.hs

@@ -0,0 +1,19 @@
+module Testsuite.ExecutableTests.Empty.EmptyHarness where
+
+import Testsuite.ExecutableTests.Empty.EmptyABCTest (mainEmptyABCTest)
+import Testsuite.ExecutableTests.Empty.EmptyASTTest (mainEmptyASTTest)
+import Testsuite.ExecutableTests.Empty.EmptyBytecodeBytesTest (mainEmptyBytecodeBytesTest)
+import Testsuite.ExecutableTests.Empty.EmptyTASTTest (mainEmptyTASTTest)
+import Testsuite.ExecutableTests.HarnessSupport
+
+main :: IO ()
+main = do
+  let tests =
+        [ ("Empty AST", mainEmptyASTTest),
+          ("Empty TAST", mainEmptyTASTTest),
+          ("Empty ABC", mainEmptyABCTest),
+          ("Empty Bytecode Bytes", mainEmptyBytecodeBytesTest)
+        ]
+  results <- runNamedTests tests
+  printTestResults "Empty Harness" results
+  exitOnFailures results

src/Testsuite/ExecutableTests/Empty/EmptyTASTTest.hs

@@ -0,0 +1,29 @@
+module Testsuite.ExecutableTests.Empty.EmptyTASTTest where
+
+import Control.Exception (throwIO)
+import Grammar.AST (Class)
+import Grammar.TAST (TypedClass)
+import Testsuite.AstFiles.EmptyTestAST (expectedAST)
+import Testsuite.ExecutableTests.HarnessSupport (TestFailure (..))
+import Testsuite.TastFiles.EmptyTestTAST (expectedTAST)
+import Typecheck.SemanticChecker (typeCheckClass)
+
+mainEmptyTASTTest :: IO ()
+mainEmptyTASTTest = do
+  let actualTAST = typeCheckProgram expectedAST
+  if actualTAST == expectedTAST
+    then pure ()
+    else
+      throwIO
+        ( TestFailure
+            ( unlines
+                [ "Actual TAST:",
+                  show actualTAST,
+                  "Expected TAST:",
+                  show expectedTAST
+                ]
+            )
+        )
+
+typeCheckProgram :: [Class] -> [TypedClass]
+typeCheckProgram classes = map (\cls -> typeCheckClass cls [] classes) classes

src/Testsuite/ExecutableTests/HarnessSupport.hs

@@ -0,0 +1,110 @@
+module Testsuite.ExecutableTests.HarnessSupport
+  ( TestResult (..),
+    TestFailure (..),
+    runNamedTests,
+    printTestResults,
+    exitOnFailures
+  )
+where
+
+import Control.Exception (Exception, SomeException, fromException, try)
+import Data.List (dropWhileEnd, intercalate)
+import System.Exit (ExitCode (..), exitFailure)
+import System.IO (BufferMode (LineBuffering), hFlush, hSetBuffering, stderr, stdout)
+
+newtype TestFailure = TestFailure {failureDetails :: String}
+  deriving (Show)
+
+instance Exception TestFailure
+
+data TestResult = TestResult
+  { testName :: String,
+    passed :: Bool,
+    details :: String
+  }
+  deriving (Eq, Show)
+
+runNamedTests :: [(String, IO ())] -> IO [TestResult]
+runNamedTests tests = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+  runNamedTests' tests
+
+runNamedTests' :: [(String, IO ())] -> IO [TestResult]
+runNamedTests' [] = pure []
+runNamedTests' (test : rest) = do
+  result <- runNamedTest test
+  results <- runNamedTests' rest
+  pure (result : results)
+
+runNamedTest :: (String, IO ()) -> IO TestResult
+runNamedTest (name, action) = do
+  putStrLn ("[RUN ] " ++ name)
+  hFlush stdout
+  result <- try action :: IO (Either SomeException ())
+  case result of
+    Right () -> do
+      putStrLn ("[DONE] " ++ name)
+      hFlush stdout
+      pure (TestResult name True "")
+    Left ex -> do
+      let details = failureDetailsForSummary ex
+      let runtimeDetails = failureDetailsForRuntime ex
+      if null runtimeDetails
+        then pure ()
+        else putStrLn runtimeDetails
+      putStrLn ("[DONE] " ++ name)
+      hFlush stdout
+      pure (TestResult name False details)
+
+printTestResults :: String -> [TestResult] -> IO ()
+printTestResults title results = do
+  putStrLn ("\n== " ++ title ++ " ==")
+  mapM_ printResult results
+  let total = length results
+      failures = length (filter (not . passed) results)
+      successes = total - failures
+  putStrLn ("Summary: " ++ show successes ++ "/" ++ show total ++ " passed")
+
+printResult :: TestResult -> IO ()
+printResult (TestResult name True _) =
+  putStrLn ("[PASS] " ++ name)
+printResult (TestResult name False info) = do
+  putStrLn ("[FAIL] " ++ name)
+  if null info
+    then pure ()
+    else mapM_ (putStrLn . ("       " ++)) (lines info)
+
+exitOnFailures :: [TestResult] -> IO ()
+exitOnFailures results =
+  if any (not . passed) results
+    then exitFailure
+    else pure ()
+
+renderException :: SomeException -> String
+renderException ex =
+  case fromException ex :: Maybe ExitCode of
+    Just ExitSuccess -> "unexpected ExitSuccess exception"
+    Just (ExitFailure code) -> "exit failure code " ++ show code
+    Nothing -> sanitize (show ex)
+
+failureDetailsForRuntime :: SomeException -> String
+failureDetailsForRuntime ex =
+  case fromException ex :: Maybe TestFailure of
+    Just (TestFailure details) -> stripTrailingNewlines details
+    Nothing -> indentOneLine (renderException ex)
+
+failureDetailsForSummary :: SomeException -> String
+failureDetailsForSummary ex =
+  case fromException ex :: Maybe TestFailure of
+    Just (TestFailure details) -> stripTrailingNewlines details
+    Nothing -> renderException ex
+
+indentOneLine :: String -> String
+indentOneLine text = "         " ++ text
+
+stripTrailingNewlines :: String -> String
+stripTrailingNewlines = dropWhileEnd (== '\n') . dropWhileEnd (== '\r')
+
+sanitize :: String -> String
+sanitize = intercalate " " . words

src/Testsuite/TastFiles/ArithmeticTestTAST.hs

@@ -0,0 +1,57 @@
+module Testsuite.TastFiles.ArithmeticTestTAST (expectedTAST) where
+
+import Grammar.AST (BinaryOperator (..), UnaryOperator (..))
+import Grammar.TAST
+
+expectedTAST =
+  [ Class
+      "ArithmeticTest"
+      []
+      [ Method
+          "int"
+          "basic"
+          [("int", "a"), ("int", "b"), ("int", "c")]
+          ( Block
+              [ Return
+                  ( Just
+                      ( Binary
+                          Subtract
+                          (Binary Add (LocalOrFieldVar "a" "int") (LocalOrFieldVar "b" "int") "int")
+                          ( Binary
+                              Modulo
+                              ( Binary
+                                  Divide
+                                  (Binary Multiply (LocalOrFieldVar "c" "int") (LocalOrFieldVar "a" "int") "int")
+                                  (LocalOrFieldVar "b" "int")
+                                  "int"
+                              )
+                              (LocalOrFieldVar "c" "int")
+                              "int"
+                          )
+                          "int"
+                      )
+                  )
+                  "int"
+              ]
+              "int"
+          )
+      , Method
+          "boolean"
+          "logic"
+          [("boolean", "a"), ("boolean", "b"), ("boolean", "c")]
+          ( Block
+              [ Return
+                  ( Just
+                      ( Binary
+                          And
+                          (Unary Not (LocalOrFieldVar "a" "boolean") "boolean")
+                          (Binary Or (LocalOrFieldVar "c" "boolean") (LocalOrFieldVar "b" "boolean") "boolean")
+                          "boolean"
+                      )
+                  )
+                  "boolean"
+              ]
+              "boolean"
+          )
+      ]
+  ]

src/Testsuite/TastFiles/EmptyTestTAST.hs

@@ -0,0 +1,10 @@
+module Testsuite.TastFiles.EmptyTestTAST (expectedTAST) where
+
+import Grammar.TAST
+
+expectedTAST =
+  [ Class
+      "EmptyTest"
+      []
+      []
+  ]

src/Testsuite/abcFiles/ArithmeticTest.abc

@@ -1 +0,0 @@
-[("basic",BtcProgram [BtcLine {lineNumber = 0, instruction = ILoad 0},BtcLine {lineNumber = 1, instruction = ILoad 1},BtcLine {lineNumber = 2, instruction = IAdd},BtcLine {lineNumber = 3, instruction = ILoad 2},BtcLine {lineNumber = 4, instruction = ILoad 0},BtcLine {lineNumber = 5, instruction = IMul},BtcLine {lineNumber = 6, instruction = ILoad 1},BtcLine {lineNumber = 7, instruction = ISub},BtcLine {lineNumber = 8, instruction = ILoad 2},BtcLine {lineNumber = 9, instruction = ISub},BtcLine {lineNumber = 10, instruction = IReturn}]),("logic",BtcProgram [BtcLine {lineNumber = 0, instruction = ILoad 0},BtcLine {lineNumber = 1, instruction = ILoad 2},BtcLine {lineNumber = 2, instruction = ILoad 1},BtcLine {lineNumber = 3, instruction = IAdd},BtcLine {lineNumber = 4, instruction = IAdd},BtcLine {lineNumber = 5, instruction = IReturn}])]

src/Testsuite/abcFiles/EmptyTest.abc

@@ -1 +0,0 @@
-[]

src/Testsuite/javaFiles/Main.java

@@ -68,13 +68,17 @@ public class Main {
         // CombinedControlTest tests
         System.out.println("test CombinedControlTest.compute(). Expected: -3, Real: " + combined.compute());
         // ExpressionTest tests
-        System.out.println("test ExpressionTest.shortCircuit(2, 1). Expected: true, Real: " + ExpressionTest.shortCircuit(2, 1));
-        System.out.println("test ExpressionTest.shortCircuit(0, 1). Expected: false, Real: " + ExpressionTest.shortCircuit(0, 1));
-        System.out.println("test ExpressionTest.charArithmetic('A', 2). Expected: C, Real: " + ExpressionTest.charArithmetic('A', 2));
+        System.out.println("test ExpressionTest instance created. Expected: non-null, Real: " + (expression != null));
+        System.out.println("test ExpressionTest.shortCircuit(2, 1). Expected: true, Real: " + expression.shortCircuit(2, 1));
+        System.out.println("test ExpressionTest.shortCircuit(0, 1). Expected: false, Real: " + expression.shortCircuit(0, 1));
+        System.out.println("test ExpressionTest.charArithmetic('A', 2). Expected: C, Real: " + expression.charArithmetic('A', 2));
         // IfTest tests
-        System.out.println("test IfTest.ifElseTest(-1). Expected: false, Real: " + IfTest.ifElseTest(-1));
-        System.out.println("test IfTest.ifElseTest(0). Expected: true, Real: " + IfTest.ifElseTest(0));
-        System.out.println("test IfTest.ifElseTest(11). Expected: true, Real: " + IfTest.ifElseTest(11));
+        System.out.println("test IfTest instance created. Expected: non-null, Real: " + (ifTest != null));
+        System.out.println("test IfTest.ifElseTest(-1). Expected: false, Real: " + ifTest.ifElseTest(-1));
+        System.out.println("test IfTest.ifElseTest(0). Expected: true, Real: " + ifTest.ifElseTest(0));
+        System.out.println("test IfTest.ifElseTest(11). Expected: true, Real: " + ifTest.ifElseTest(11));
+        // MultiClassTest tests
+        System.out.println("test MultiClassTest instance created. Expected: non-null, Real: " + (multiClass != null));
         // SingletonTest tests
         System.out.println("test SingletonTest.getInstance(). Expected: non-null, Real: " + (singleton.getInstance() != null));
         // WhileTest tests

src/Testsuite/tastFiles/ArithmeticTest.tast

@@ -1,55 +0,0 @@
-[
-  Class "ArithmeticTest"
-    []
-    [ Method "int" "basic" [("int", "a"), ("int", "b"), ("int", "c")]
-        (TypedStmt
-          (Block
-            [ TypedStmt
-                (Return
-                  (Just
-                    (Binary Subtract
-                      (Binary Add
-                        (LocalOrFieldVar "a" "int")
-                        (LocalOrFieldVar "b" "int")
-                      )
-                      (Binary Modulo
-                        (Binary Divide
-                          (Binary Multiply
-                            (LocalOrFieldVar "c" "int")
-                            (LocalOrFieldVar "a" "int")
-                          )
-                          (LocalOrFieldVar "b" "int")
-                        )
-                        (LocalOrFieldVar "c" "int")
-                      )
-                    )
-                  )
-                )
-                "int"
-            ]
-          )
-          "int"
-        )
-    , Method "boolean" "logic" [("boolean", "a"), ("boolean", "b"), ("boolean", "c")]
-        (TypedStmt
-          (Block
-            [ TypedStmt
-                (Return
-                  (Just
-                    (Binary And
-                      (Unary Not (LocalOrFieldVar "a" "boolean") "boolean")
-                      (Binary Or
-                        (LocalOrFieldVar "c" "boolean")
-                        (LocalOrFieldVar "b" "boolean")
-                        "boolean"
-                      )
-                    )
-                  )
-                )
-                "boolean"
-            ]
-          )
-          "boolean"
-        )
-    ]
-]

src/Testsuite/tastFiles/EmptyTest.tast

@@ -1,3 +0,0 @@
-[
-  Class "EmptyTest" [] []
-]

src/Testsuite/test-programs/ClassWithInt/ClassWithInt.java

@@ -1,3 +0,0 @@
-class ClassWithInt {
-  Integer i;
-}

test.sh

@@ -0,0 +1,66 @@
+#!/bin/bash
+
+# run all tests:   ./test.sh 2>&1 | grep -E "Testing|Results"
+# inspect a diff:  diff <(javap -c /tmp/compoiler-ref/FieldsTest.class) <(javap -c /tmp/compoiler-out/FieldsTest.class)
+
+JAVA_DIR="src/Testsuite/javaFiles"
+REF_DIR="/tmp/compoiler-ref"
+OUT_DIR="/tmp/compoiler-out"
+PASS=0
+FAIL=0
+ERROR=0
+
+mkdir -p "$REF_DIR" "$OUT_DIR"
+
+for javafile in "$JAVA_DIR"/*.java; do
+  classname=$(basename "$javafile" .java)
+  echo -n "Testing $classname ... "
+
+  # Run our compiler
+  compiler_out=$(src/Main "$javafile" 2>&1)
+  if [ $? -ne 0 ]; then
+    echo "ERROR (compiler crashed)"
+    echo "  $compiler_out"
+    ((ERROR++))
+    continue
+  fi
+
+  # Move generated .class to OUT_DIR
+  mv "out/${classname}.class" "$OUT_DIR/" 2>/dev/null
+  if [ ! -f "$OUT_DIR/${classname}.class" ]; then
+    echo "ERROR (no .class generated)"
+    ((ERROR++))
+    continue
+  fi
+
+  # Compile reference with javac
+  javac "$javafile" -d "$REF_DIR" 2>/dev/null
+  if [ ! -f "$REF_DIR/${classname}.class" ]; then
+    echo "ERROR (javac failed)"
+    ((ERROR++))
+    continue
+  fi
+
+  # Compare structure and bytecode only (strip CP indices from instructions,
+  # skip debug info like LineNumberTable and SourceFile)
+  normalize() {
+    javap -c "$1" 2>&1 \
+      | grep -v "^Classfile\|Last modified\|SHA-256\|Compiled from\|LineNumberTable\|line [0-9]\|SourceFile" \
+      | sed 's/#[0-9]*/\#N/g' \
+      | sed 's/[[:space:]]*\/\/.*$//'
+  }
+  ref=$(normalize "$REF_DIR/${classname}.class")
+  mine=$(normalize "$OUT_DIR/${classname}.class")
+
+  if diff <(echo "$ref") <(echo "$mine") > /dev/null 2>&1; then
+    echo "PASS"
+    ((PASS++))
+  else
+    echo "FAIL"
+    diff <(echo "$ref") <(echo "$mine")
+    ((FAIL++))
+  fi
+done
+
+echo ""
+echo "Results: $PASS passed, $FAIL failed, $ERROR errors"