Pascal-S validator pilot (psc oracle, builds, tests)

grammars/PascalS/README.md

@@ -0,0 +1,84 @@
+# Pascal-S validator pilot
+
+`pascals.atg` describes Wirth Pascal-S (1976) as implemented by
+`PascalS0` (Turbo-Pascal batch interpreter). It was authored from the
+P2 pilot skeleton and corrected against some 90 oracle probes —
+every construct below was checked against the running interpreter
+(no fpc involved anywhere).
+
+## Oracle notes
+
+`psc` was built with `fpc -Mtp` from `Pascals/` plus a `/tmp`-only
+`TrmInOut` stub (the shipped unit needs DOS `REGISTERS`/`MsDos`;
+only console setup, irrelevant to parse verdicts). Behaviors the
+harness respects, all verified:
+
+- Verdicts come from the `.lst` listing: `******* ^ NNN` markers
+  (full error table printed in `PascalS0.pas:errormsg`); absence =
+  accept. Feeding is via `psc src.lst` args with stdin `</dev/null`
+  (renders blocking on `read` harmless); 15s timeout (valid programs
+  finish instantly).
+- Lowercase is accepted (Turbo scanner), so the validator uses
+  `IGNORE CASE` — unlike the P2 pilot.
+- Mandatory program heading with file list:
+  `program t (input, output);` (bare `program t;` is error 9).
+  `input`/`output` exist for `eof`/`eoln` only.
+
+Key probed Pascal-S facts: `and`/`or`/`not`/`div`/`mod` words;
+`if`/`while`/`repeat`/`for to/downto`/`case` (no `ELSE`, no
+`OTHERWISE`); `(* *)` comments that do not nest, plus `{}`;
+`const`/`type`/`var`/nested routines with `var` params; integer,
+real, char, boolean (no string/enum/subrange/pointer/set/file
+types); multi-dim arrays with const bounds; records without
+variants; `read`/`readln`/`write`/`writeln` (bare `writeln;` is
+legal!); write-widths; `odd`/`abs`/`ord`/`chr`; `eof`/`eoln` with
+mandatory file arg; unary signs only at expression start
+(`a + +b` is error 58, but `-a` is fine); `NOT` anywhere;
+single-statement branches; empty statements; char/enum-less case
+labels (`pnumber`/`ident`/`pstring`).
+
+Absent (all probed): labels/`goto`, `forward`, `packed`, sets,
+pointers (`^` is error 24), files, `with`, procedural params,
+`break`/`exit`/`halt`/`return`, `nil`, `_` in identifiers (error
+24), `//` comments, `OTHERWISE`, `max`, const expressions
+(`3 + 4` is error 6), multi-char const strings (error 50),
+`1.`/`.5` reals, `$`/`#` literals, `IN`, chained assignment,
+function-calls-as-statements (error 45).
+
+## Grammar notes
+
+Single-statement branches (avoids `;`-capture), `begin..end` as
+statements, trailing-`;`-tolerant sections/fields/case-items,
+order-free declaration sections, no label section at all,
+`EofCall` with mandatory `(file)` (which is what rejects bare
+`eof`), strict EOF check (patched into `Parse` by `build.sh`,
+which also fails on degenerate `IF/WHILE FALSE` generation).
+
+Lenient acceptances (documented, never false positives):
+multi-char const strings (a `pchar` token breaks V1.53
+determinism — probe H2 shows the oracle's error 50); bare
+builtin calls (`odd;` parses although only `eof`/`eoln` strictness
+was probed); `TYPE`-level constructs the oracle would mark
+semantically are out of scope for a syntax validator.
+
+## Build
+
+```sh
+./build.sh        # -> build/PascalS (build/ is git-ignored)
+```
+
+Needs `CR` (Coco/R), `gm2 -fiso`, the `parser.frm`/`scanner.frm`
+frames and `FileIO.def/.mod` — all resolved from the environment with
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`).
+
+## Differential results (PascalS vs `psc`)
+
+Accept battery (22 cases: all statements, arrays, records,
+`ord`/`chr`, reals, strings, `odd`, write-widths, `eof(input)`):
+**0 false positives**. Broken mutants (12: truncation, bad
+factors, unterminated comment, `@`, missing `TO`, `ELSE`,
+`goto`, `_`, `1..3`, set constructor): **0 missed**, positions
+close. Example corpus (`Pascals/eg0`–`eg7`): agree on all 8
+(`eg0`/`eg1` are intentionally broken and both sides reject them).
+`tests/deep.pas` (nested routines with `var` params, records,
+all statements, reals): clean on both sides.

grammars/PascalS/build.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+# Build the Pascal-S syntax validator from pascals.atg.
+# Needs: CR (Coco/R V1.53), gm2 -fiso, parser/scanner frames, FileIO.
+# Note: link via the two-step module list; a single-step link trips
+# over pre-existing errors in this gm2 build's own ISO library .defs.
+set -e
+CR="${CR:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+GM2="${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}"
+FRAMES="${CRFRAMES:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+M2LIB="${M2LIB:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+HERE="$(cd "$(dirname "$0")" && pwd)"
+B="$HERE/build"
+rm -rf "$B"
+mkdir -p "$B"
+cp "$HERE/pascals.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C pascals.atg
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" PascalSP.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== patch: EOF check ==="
+python3 - "$B" <<'PYEOF'
+import sys
+b = sys.argv[1]
+s = open(b + '/PascalSP.mod').read()
+old = '    PascalSS.Reset; Get;\n    PascalS;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    PascalSS.Reset; Get;\n    IF sym # 0 THEN PascalS END;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/PascalSP.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== compile ==="
+for m in FileIO PascalSS PascalSP PascalS; do "$GM2" -fiso -I . -c "$m.mod"; done
+echo "=== link ==="
+# NOTE: the gen step exits 1 on pre-existing errors in gm2's own
+# ISO library .defs, but still writes a usable modules.lst.
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o PascalSS.o PascalSP.o PascalS.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o PascalS FileIO.o PascalSS.o PascalSP.o PascalS.mod
+echo "=== smoke ==="
+printf 'program hello (input, output);\nbegin\n  writeln('"'"'hi'"'"');\nend.\n' > Hello.pas
+./PascalS Hello.pas
+printf 'program t (input, output);\nbegin\nend. GARBAGE\n' > Garbage.pas
+if ./PascalS Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./PascalS "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST"

grammars/PascalS/pascals.atg

@@ -0,0 +1,123 @@
+(* Pascal-S ATG for Coco/R *)
+(* Wirth Pascal-S (1976), as implemented by PascalS0 (Turbo batch) *)
+(* Lowercase ok (Turbo scanner); probed against psc, never fpc *)
+
+(* Tags: PASCALS, WIRTH *)
+
+COMPILER PascalS
+IGNORE CASE
+
+CHARACTERS
+  eol = CHR(13) .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit = "0123456789" .
+  noQuote1 = ANY - "'" - eol .
+IGNORE CHR(9) .. CHR(13)
+COMMENTS FROM "(*" TO "*)"
+COMMENTS FROM "{" TO "}"
+
+TOKENS
+  ident = letter { letter | digit } .
+  pnumber = digit { digit } | digit { digit } CONTEXT ( ".." ) .
+  preal = digit { digit } "." digit { digit } [ "E" [ "+" | "-" ] digit { digit } ] .
+  pstring = "'" { noQuote1 | "''" } "'" .
+
+
+
+
+PRODUCTIONS
+
+  PascalS = "program" ident "(" ident { "," ident } ")" ";" Block "." .
+
+  Block = DeclPart [ Compound ] .
+  Compound = "begin" Statements "end" .
+
+  DeclPart = { ConstSection | TypeSection | VarSection | ProcDecl } .
+
+  ConstSection = "const" [ ConstDecl { ";" [ ConstDecl ] } ] .
+  ConstDecl = ident "=" Value .
+  Value = [ "+" | "-" ] ( pnumber | preal | pstring | ident ) .
+
+  TypeSection = "type" [ TypeDecl { ";" [ TypeDecl ] } ] .
+  TypeDecl = ident "=" Type .
+
+  VarSection = "var" [ VarDecl { ";" [ VarDecl ] } ] .
+  VarDecl = identlist ":" Type .
+  ProcDecl = ( "procedure" | "function" ) ident [ FormalParams ] [ ":" Type ] ";" Block ";" .
+  FormalParams = "(" [ FormalGroup { ";" FormalGroup } ] ")" .
+  FormalGroup = [ "var" ] identlist ":" Type .
+
+  identlist = ident { "," ident } .
+
+  Type = SimpleType | StructType | TypeIdent .
+  TypeIdent = ident .
+
+  SimpleType = integertype | realtype | chartype | booleantype .
+
+  integertype = "integer" .
+  realtype = "real" .
+  chartype = "char" .
+  booleantype = "boolean" .
+
+  StructType = ArrayType | RecordType .
+
+  ArrayType = "array" "[" Bound { "," Bound } "]" "of" Type .
+
+  Bound = SimpleType | Value [ ".." Value ] .
+
+  RecordType = "record" FieldList "end" .
+
+  FieldList = [ Field { ";" [ Field ] } ] .
+
+  Field = identlist ":" Type .
+
+  Statements = [ Statement { ";" [ Statement ] } ] .
+
+  IfStatement = "if" Expr "then" Statement { "else" Statement } .
+
+  Statement = IfStatement
+            | CaseStmt
+            | WhileStmt
+            | RepeatStmt
+            | ForStmt
+            | ident IdentTail
+            | Compound
+            | ProcDecl .
+
+  CaseStmt = "case" Expr "of" [ CaseItem { ";" [ CaseItem ] } ] "end" .
+
+  CaseItem = CaseLabelList ":" Statement .
+
+  CaseLabelList = CaseLabel { "," CaseLabel } .
+  CaseLabel = pnumber | ident | pstring .
+
+  WhileStmt = "while" Expr "do" Statement .
+
+  RepeatStmt = "repeat" Statements "until" Expr .
+
+  ForStmt = "for" ident ":=" Expr ( "to" | "downto" ) Expr "do" Statement .
+
+  IdentTail = [ Selector { Selector } ] [ ":=" Expr | "(" [ ParamList ] ")" ] .
+  Selector = "." ident | "[" Expr { "," Expr } "]" .
+
+
+  ParamList = Param { "," Param } .
+
+  Param = Expr [ ":" Expr [ ":" Expr ] ] .
+
+  Expr = SimpleExpr [ Relationship SimpleExpr ] .
+
+  Relationship = "=" | "<" | ">" | "<=" | ">=" | "<>" .
+
+  SimpleExpr = ["+" | "-"] Term { ("+" | "-" | "or") Term } .
+
+  Term = Factor { ("*" | "/" | "div" | "mod" | "and") Factor } .
+
+  Factor = ["not"] Primary .
+
+  Primary = pnumber | preal | pstring | EofCall | "(" Expr ")" | ident { Selector } [ "(" [ ParamList ] ")" ] .
+  EofCall = ( "eof" | "eoln" ) "(" ident ")" .
+
+
+
+END PascalS.

grammars/PascalS/tests/deep.pas

@@ -0,0 +1,44 @@
+program deep (input, output);
+const n = 10;
+  neg = -5;
+  pi = 3.14159;
+  h = 'h';
+type
+  intarr = array [1..10] of integer;
+  matrix = array [0..1, 0..2] of integer;
+  point = record x, y: integer end;
+var
+  i, j: integer;
+  ch: char;
+  b: boolean;
+  r: real;
+  a: intarr;
+  pt: point;
+function sum(a, b: integer): integer;
+begin
+  sum := a + b
+end;
+function isodd(n: integer): boolean;
+begin
+  isodd := odd(n)
+end;
+procedure fill(var a: intarr; value: integer);
+var k: integer;
+begin
+  for k := 1 to n do a[k] := value
+end;
+begin
+  for i := 1 to n do a[i] := i;
+  while i < n do i := i + 1;
+  repeat
+    case i of
+      1: write(1);
+      2, 3: write(2)
+    end;
+  until i > n;
+  pt.x := sum(1, 2);
+  r := 1.5e-3;
+  b := (i = 1) and (j <> 2) or not b;
+  fill(a, 0);
+  writeln('done')
+end.