TP3/shell/tests/CompileTest.mod

MODULE CompileTest ;

(* Direct test harness for the TP3 compiler.

   Reads fixture paths from stdin, one per line, loads each into TextBuf
   exactly the way the shell's LoadWorkFile does, then calls Compiler.Compile
   and prints a one-line verdict plus a source excerpt with a caret under the
   error position.

   This is the fast loop for compiler work: no pty, no editor, no screen
   redraws - just Compile's own errNo / errPos, which is what actually
   matters.  (The pty harness in matrix.py covers the shell/editor UI.)

   Usage:  printf 'a.pas\nb.pas\n' | ./compiletest          *)

FROM Posix IMPORT read, write, open, close ;
FROM TextBuf IMPORT TextLimit, Clear, Length, CharAt, InsertCh ;
FROM Compiler IMPORT Compile, CodeBytes, DataBytes ;
FROM SYSTEM IMPORT ADR, BYTE ;

CONST
   STDIN = 0 ;
   STDOUT = 1 ;
   O_RDONLY = 0 ;

VAR
   lineBuf : ARRAY [0..255] OF CHAR ;
   path    : ARRAY [0..511] OF CHAR ;
   txt     : ARRAY [0..79] OF CHAR ;
   mark    : ARRAY [0..79] OF CHAR ;

PROCEDURE PutCh (ch : CHAR) ;
VAR n : LONGINT ;
BEGIN
   n := write (STDOUT, ADR (ch), 1)
END PutCh ;

PROCEDURE PutStr (s : ARRAY OF CHAR) ;
VAR i : CARDINAL ; n : LONGINT ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      n := write (STDOUT, ADR (s [i]), 1) ;
      INC (i)
   END
END PutStr ;

PROCEDURE PutCard (n : CARDINAL) ;
VAR dig : ARRAY [0..9] OF CHAR ; i : CARDINAL ;
BEGIN
   IF n = 0 THEN
      PutCh ("0")
   ELSE
      i := 0 ;
      WHILE n > 0 DO
         dig [i] := CHR (ORD ("0") + (n MOD 10)) ;
         n := n DIV 10 ;
         INC (i)
      END ;
      WHILE i > 0 DO
         DEC (i) ;
         PutCh (dig [i])
      END
   END
END PutCard ;

PROCEDURE NL ;
BEGIN
   PutCh (CHR (13)) ;
   PutCh (CHR (10))
END NL ;

PROCEDURE StrCopy (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   IF i <= HIGH (dst) THEN
      dst [i] := 0C
   END
END StrCopy ;

PROCEDURE ReadLineStr (VAR s : ARRAY OF CHAR) : BOOLEAN ;
(* one line from stdin; FALSE at EOF/blank line *)
VAR ch : CHAR ; n : LONGINT ; i : CARDINAL ;
BEGIN
   i := 0 ;
   s [0] := 0C ;
   LOOP
      n := read (STDIN, ADR (ch), 1) ;
      IF n # 1 THEN
         IF i = 0 THEN
            RETURN FALSE
         END ;
         s [i] := 0C ;
         RETURN TRUE
      END ;
      IF (ch = CHR (10)) OR (ch = CHR (13)) THEN
         IF i = 0 THEN
            RETURN FALSE
         END ;
         s [i] := 0C ;
         RETURN TRUE
      END ;
      IF i < HIGH (s) THEN
         s [i] := ch ;
         INC (i)
      END
   END
END ReadLineStr ;

PROCEDURE LoadFile (p : ARRAY OF CHAR) : BOOLEAN ;
(* same CR/LF normalisation as the shell's LoadWorkFile *)
VAR fd : INTEGER ; k : LONGINT ; b : BYTE ; prevCR : BOOLEAN ;
BEGIN
   fd := open (ADR (p), O_RDONLY, 0) ;
   IF fd < 0 THEN
      RETURN FALSE
   END ;
   Clear ;
   prevCR := FALSE ;
   LOOP
      IF Length () >= TextLimit THEN
         EXIT
      END ;
      k := read (fd, ADR (b), 1) ;
      IF k # 1 THEN
         EXIT
      END ;
      IF b = 26 THEN
         EXIT                             (* ^Z ends the text *)
      ELSIF b = 10 THEN
         IF NOT prevCR THEN
            InsertCh (Length (), CHR (13))  (* lone LF -> CR *)
         END ;
         prevCR := FALSE
      ELSIF b = 13 THEN
         InsertCh (Length (), CHR (13)) ;
         prevCR := TRUE
      ELSE
         InsertCh (Length (), CHR (ORD (b))) ;
         prevCR := FALSE
      END
   END ;
   k := close (fd) ;
   RETURN TRUE
END LoadFile ;

PROCEDURE ShowAt (pos : CARDINAL) ;
(* print the source around pos, with '^' under pos *)
VAR s, e, i : CARDINAL ;
BEGIN
   IF pos > 40 THEN
      s := pos - 40
   ELSE
      s := 0
   END ;
   e := pos + 30 ;
   IF e > Length () THEN
      e := Length ()
   END ;
   IF e > s + 78 THEN
      e := s + 78
   END ;
   i := 0 ;
   WHILE s + i < e DO
      txt [i] := CharAt (s + i) ;
      IF txt [i] = CHR (13) THEN
         txt [i] := " "
      END ;
      IF s + i = pos THEN
         mark [i] := "^"
      ELSE
         mark [i] := "-"
      END ;
      INC (i)
   END ;
   txt [i] := 0C ;
   mark [i] := 0C ;
   PutStr ("        " ) ;
   PutStr (txt) ;
   NL ;
   PutStr ("        " ) ;
   PutStr (mark) ;
   NL
END ShowAt ;

VAR
   errNo, errPos : CARDINAL ;
   ok : BOOLEAN ;
BEGIN
   PutStr ("FIXTURE  RESULT") ;
   NL ;
   WHILE ReadLineStr (lineBuf) DO
      StrCopy (path, lineBuf) ;
      IF LoadFile (path) THEN
         ok := Compile (errNo, errPos) ;
         IF ok THEN
            PutStr (lineBuf) ;
            PutStr ("  OK  code=") ;
            PutCard (CodeBytes ()) ;
            PutStr (" data=") ;
            PutCard (DataBytes ()) ;
            NL
         ELSE
            PutStr (lineBuf) ;
            PutStr ("  ERROR ") ;
            PutCard (errNo) ;
            PutStr (" at pos ") ;
            PutCard (errPos) ;
            NL ;
            ShowAt (errPos)
         END
      ELSE
         PutStr (lineBuf) ;
         PutStr ("  CANNOT OPEN") ;
         NL
      END
   END
END CompileTest.