C64-dev/newLang/scripts/verify-parser-test.ps1

# E03-S01: run the parser over every fixture in x128 and check the ERR files
# and the recorded top-level types against the fixtures' expectations.
[CmdletBinding()]
param([int]$Port = 6535, [int]$TimeoutSeconds = 300)

$ErrorActionPreference = "Stop"
$project = Split-Path $PSScriptRoot -Parent
Import-Module (Join-Path $PSScriptRoot "lib\Nova128Test.psm1") -Force
. (Join-Path $PSScriptRoot "build-parser-test.ps1")          # defines $ParserFixtures
$out = Join-Path $project "build\parser-test"
$disk = Join-Path $out "parser-test.d81"

# Catalog: symbol -> number.
$codes = @{}
foreach ($line in Get-Content (Join-Path $project "src\common\diagcat.inc")) {
    $m = [regex]::Match($line, '^\s*DIAGNOSTIC\s+(\w+),\s*(\d+),')
    if ($m.Success) { $codes[$m.Groups[1].Value] = [int]$m.Groups[2].Value }
}

$session = Start-Nova128X128 -Autostart $disk -Drive8Image $disk -Port $Port `
    -Screenshot (Join-Path $out "parser-test-vicii.png")
try {
    $mb = Wait-Nova128Mailbox $session -TimeoutSeconds $TimeoutSeconds
    $dump = Read-Nova128Memory $session ($mb[8] + 256 * $mb[9]) ($mb[10] + 256 * $mb[11])
} finally {
    Stop-Nova128X128 $session
}
if ($mb[3] -ne 0xA5) { throw ("C128 reported FAIL (code `${0:X2})" -f $mb[4]) }

# ------------------------------------------------------------ decode dump
function ConvertFrom-Spelling([byte[]]$bytes) {
    return -join ($bytes | ForEach-Object {
        if ($_ -ge 0x41 -and $_ -le 0x5A) { [char]($_ + 0x20) } elseif ($_ -ge 0xC1 -and $_ -le 0xDA) { [char]($_ - 0x80) } else { [char]$_ } })
}
# A name is a length and its spelling; a type is base, name, length lo/hi.
# Both are rendered lowercase, as the oracle below writes them.
function Read-DumpName {
    $len = $dump[$script:p]; $script:p++
    if ($len -eq 0) { return "" }
    $s = ConvertFrom-Spelling $dump[$script:p..($script:p + $len - 1)]
    $script:p += $len
    return $s.ToLower()
}
function Read-DumpType {
    $base = $dump[$script:p]; $script:p++
    $name = Read-DumpName
    $n = $dump[$script:p] + 256 * $dump[$script:p + 1]; $script:p += 2
    $t = @("none", "boolean", "byte", "char", "integer", "word", $name)[$base]
    if ($n) { $t += "[$n]" }
    return $t
}
$records = @(); $script:p = 0
while ($dump[$p] -ne 0xFE) {
    if ($dump[$p] -ne 0xFF) { throw "dump out of sync at $p" }
    $r = [pscustomobject]@{ Index = $dump[$p + 1]; Load = $dump[$p + 2]; Count = $dump[$p + 3]
        MinSp = $dump[$p + 4]; Types = @(); Members = @(); Layout = @(); Trace = $null }
    $p += 5
    while ($dump[$p] -ne 0xFD -and $dump[$p] -ne 0xFC -and $dump[$p] -ne 0xFB -and $dump[$p] -ne 0xFA) {
        $len = $dump[$p + 3]
        $spell = ConvertFrom-Spelling $dump[($p + 4)..($p + 3 + $len)]
        $r.Types += ("{0} {1} {2}" -f @("", "interface", "class", "program")[$dump[$p]], $spell, ($dump[$p + 1] + 256 * $dump[$p + 2]))
        $p += 4 + $len
    }
    if ($dump[$p] -eq 0xFC) {
        $p++
        while ($dump[$p] -ne 0xFD -and $dump[$p] -ne 0xFB -and $dump[$p] -ne 0xFA) {
            $owner = Read-DumpName
            $name = Read-DumpName
            $flags = $dump[$p]; $p++
            $type = Read-DumpType
            $count = $dump[$p]; $p++
            $params = @(for ($k = 0; $k -lt $count; $k++) { Read-DumpType })
            $r.Members += ("{0}.{1} {2} {3} {4} ({5})" -f $owner, $name,
                $(if ($flags -band 1) { "method" } else { "field" }),
                $(if ($flags -band 2) { "private" } else { "public" }), $type, ($params -join ","))
        }
        if ($dump[$p] -eq 0xFA) {
            $p++
            while ($dump[$p] -ne 0xFD -and $dump[$p] -ne 0xFB) {
                $owner = Read-DumpName
                $size = $dump[$p] + 256 * $dump[$p + 1]; $p += 2
                $count = $dump[$p]; $p++
                $r.Layout += ("{0} size {1}" -f $owner, $size)
                for ($k = 0; $k -lt $count; $k++) {
                    $fname = Read-DumpName
                    $off = $dump[$p] + 256 * $dump[$p + 1]; $p += 2
                    $r.Layout += ("{0}.{1} offset {2}" -f $owner, $fname, $off)
                }
            }
        }
        if ($dump[$p] -eq 0xFB) {
            $n = $dump[$p + 1] + 256 * $dump[$p + 2]
            $r.Trace = if ($n) { [byte[]]$dump[($p + 3)..($p + 2 + $n)] } else { [byte[]]@() }
            $p += 3 + $n
        }
    }
    $p++
    $records += $r
}

# Expression trace -> "line: postfix" strings. Operands are named by the
# source text at their column; operators by their symbol (parser.inc TR_*).
$traceOps = @{ 0x17 = "="; 0x1E = "<>"; 0x1C = "<"; 0x1D = ">"; 0x1F = "<="; 0x20 = ">="
    0x18 = "+"; 0x19 = "-"; 0x1A = "*"; 0x1B = "/"; 0x40 = "and"; 0x53 = "or" }
function ConvertFrom-Trace([byte[]]$trace, [string[]]$lines) {
    $out = @(); $k = 0; $cur = $null
    while ($k -lt $trace.Length) {
        $b = $trace[$k]
        if ($b -eq 0xFF) {
            if ($cur) { $out += $cur }
            $line = $trace[$k + 1] + 256 * $trace[$k + 2]; $k += 3
            $cur = "${line}:"; $src = $lines[$line - 1]; continue
        }
        if ($b -eq 0xF0) { $cur += " neg" }
        elseif ($b -eq 0xF1) { $cur += " not" }
        elseif ($b -ge 0x80) { $cur += " " + $traceOps[$b - 0x80] }
        else {
            $m = [regex]::Match($src.Substring($b - 1), '^(\w+|"[^"]*"|''.'')')
            $cur += " " + $m.Value.ToLower()
        }
        $k++
    }
    if ($cur) { $out += $cur }
    return ,$out
}

# Members the source declares, derived independently by regex: per class or
# interface in order; access defaults (fields private, methods public);
# a second declaration of a name in the same namespace is not recorded.
$typeRx = '(boolean|byte|char|integer|word|\w+)(\[(\d+)\])?'
function Format-SourceType([string]$base, [string]$n) {
    $t = $base.ToLower(); if ($n) { $t += "[$n]" }; return $t
}
function Get-SourceMembers([string]$path) {
    $members = @(); $seen = @{}; $owner = $null; $inBody = $false
    foreach ($line in Get-Content -LiteralPath $path) {
        if ($line -match '^\s*(interface|class)\s+(\w+)') { $ownerKind = $Matches[1]; $owner = $Matches[2].ToLower(); continue }
        if ($line -match '^\s*end\s+(interface|class)\b') { $owner = $null; continue }
        if ($line -match '^\s*end\s+method\b') { $inBody = $false; continue }
        if (-not $owner -or $inBody) { continue }
        $m = [regex]::Match($line, "^\s*(public|private)?\s*method\s+(\w+)\s*\((.*)\)\s*(as\s+$typeRx)?\s*$")
        if ($m.Success) {
            $kind = "method"; $name = $m.Groups[2].Value.ToLower()
            $access = if ($m.Groups[1].Value -eq "private") { "private" } else { "public" }
            $type = if ($m.Groups[4].Success) { Format-SourceType $m.Groups[5].Value $m.Groups[7].Value } else { "none" }
            $params = @(foreach ($part in ($m.Groups[3].Value -split ',' | Where-Object { $_.Trim() })) {
                $pm = [regex]::Match($part.Trim(), "^\w+\s+as\s+$typeRx$")
                Format-SourceType $pm.Groups[1].Value $pm.Groups[3].Value })
            $inBody = ($ownerKind -eq "class")         # interface methods have no body
        } else {
            $m = [regex]::Match($line, "^\s*(public|private)?\s*$typeRx\s+(\w+)\s*$")
            if (-not $m.Success) { continue }
            $kind = "field"; $name = $m.Groups[5].Value.ToLower()
            $access = if ($m.Groups[1].Value -eq "public") { "public" } else { "private" }
            $type = Format-SourceType $m.Groups[2].Value $m.Groups[4].Value
            $params = @()
        }
        $key = "$owner.$kind.$name"
        if ($seen[$key]) { continue }
        $seen[$key] = $true
        $members += ("{0}.{1} {2} {3} {4} ({5})" -f $owner, $name, $kind, $access, $type, ($params -join ","))
    }
    return ,$members
}
# Fixtures whose member tables are compared (headers all well formed).
$memberChecked = @("members.n8", "lifecycle.n8", "scopes.n8", "private.n8")

$c1541 = Get-ViceTool "c1541"
$listing = (& $c1541 -attach $disk -list 2>&1) | Out-String
function Get-ErrLines([string]$base) {
    $dest = Join-Path $out "$base.err.bin"
    if (Test-Path $dest) { Remove-Item $dest -Force }
    if ($listing -notmatch ('"' + [regex]::Escape("$base.err") + '"')) { return $null }
    & $c1541 -attach $disk -read "$base.err,s" $dest 2>&1 | Out-Null
    # The leading comma keeps a one-line file an array (PowerShell unrolls it).
    # Names keep their source spelling: shifted PETSCII letters ($C1-$DA) are
    # capitals; messages are compared case-insensitively.
    $text = -join ([IO.File]::ReadAllBytes($dest) | ForEach-Object {
        if ($_ -ge 0xC1 -and $_ -le 0xDA) { [char]($_ - 0x80) } else { [char]$_ } })
    return ,@(($text.TrimEnd("`r")) -split "`r")
}
function Parse-Err([string]$line) {
    $m = [regex]::Match($line, '^E(\d{3}) \S+ (\d+) (\d+) (.*)$')
    return [pscustomobject]@{ Code = [int]$m.Groups[1].Value; Line = [int]$m.Groups[2].Value
        Col = [int]$m.Groups[3].Value; Message = $m.Groups[4].Value }
}

# ---------------------------------------------------------------- check
$failures = @(); $i = 0; $minSp = 0xFF
foreach ($name in $ParserFixtures.Keys) {
    $src, $group, $expect = $ParserFixtures[$name]
    $base = $name -replace '\.n8$', ''
    $r = $records[$i]; $i++
    $errLines = Get-ErrLines $base
    $problems = @()
    if ($r.Load -ne 0) { $problems += "src_load returned $($r.Load)" }
    switch ($group) {
        { $_ -eq "accepted" -or $_ -eq "layout" } {
            if ($r.Count -ne 0) { $problems += "$($r.Count) diagnostic(s): $($errLines -join ' | ')" }
            if ($null -ne $errLines) { $problems += "an ERR file exists" }
            $want = @()
            $n = 0
            foreach ($line in Get-Content -LiteralPath $src) {
                $n++
                $m = [regex]::Match($line, '^\s*(interface|class|program)\s+(\w+)')
                if ($m.Success) { $want += ("{0} {1} {2}" -f $m.Groups[1].Value, $m.Groups[2].Value, $n) }
            }
            if ((($r.Types | Sort-Object) -join ';') -ne (($want | Sort-Object) -join ';')) {
                $problems += "types [$($r.Types -join '; ')] expected [$($want -join '; ')]"
            }
            $detail = "{0} types" -f $r.Types.Count
        }
        "rejected" {
            $text = Get-Content -Raw -LiteralPath $expect
            $sym = [regex]::Match($text, '(?m)^diagnostic: (\w+)').Groups[1].Value
            $wantLine = [int][regex]::Match($text, '(?m)^line: (\d+)').Groups[1].Value
            $colMatch = [regex]::Match($text, '(?m)^column: (\d+)')
            if ($null -eq $errLines) { $problems += "no ERR file" }
            else {
                $first = Parse-Err $errLines[0]
                if ($first.Code -ne $codes[$sym] -or $first.Line -ne $wantLine -or
                    ($colMatch.Success -and $first.Col -ne [int]$colMatch.Groups[1].Value)) {
                    $problems += "first diagnostic '$($errLines[0])' expected $sym (E$($codes[$sym])) at line $wantLine"
                }
            }
            $detail = if ($errLines) { $errLines[0] } else { "" }
        }
        "exact" {
            # SYMBOL line column [message]; a message is compared when given.
            $rows = @(Get-Content -LiteralPath $expect | Where-Object { $_ -and -not $_.StartsWith("//") } | ForEach-Object {
                $f = $_ -split ' ', 4
                [pscustomobject]@{ Key = "{0} {1} {2}" -f $codes[$f[0]], $f[1], $f[2]; Message = $f[3] } })
            $want = @($rows | ForEach-Object { $_.Key })
            $errs = @($errLines | Where-Object { $_ } | ForEach-Object { Parse-Err $_ })
            $got = @($errs | ForEach-Object { "{0} {1} {2}" -f $_.Code, $_.Line, $_.Col })
            if (($got -join ';') -ne ($want -join ';')) {
                $problems += "diagnostics [$($got -join '; ')] expected [$($want -join '; ')]"
            } else {
                for ($k = 0; $k -lt $rows.Count; $k++) {
                    if ($rows[$k].Message -and $rows[$k].Message.ToUpper() -ne $errs[$k].Message.ToUpper()) {
                        $problems += "E$($errs[$k].Code) at $($errs[$k].Line):$($errs[$k].Col) says '$($errs[$k].Message)', expected '$($rows[$k].Message)'"
                    }
                }
            }
            $detail = "{0} diagnostics" -f $got.Count
        }
    }
    if ($group -in @("accepted", "layout") -or $memberChecked -contains $name) {
        $wantMembers = Get-SourceMembers $src
        if (($r.Members -join ';') -ne ($wantMembers -join ';')) {
            $problems += "members [$($r.Members -join '; ')] expected [$($wantMembers -join '; ')]"
        }
        $detail += ", {0} members" -f $r.Members.Count
    }
    if ($group -eq "accepted" -and $expect) {          # expression trace golden
        $want = @(Get-Content -LiteralPath $expect | Where-Object { $_ -and -not $_.StartsWith("//") })
        if ($null -eq $r.Trace) { $problems += "no expression trace" }
        else {
            $got = ConvertFrom-Trace $r.Trace @(Get-Content -LiteralPath $src)
            for ($k = 0; $k -lt [Math]::Max($got.Count, $want.Count); $k++) {
                if ($got[$k] -ne $want[$k]) { $problems += "trace '$($got[$k])' expected '$($want[$k])'" }
            }
            $detail += ", {0} traced statements" -f $got.Count
        }
    }
    if ($group -eq "layout") {
        $want = @(Get-Content -LiteralPath $expect | Where-Object { $_ -and -not $_.StartsWith("//") })
        if (($r.Layout -join ';') -ne ($want -join ';')) {
            $problems += "layout [$($r.Layout -join '; ')] expected [$($want -join '; ')]"
        }
        $detail += ", {0} layout lines" -f $r.Layout.Count
    }
    if ($r.MinSp -ne 0xFF -and $r.MinSp -lt $minSp) { $minSp = $r.MinSp }
    $status = if ($problems) { "FAIL" } else { "ok" }
    Write-Host ("  {0,-13} {1,-9} {2} {3}" -f $name, $group, $status, $detail)
    if ($problems) { $failures += "${name}: " + ($problems -join "; ") }
}
# The expression bound must leave hardware stack to spare (KERNAL calls and
# interrupts run below the parser).
if ($minSp -lt 0x60) { $failures += ("expression parsing took the stack down to `${0:X2}" -f $minSp) }
if ($failures) { throw ("parser verification failed:`n  " + ($failures -join "`n  ")) }
Write-Host ("verified parser: {0} fixtures; lowest stack pointer in expressions `${1:X2}" -f $ParserFixtures.Count, $minSp)