#!/usr/bin/env bash
# Does the JS dialect agree with LLVM, or refuse in its own words?
#
# Shaped after spike/x86/survey.sh and for the same reason: the only honest
# test of a backend is what the program prints and what it exits with. Every
# program in test/programs is built both ways -- native through LLVM, and one
# .js run by node -- and stdout, stderr and the exit status are all diffed.
#
# The difference from the x86 sweep is what a refusal means. That backend is
# *behind*: every node it refuses is one it will lower eventually, so a
# refusal there is a regression and the strict mode fails on one. This is a
# *dialect*: docs/DISCUSS.md item 5 decided that object mapping leaves the
# memory model behind, so a program using pointers, allocators, a Map, a Pool,
# the FFI or conditions is refused permanently and correctly. A refusal here
# is therefore an expected outcome and not a failure -- what fails is a
# DIFFER, which is a wrong answer, and a CRASH, which is a program the backend
# emitted and node would not run.
#
# Five outcomes:
#
#   MATCH    built both ways, same stdout, same stderr, same exit status
#   DIFFER   built both ways, and disagreed
#   REFUSED  Js.Unsupported -- named by the backend, with a location (exit 3)
#   CRASH    emitted JS that node refused to run, or that threw
#   SKIP     no main, does not compile at all, or does not terminate
#
# Over test/programs, and over spike/js's own probes, which are here for the
# paths the corpus does not walk -- p1-int-semantics.flan in particular is the
# evidence for the wrapping, division and shift decisions in lib/js.ml's
# header, and it is in the corpus rather than run by hand so that the evidence
# is the sweep.
#
# Usage: spike/js/survey.sh [name-substring ...]
set -u
orig=$(pwd)
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$root" || exit 1

# FLAN is how the dune @js alias hands this script a compiler dune has already
# built; building it here would be a second dune inside the first one's lock.
# See spike/x86/survey.sh, which says the same thing at more length.
if [ -n "${FLAN:-}" ]; then
  case $FLAN in /*) flan=$FLAN;; *) flan=$orig/$FLAN;; esac
else
  dune build --root . bin/main.exe 2>&1 | head -30
  flan=$root/_build/default/bin/main.exe
fi
test -x "$flan" || { echo "build failed"; exit 1; }

# node is the host. Guarded rather than assumed: this sweep is opt-in and a
# machine without node should say so and stop, not report zero of everything.
node=${NODE:-node}
if ! command -v "$node" > /dev/null 2>&1; then
  echo "js survey: no $node on PATH, nothing run"
  exit 0
fi

corpus=${SURVEY_CORPUS:-$root}
out=$(mktemp -d); trap 'rm -rf "$out"' EXIT

# The ones that run until something stops them, excluded by name for the reason
# the x86 sweep excludes them: a timeout cannot tell them from a hang -- and in
# dev-chatty's case cannot even give the two sides the same truncation, since
# it prints 4K a frame for as long as it is allowed to.
forever="dev-loop dev-watch dev-chatty"

TIMEOUT=${TIMEOUT:-20}

# Extra flags, given to *both* sides, the way the x86 sweep hands them over.
# SURVEY_FLAGS=--no-bounds-checks is the one with a use here: this backend
# emits a *second* indexing path when the checks are off -- a bare a[i] and a
# bare s.a[s.o + i], with no $at around either -- and a path the sweep never
# walks is a path nobody has run. Swept: 23 MATCH, 0 DIFFER, with arith.flan
# the one CRASH, and it is not one -- that program indexes out of range on
# purpose, so with the checks off the native build segfaults and node throws,
# and neither answer is defined. Nothing else changes.
read -r -a extra <<<"${SURVEY_FLAGS:-}"

declare -a match=() differ=() refused=() crash=() skip=()

for src in "$corpus"/test/programs/*.flan "$corpus"/spike/js/*.flan; do
  name=$(basename "$src" .flan)
  if [ $# -gt 0 ]; then
    want=0
    for pat in "$@"; do case "$name" in *"$pat"*) want=1;; esac; done
    [ $want = 1 ] || continue
  fi
  case " $forever " in *" $name "*) skip+=("$name:runs-forever"); continue;; esac

  # LLVM first. A program that does not compile at all, or has no main, is not
  # this backend's business -- the frontend refused it either way.
  if ! "$flan" build "$src" "${extra[@]}" -o "$out/$name.llvm" \
       >"$out/$name.llvm.err" 2>&1; then
    if grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then
      skip+=("$name:no-main")
    else
      skip+=("$name:does-not-compile")
    fi
    continue
  fi

  "$flan" build "$src" --target=js "${extra[@]}" -o "$out/$name.js" \
    >"$out/$name.js.err" 2>&1
  rc=$?
  if [ $rc = 3 ]; then
    why=$(head -1 "$out/$name.js.err" | sed 's/^js: //' | sed 's/^[^ ]*flan:[0-9]*:[0-9]*: //')
    refused+=("$name:$why")
    continue
  fi
  if [ $rc != 0 ]; then
    crash+=("$name:compiler:$(head -1 "$out/$name.js.err")")
    continue
  fi

  ( cd "$out" && timeout "$TIMEOUT" "$out/$name.llvm" \
      >"$out/$name.llvm.out" 2>"$out/$name.llvm.diag" )
  a=$?
  ( cd "$out" && timeout "$TIMEOUT" "$node" "$out/$name.js" \
      >"$out/$name.js.out" 2>"$out/$name.js.diag" )
  b=$?
  # node's own failure -- a SyntaxError, a ReferenceError, a thrown Error --
  # is not a disagreement about a value. It is a backend that emitted
  # something it should have refused, and it gets its own bucket so that the
  # two are never confused in the counts.
  if grep -q "^[A-Za-z]*Error:\|node:internal" "$out/$name.js.diag" 2>/dev/null; then
    crash+=("$name:node:$(grep -m1 "^[A-Za-z]*Error:" "$out/$name.js.diag" | head -c 120)")
    continue
  fi
  if [ "$a" = "$b" ] && cmp -s "$out/$name.llvm.out" "$out/$name.js.out" \
     && cmp -s "$out/$name.llvm.diag" "$out/$name.js.diag"; then
    match+=("$name")
  else
    differ+=("$name:llvm=$a/js=$b")
    if [ "${SURVEY_SHOW:-}" = 1 ]; then
      echo "--- $name: llvm exit $a, js exit $b"
      diff "$out/$name.llvm.out" "$out/$name.js.out" | head -20
      diff "$out/$name.llvm.diag" "$out/$name.js.diag" | head -20
    fi
  fi
done

echo
echo "MATCH   ${#match[@]}"
echo "DIFFER  ${#differ[@]}"
[ "${#differ[@]}" = 0 ] || printf '          %s\n' "${differ[@]}"
echo "REFUSED ${#refused[@]}"
if [ "${#refused[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
  printf '%s\n' "${refused[@]}" | sed 's/^[^:]*://' | cut -c1-60 | sort | uniq -c \
    | sort -rn | sed 's/^/          /'
fi
echo "CRASH   ${#crash[@]}"
[ "${#crash[@]}" = 0 ] || printf '          %s\n' "${crash[@]}"
echo "SKIP    ${#skip[@]}"
if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then
  printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \
    | sed 's/^/          /'
fi

# Strict mode, for the @js alias. A refusal is *not* a failure here -- see the
# header -- so only a wrong answer and a program node could not run are.
if [ "${SURVEY_STRICT:-}" = 1 ]; then
  if [ "${#differ[@]}" != 0 ] || [ "${#crash[@]}" != 0 ]; then
    echo
    echo "js survey FAILED: ${#differ[@]} differ, ${#crash[@]} crash"
    exit 1
  fi
  echo
  echo "js survey ok: ${#match[@]} match, ${#refused[@]} refused by name"
fi