TP3/calc-port/gm2-probes.sh

#!/bin/sh
# gm2-probes.sh -- what GNU Modula-2 (Gm2) accepts, measured.
#
# WHY THIS EXISTS
#   Porting Resources/TP3/CALC.PAS to Gnu Modula-2 needs to know which
#   ISO Modula-2 constructs the toolchain actually supports, because CALC
#   leans on several of them.  Rather than assume, this script compiles one
#   minimal module per construct and records accept/reject.
#
#   It is an ASSERTION, not a report: EXPECTED below is what was measured on
#   this machine.  If a future Gm2 gains (or loses) a construct, this goes red
#   and the difference is printed.  Re-baseline deliberately -- do not edit
#   EXPECTED to make a failure disappear.
#
# MEASURED ON
#   gm2 (GCC) 16.0.1 20260325 (experimental), invoked -fiso -Wall
#   /home/eric/bin/Modula2/Gm2/bin/gm2
#
# USAGE
#   sh calc-port/gm2-probes.sh          report, and check against EXPECTED
#   sh calc-port/gm2-probes.sh --bless  re-baseline EXPECTED from what it sees
#
# NOTE ON WRITING PROBE FILES
#   Use the heredocs below (quoted delimiter, so ' survives).  Do NOT try to
#   build these with `printf '%s' "$src"` -- %s does not expand \n, so the
#   module lands on one line and every diagnostic becomes nonsense.  Use
#   `printf "$fmt"` with \n in the FORMAT, or a heredoc.

GM2=${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}
DIR=$(mktemp -d "${TMPDIR:-/tmp}/gm2probe.XXXXXX") || exit 1
trap 'rm -rf "$DIR"' EXIT
BLESS=no
[ "$1" = "--bless" ] && BLESS=yes

# ---------------------------------------------------------------- probes ----
# name : expect(accept|reject) : one-line description
# Each probe is the smallest module that exercises exactly one construct.

emit() { cat > "$DIR/$1.mod"; }

emit char_literal              <<'EOF'
MODULE char_literal;
VAR c : CHAR;
BEGIN c := 'A' END char_literal.
EOF

emit array_of_char             <<'EOF'
MODULE array_of_char;
VAR s : ARRAY [0..70] OF CHAR;
BEGIN s [0] := 'x' END array_of_char.
EOF

emit string_into_char_array    <<'EOF'
MODULE string_into_char_array;
VAR s : ARRAY [0..5] OF CHAR;
BEGIN s := "ABS" END string_into_char_array.
EOF

emit array_subrange_bound      <<'EOF'
MODULE array_subrange_bound;
VAR a : ARRAY [0..20] OF INTEGER;
BEGIN a [0] := 1 END array_subrange_bound.
EOF

emit nested_proc_forward       <<'EOF'
MODULE nested_proc_forward;
PROCEDURE Go (n : INTEGER);
  PROCEDURE H (x : INTEGER) : BOOLEAN; FORWARD;
  PROCEDURE O (x : INTEGER);
  BEGIN IF H (x) THEN END END O;
  PROCEDURE H (x : INTEGER) : BOOLEAN;
  BEGIN RETURN x > 0 END H;
BEGIN O (n) END Go;
BEGIN Go (4) END nested_proc_forward.
EOF

emit nested_function           <<'EOF'
MODULE nested_function;
PROCEDURE Go (n : INTEGER);
  FUNCTION F (x : INTEGER) : INTEGER;
  BEGIN RETURN x END F;
BEGIN n := F (n) END Go;
BEGIN Go (4) END nested_function.
EOF

emit named_shortsubrange       <<'EOF'
MODULE named_shortsubrange;
TYPE Dec = 0..20;
VAR d : Dec;
BEGIN d := 2 END named_shortsubrange.
EOF

emit inline_shortsubrange      <<'EOF'
MODULE inline_shortsubrange;
VAR d : 0..20;
BEGIN d := 2 END inline_shortsubrange.
EOF

emit char_subrange_type        <<'EOF'
MODULE char_subrange_type;
TYPE Col = 'A'..'G';
VAR c : Col;
BEGIN c := 'A' END char_subrange_type.
EOF

emit enum_indexed_array        <<'EOF'
MODULE enum_indexed_array;
TYPE Sf = (fabs, fsqrt, fsqr);
     Nm = ARRAY [Sf] OF ARRAY [0..5] OF CHAR;
VAR c : CHAR;
BEGIN c := Nm [fsqrt] [1] END enum_indexed_array.
EOF

emit set_of_char_literal       <<'EOF'
MODULE set_of_char_literal;
VAR c : CHAR; b : BOOLEAN;
BEGIN b := c IN {'0'..'9'} END set_of_char_literal.
EOF

emit bitset_instead_of_set     <<'EOF'
MODULE bitset_instead_of_set;
(* CALC's `CellStatus : set of Attributes` and `Numbers : set of Char`
   have no SET OF here; BITSET + INCL + membership is the replacement. *)
VAR b : BITSET;
BEGIN
  b := {};
  INCL (b, 2);
  IF 2 IN b THEN INCL (b, 3) END
END bitset_instead_of_set.
EOF

emit char_range_comparisons    <<'EOF'
MODULE char_range_comparisons;
VAR c : CHAR; b : BOOLEAN;
BEGIN b := (c >= '0') AND (c <= '9') END char_range_comparisons.
EOF

# ------------------------------------------------------------- expected -----
# name:expect -- measured on gm2 16.0.1 -fiso, 2026-10-05
cat > "$DIR/EXPECTED" <<'EOF'
char_literal:accept
array_of_char:accept
string_into_char_array:accept
array_subrange_bound:accept
nested_proc_forward:accept
nested_function:reject
named_shortsubrange:reject
inline_shortsubrange:reject
char_subrange_type:reject
enum_indexed_array:reject
set_of_char_literal:reject
bitset_instead_of_set:accept
char_range_comparisons:accept
EOF

# ----------------------------------------------------------------- run ------
echo "gm2: $("$GM2" --version 2>&1 | head -1)"
echo
bad=0
for spec in \
  "char_literal:accept" \
  "array_of_char:accept" \
  "string_into_char_array:accept" \
  "array_subrange_bound:accept" \
  "nested_proc_forward:accept" \
  "nested_function:reject" \
  "named_shortsubrange:reject" \
  "inline_shortsubrange:reject" \
  "char_subrange_type:reject" \
  "enum_indexed_array:reject" \
  "set_of_char_literal:reject" \
  "bitset_instead_of_set:accept" \
  "char_range_comparisons:accept"
do
  name=${spec%%:*}
  want=${spec##*:}
  err=$("$GM2" -fiso -Wall -o "$DIR/$name" "$DIR/$name.mod" 2>&1 |
        grep ": error" | head -1)
  if [ -z "$err" ]; then got=accept; else got=reject; fi
  mark="   "
  if [ "$got" != "$want" ]; then mark="!! "; bad=$((bad+1)); fi
  printf '%s%-24s want=%-6s got=%-6s' "$mark" "$name" "$want" "$got"
  if [ -n "$err" ]; then
    printf '  %s' "$(printf '%s' "$err" | sed 's/.*error: //')"
  fi
  echo
done

echo
if [ "$BLESS" = yes ]; then
  echo "--bless: EXPECTED is written from what was just measured:"
  for spec in \
    "char_literal" "array_of_char" "string_into_char_array" \
    "array_subrange_bound" "nested_proc_forward" "nested_function" \
    "named_shortsubrange" "inline_shortsubrange" "char_subrange_type" \
    "enum_indexed_array" "set_of_char_literal" "bitset_instead_of_set" \
    "char_range_comparisons"
  do
    name=$spec
    err=$("$GM2" -fiso -Wall -o "$DIR/$name" "$DIR/$name.mod" 2>&1 |
          grep ": error" | head -1)
    if [ -z "$err" ]; then echo "$name:accept"; else echo "$name:reject"; fi
  done
  exit 0
fi

if [ "$bad" -eq 0 ]; then
  echo "PASS: all 13 constructs match what this Gm2 was measured to do"
  exit 0
fi
echo "FAIL: $bad construct(s) differ from EXPECTED -- Gm2 may have changed."
echo "      Re-run with --bless only if the new behaviour is understood."
exit 1