# 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 = @(); Trace = $null } $p += 5 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 -and $dump[$p] -ne 0xFB) { $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 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). 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; $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) { "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 { "" } } "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 } 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 ($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)