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]; Types = @(); Members = @() }
    $p += 4
    while ($dump[$p] -ne 0xFD -and $dump[$p] -ne 0xFC) {
        $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) {
            $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 ","))
        }
    }
    $p++
    $records += $r
}

# 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).
    return ,@(([Text.Encoding]::ASCII.GetString([IO.File]::ReadAllBytes($dest)).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 }
}

# ---------------------------------------------------------------- check
$failures = @(); $i = 0; $pending = @()
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) {
        "accepted" {
            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 { "" }
        }
        "pending" {
            if ($r.Count -ne 0) { $problems += "false diagnostic(s) before E03-S03: $($errLines -join ' | ')" }
            $pending += $name
            $detail = "pending E03-S03 (statement grammar); no false errors"
        }
        "exact" {
            $want = @(Get-Content -LiteralPath $expect | Where-Object { $_ -and -not $_.StartsWith("//") } | ForEach-Object {
                $f = $_ -split ' '; "{0} {1} {2}" -f $codes[$f[0]], $f[1], $f[2] })
            $got = @($errLines | Where-Object { $_ } | ForEach-Object { $e = Parse-Err $_; "{0} {1} {2}" -f $e.Code, $e.Line, $e.Col })
            if (($got -join ';') -ne ($want -join ';')) {
                $problems += "diagnostics [$($got -join '; ')] expected [$($want -join '; ')]"
            }
            $detail = "{0} diagnostics" -f $got.Count
        }
    }
    if ($group -eq "accepted" -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
    }
    $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 "; ") }
}
if ($failures) { throw ("parser verification failed:`n  " + ($failures -join "`n  ")) }
Write-Host ("verified parser: {0} fixtures ({1} pending E03-S03)" -f $ParserFixtures.Count, $pending.Count)