Oberon-2 validator pilot (voc oracle, builds, tests)

grammars/Oberon2/README.md

@@ -0,0 +1,54 @@
+# Oberon-2 validator pilot
+
+`oberon2_oberon.atg` describes Oberon-2 (Wirth/Mössenböck). It
+generated cleanly with Coco/R V1.53 (`CR`) but needed three repairs
+before GNU Modula-2 (`gm2 -fiso`) could build it and real programs
+would parse — all diagnosed against `voc` as oracle:
+
+1. Duplicate `CASE` labels in the generated `statement` procedure:
+   ident-led `assignment` vs `ProcedureCall` merged into a single
+   `IdentTail` dispatch (`":="` vs `"("`, plus selectors).
+2. The classic optional-prefix trap in `qualident`: `[ident "."]`
+   committed on any identifier and then demanded `.`, so every
+   `TYPE T = INTEGER` failed (same fix as the Oberon-07 pilot:
+   `ident { "." ident }`).
+3. The reference grammar has no `FOR` statement at all — added
+   `FOR ident := ... TO ... [BY ...] DO ... END` (verified against
+   `voc`, which accepts `BY -1`).
+4. The reference `string` token used `"` quotes; Oberon strings use
+   `'` — fixed token and `noQuote` set.
+5. The designator's type-guard alternative `"(" qualident ")"`
+   shadowed calls with non-identifier arguments (`f(1)` failed while
+   `f(i)` parsed as a guard); merged to `"(" [ ExpList ] ")"`.
+6. Type-bound procedures gained their receiver:
+   `PROCEDURE [(VAR) v: T] [Name*] ...` (verified against `voc`).
+
+Two benign LL(1) warning families remain (dangling-`ELSE`-style,
+loop-exit greediness — both resolve correctly).
+
+Oberon-2 facts confirmed by probe (validator matches `voc`):
+no enumerations, `WITH` only in guarded-pointer form,
+`CASE` with `|` separators and `ELSE`, `LOOP`/`EXIT`, `RETURN`
+with optional value, `&`/`~`/`OR`, `IN`/`IS`, sets with `..`
+ranges, `NIL`, `NEW` (no dispose), `DIV`/`MOD`, `IMPORT` lists,
+`FORWARD` (`PROCEDURE ^ name`) declarations.
+
+## Build
+
+```sh
+./build.sh        # -> build/O2 (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 (O2 vs `voc`)
+
+Accept battery (22 cases: all statements, `FOR`/`BY`, `CASE`/`ELSE`,
+`LOOP`/`EXIT`, guarded `WITH`, `NEW`/deref, `ORD`, floats, strings,
+`Out` calls, `RETURN`) + `tests/deep.Mod` (records, pointers,
+multi-dim arrays, nested routines, type-bound procedures, all
+statements): **0 false positives**. Broken mutants (9): **0 missed**,
+positions close. (`i := 1` without `;` is accepted by `voc` too —
+separator leniency, correctly skipped.)

grammars/Oberon2/build.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+# Build the Oberon-2 syntax validator from oberon2_oberon.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/oberon2_oberon.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C oberon2_oberon.atg
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" OberonP.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 + '/OberonP.mod').read()
+old = '    OberonS.Reset; Get;\n    Oberon;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    OberonS.Reset; Get;\n    Oberon;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/OberonP.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== compile ==="
+for m in FileIO OberonS OberonP Oberon; 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 OberonS.o OberonP.o Oberon.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o O2 FileIO.o OberonS.o OberonP.o Oberon.mod
+echo "=== smoke ==="
+printf 'MODULE Hello;\nBEGIN\n  Out.String('"'"'hi'"'"'); Out.Ln\nEND Hello.\n' > Hello.Mod
+./O2 Hello.Mod
+printf 'MODULE T;\nBEGIN\nEND T. GARBAGE\n' > Garbage.Mod
+if ./O2 Garbage.Mod 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./O2 "$HERE/tests/deep.Mod"
+rm -f Hello.Mod Hello.LST Garbage.Mod Garbage.LST "$HERE/tests/deep.LST"

grammars/Oberon2/oberon2_oberon.atg

@@ -0,0 +1,96 @@
+(* Tags: OBERON2, TypeBound, Vischap, Extended *)
+COMPILER Oberon
+(* A grammar for Oberon *)
+
+CHARACTERS
+  eol      = CHR(13) .
+  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit    = "0123456789" .
+  hexDigit = digit + "ABCDEF" .
+  noQuote  = ANY - "'" - eol .
+
+IGNORE  CHR(9) .. CHR(13)
+
+COMMENTS
+  FROM "(*" TO "*)" NESTED
+
+TOKENS
+  ident   =  letter { letter | digit } .
+  integer  =  digit { digit } | digit { hexDigit } "H" .
+  real  =  digit { digit } "." { digit }
+           [ ("E" | "D") [ "+" | "-" ] digit { digit } ] .
+  CharConstant = digit { hexDigit } "X" .
+  string  =  "'" { noQuote } "'" .
+
+PRODUCTIONS
+  Oberon           =  module .
+  number           =  integer | real .
+  identdef         =  ident [ "*" ] .
+  qualident        =  ident { "." ident } .
+  ConstantDeclaration  =  identdef "=" ConstExpression .
+  ConstExpression  =  expression .
+  TypeDeclaration  =  identdef "=" type .
+  type             =  qualident | ArrayType | RecordType | PointerType | ProcedureType .
+  ArrayType        =  "ARRAY" length { "," length } "OF" type .
+  length           =  ConstExpression .
+  RecordType       =  "RECORD" [ "(" BaseType ")" ] FieldListSequence "END" .
+  BaseType         =  qualident .
+  FieldListSequence  =  FieldList { ";" FieldList } .
+  FieldList        =  [ IdentList ":" type ] .
+  IdentList        =  identdef { "," identdef } .
+  PointerType      =  "POINTER" "TO" type .
+  ProcedureType    =  "PROCEDURE" [ FormalParameters ] .
+  VariableDeclaration  =  IdentList ":" type .
+  designator       =  qualident { "." ident | "[" ExpList "]" | "(" [ ExpList ] ")" | "^"  } .
+  ExpList          =  expression { "," expression } .
+  expression       =  SimpleExpression [ relation SimpleExpression ] .
+  relation         =  "=" | "#" | "<" | "<=" | ">" | ">=" | "IN" | "IS" .
+  SimpleExpression =  [ "+" | "-" ] term { AddOperator term } .
+  AddOperator      =  "+" | "-" | "OR" .
+  term             =  factor { MulOperator factor } .
+  MulOperator      =  "*" | "/" | "DIV" | "MOD" | "&" .
+  factor           =  number | CharConstant | string | "NIL" | set
+                      | designator [ ActualParameters ]
+                      | "(" expression ")" | "~" factor .
+  set              =  "{" [ element { "," element } ] "}" .
+  element          =  expression [ ".." expression ] .
+  ActualParameters =  "(" [ ExpList ] ")" .
+  statement        =  [ ident IdentTail | IfStatement |
+                        CaseStatement | WhileStatement | RepeatStatement |
+                        LoopStatement | ForStatement | WithStatement | "EXIT" |
+                        "RETURN" [ expression ] ] .
+  IdentTail = { "." ident | "[" ExpList "]" | "(" [ ExpList ] ")" | "^" }
+              [ ":=" expression | "(" [ ExpList ] ")" ] .
+  StatementSequence =  statement { ";" statement } .
+  IfStatement      =  "IF" expression "THEN" StatementSequence
+                     { "ELSIF" expression "THEN" StatementSequence }
+                     [ "ELSE" StatementSequence ] "END" .
+  CaseStatement    =  "CASE" expression "OF" case { "|" case }
+                     [ "ELSE" StatementSequence ] "END" .
+  case             =  [ CaseLabelList ":" StatementSequence ] .
+  CaseLabelList    =  CaseLabels { "," CaseLabels } .
+  CaseLabels       =  ConstExpression [ ".." ConstExpression ] .
+  WhileStatement   =  "WHILE" expression "DO" StatementSequence "END" .
+  RepeatStatement  =  "REPEAT" StatementSequence "UNTIL" expression .
+  LoopStatement    =  "LOOP" StatementSequence "END" .
+  ForStatement     =  "FOR" ident ":=" expression "TO" expression
+                      [ "BY" ConstExpression ] "DO" StatementSequence "END" .
+  WithStatement    =  "WITH" qualident ":" qualident "DO" StatementSequence "END" .
+  ProcedureDeclaration  =  ProcedureHeading ";" ProcedureBody ident .
+  ProcedureHeading =  "PROCEDURE" [ "(" [ "VAR" ] ident ":" ident ")" ] [ "*" ] identdef [ FormalParameters ] .
+  ProcedureBody    =  DeclarationSequence [ "BEGIN" StatementSequence ] "END" .
+  ForwardDeclaration  =  "PROCEDURE" "^" ident [ "*" ] [ FormalParameters ] .
+  DeclarationSequence  =  {   "CONST" { ConstantDeclaration ";" }
+                            | "TYPE"  { TypeDeclaration ";" }
+                            | "VAR"   { VariableDeclaration ";" } }
+                          {   ProcedureDeclaration ";"
+                            | ForwardDeclaration ";" } .
+  FormalParameters =  "(" [ FPSection { ";" FPSection } ] ")" [ ":" qualident ] .
+  FPSection        =  [ "VAR" ] ident { "," ident } ":" FormalType .
+  FormalType       =  { "ARRAY" "OF" } (qualident | ProcedureType) .
+  ImportList       =  "IMPORT" import { "," import } ";" .
+  import           =  ident [ ":=" ident ] .
+  module           =  "MODULE" ident ";"
+                      [ ImportList ] DeclarationSequence
+                      [ "BEGIN" StatementSequence ] "END" ident "." .
+END Oberon.

grammars/Oberon2/tests/deep.Mod

@@ -0,0 +1,68 @@
+MODULE Deep;
+IMPORT Out;
+
+CONST N = 10;
+  Neg = -5;
+  Pi = 3.14159;
+  Hello = 'hi';
+
+TYPE
+  IntArr = ARRAY 10 OF INTEGER;
+  Matrix = ARRAY 2, 3 OF INTEGER;
+  Point = RECORD x, y: INTEGER END;
+  PInt = POINTER TO RECORD v: INTEGER END;
+  Node = POINTER TO NodeDesc;
+  NodeDesc = RECORD
+    key: INTEGER;
+    left, right: Node
+  END;
+
+VAR
+  i, j: INTEGER;
+  ch: CHAR;
+  b: BOOLEAN;
+  r: REAL;
+  a: IntArr;
+  pt: Point;
+  p: PInt;
+  t: Node;
+
+PROCEDURE Sum(a, b: INTEGER): INTEGER;
+BEGIN
+  RETURN a + b
+END Sum;
+
+PROCEDURE Fill(VAR a: IntArr; val: INTEGER);
+VAR k: INTEGER;
+BEGIN
+  FOR k := 1 TO N DO a[k] := val END
+END Fill;
+
+PROCEDURE (t: Node) Insert(key: INTEGER);
+BEGIN
+  t.key := key
+END Insert;
+
+BEGIN
+  FOR i := 1 TO N DO a[i] := i END;
+  WHILE i < N DO i := i + 1 END;
+  REPEAT
+    CASE i OF
+      1: Out.Int(1, 0)
+    | 2, 3: Out.Int(2, 0)
+    ELSE Out.Int(9, 0)
+    END
+  UNTIL i > N;
+  LOOP
+    IF i > N THEN EXIT END;
+    i := i + 1
+  END;
+  pt.x := Sum(1, 2);
+  NEW(p); p.v := 1;
+  NEW(t); t.Insert(5);
+  WITH p: PInt DO p.v := 2 END;
+  r := 1.5E-3;
+  b := (i = 1) & (j # 2) OR ~b;
+  Fill(a, 0);
+  Out.String('done'); Out.Ln
+END Deep.