### -*-autotest-*-
###
### Test script for `runlisp'
###
### (c) 2020 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
###
### Runlisp is free software: you can redistribute it and/or modify it
### under the terms of the GNU General Public License as published by the
### Free Software Foundation; either version 3 of the License, or (at your
### option) any later version.
###
### Runlisp is distributed in the hope that it will be useful, but WITHOUT
### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
### FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
### for more details.
###
### You should have received a copy of the GNU General Public License
### along with Runlisp.  If not, see <https://www.gnu.org/licenses/>.

m4_define([RUNLISP_PATH], [$abs_top_builddir/runlisp])

m4_define([_FOREACH], [dnl
m4_if([$#], [1], [_foreach_func($1)],
	[_foreach_func($1)[]_FOREACH(m4_shift($@))])])
m4_define([FOREACH], [dnl
m4_pushdef([_foreach_func], [$2])dnl
_FOREACH($1)[]dnl
m4_popdef([_foreach_func])])

m4_define([LISP_SYSTEMS],
  [sbcl, sbcl/noimage,
   ccl, ccl/noimage,
   clisp, clisp/noimage,
   ecl, ecl/noimage,
   cmucl, cmucl/noimage,
   abcl, abcl/noimage])

m4_define([SETUP_RUNLISP_ENV],
[RUNLISP_SYSCONFIG=$abs_top_srcdir/runlisp-base.conf; export RUNLISP_SYSCONFIG
RUNLISP_SYSCONFIG_DIR=/notexist; export RUNLISP_SYSCONFIG_DIR
RUNLISP_IMAGEDIR=$abs_top_builddir; export RUNLISP_IMAGEDIR
RUNLISP_EVAL=$abs_top_srcdir/eval.lisp; export RUNLISP_EVAL
unset RUNLISP_USERCONFIG
])

m4_define([PREPARE_LISP_TEST],
[SETUP_RUNLISP_ENV
lisp=$1
LISP=$m4_translit(m4_bpatsubst([$1], [/.*$], []), [a-z], [A-Z])
AT_SKIP_IF([test "x$LISP" = x])
case $lisp in
  */*) opt=${lisp@%:@*/} lisp=${lisp%%/*} ;;
  *) opt="" ;;
esac
case /$opt/ in */noimage/*) RUNLISP_IMAGEDIR=./notexist ;; esac])

m4_define([WHICH_LISP],
[(or @%:@+sbcl "sbcl" @%:@+ccl "ccl" @%:@+clisp "clisp"
     @%:@+ecl "ecl" @%:@+cmu "cmucl" @%:@+abcl "abcl"
     "unknown")])

m4_define([NL], [
])

###--------------------------------------------------------------------------
### A basic smoke test.

## Check that the system basically works, by running a trivial test program.
## Also try to verify that we're not running user or site startup code,
## though this is hard to do in general.
FOREACH([LISP_SYSTEMS],
[AT_SETUP([$1 smoke])
AT_KEYWORDS([script smoke $1])
PREPARE_LISP_TEST([$1])

## Prepare a user-init file which will break the test if it's run by printing
## something unexpected.
mkdir HOME
case $lisp in
  sbcl) initfile=.sbclrc ;;
  ccl) initfile=.ccl-init.lisp ;;
  clisp) initfile=.clisprc.lisp ;;
  ecl) initfile=.eclrc ;;
  cmucl) initfile=.cmucl-init.lisp ;;
  abcl) initfile=.abclrc ;;
esac
cat >HOME/$initfile <<EOF
(format t "*** I should not be seen~%")
EOF
HOME=$(pwd)/HOME; export HOME

## Prepare the script.
cat >test-script <<EOF
@%:@! RUNLISP_PATH -L$lisp

;; Print a greeting to \`*standard-output*', identifying the Lisp system, so
;; that we can tell whether we called the right one.
(format t "Hello from ~A (~A)!~%" (lisp-implementation-type) WHICH_LISP)

@%:@! this should be a comment everywhere

;; Make sure that \`*error-output*' is hooked up properly.
(format *error-output* "to stderr~%")

;; Make sure that \`*standard-input*' is hooked up properly, by reading a
;; line and echoing it.
(format t "from stdin: ~S~%" (read-line))

;; Check that \`:runlisp-script' is set in \`*features*'.  If not, \`assert'
;; will at least write a complaint to some stream, which will fail the test.
(assert (member :runlisp-script *features*))

;; Check that there are no symbols present (interned or imported) in the
;; \`common-lisp-user' package.  Obviously, we must avoid interning any
;; ourselves.  Alas, ABCL and ECL pollute \`cl-user' out of the box.  (ECL
;; does this deliberately; ABCL's ``adjoin.lisp' lacks an \`in-package'
;; form.)
(let ((@%:@1=@%:@:syms (sort (loop :for @%:@2=@%:@:s :being
			       :the :present-symbols :of *package*
			     :collect @%:@2@%:@)
		       @%:@'string<)))
  (format t "package \`~A' [~:[ok~;has unexpected symbols ~:*~S~]]~%"
	  (package-name *package*) @%:@1@%:@))

;; Print the program name and command-line arguments.
(format t "program name = ~S~%~
	   arguments = ~:S~%"
	(uiop:argv0)
	uiop:*command-line-arguments*)
EOF
chmod +x test-script

case $lisp in
  sbcl) impl="SBCL" ;;
  ccl) impl="Clozure Common Lisp" ;;
  clisp) impl="CLISP" ;;
  ecl) impl="ECL" ;;
  cmucl) impl="CMU Common Lisp" ;;
  abcl) impl="Armed Bear Common Lisp" ;;
  *) AT_FAIL_IF([:]) ;;
esac

## Prepare an input file.
echo some random text >stdin

## Prepare the reference stdout and stderr.
cat >stdout.ref <<EOF
Hello from $impl ($lisp)!
from stdin: "some random text"
package \`COMMON-LISP-USER' ok
program name = "./test-script"
arguments = ("--eval" "nonsense" "--" "more" "args" "here")
EOF
cat >stderr.ref <<EOF
to stderr
EOF

AT_CHECK([echo "lisp=$lisp opt=$opt"; env | grep RUNLISP | sort],, [stdout])
AT_CHECK([./test-script --eval nonsense -- more args here <stdin],,
	 [stdout], [stderr])
AT_CHECK([diff -u stdout.ref stdout])
AT_CHECK([diff -u stderr.ref stderr])
AT_CLEANUP])

###--------------------------------------------------------------------------
### Check error handling.

FOREACH([LISP_SYSTEMS],
[AT_SETUP([$1 errors])
AT_KEYWORDS([script error $1])
PREPARE_LISP_TEST([$1])

## A simple script which signals an error without catching it.
cat >test <<EOF
@%:@! RUNLISP_PATH -L$lisp
(error "just kill me now")
EOF
chmod +x test

## As long as it exits with a nonzero status, I'm happy.  Some Lisps
## desperately want to drop the user into an interactive debugger, which is
## possibly useful for a developer, but an end user is now faced with a
## confusing internal error message /and/ a confusing prompt which won't go
## away.  The output may still be confusing and (certainly in CCL's case)
## voluminous, but that's not significantly worse than Tcl or Java.
./test >out >err; rc=$?
AT_FAIL_IF([test $rc = 0])

AT_CLEANUP])

###--------------------------------------------------------------------------
### Check eval mode.

### Eval mode is implemented centrally through a script, so we don't need to
### test it separately for each Lisp implementation.

AT_SETUP([eval mode])
AT_KEYWORDS([eval common])
SETUP_RUNLISP_ENV

## A very basic smoke test.
AT_CHECK([RUNLISP_PATH -e '(format t "Just another Lisp hacker!~%")'],,
[Just another Lisp hacker!
])

## The `:runlisp-script' keyword should /not/ be in `*features*'.
traceon
AT_CHECK([RUNLISP_PATH -d '(find :runlisp-script *features*)'],, [NIL
])

## Check a mixture of all the kinds of evaluation.  We'll need a stunt script
## to make this work.  Also check that the individual forms are read and
## evaluated one at a time, so that each one can affect the way the reader
## interprets the next.
cat >script.lisp <<EOF
@%:@! just want to check that Lisp doesn't choke on a shebang line here
(format t "And we're running the script...~%~
	   Command-line arguments: ~:S~%~
	   Symbols in package \`~A': ~:S~%"
	uiop:*command-line-arguments*
	(package-name *package*)
	(sort (loop :for @%:@2=@%:@:s :being
		      :the :present-symbols :of *package*
		    :collect @%:@2@%:@)
	      @%:@'string<))
EOF
AT_CHECK([RUNLISP_PATH \
	    -e '(defpackage @%:@:runlisp-test (:export @%:@:foo @%:@:bar))
		(defvar runlisp-test:foo 1)
		(defvar runlisp-test:bar "stoat!")' \
	    -d runlisp-test:foo \
	    -d runlisp-test:bar \
	    -p runlisp-test:bar \
	    -e '(incf runlisp-test:foo)' \
	    -l script.lisp \
	    -d runlisp-test:foo \
	    -- -e one two three],,
[1
"stoat!"
stoat!
And we're running the script...
Command-line arguments: ("-e" "one" "two" "three")
Symbols in package `COMMON-LISP-USER': ()
2
])

AT_CLEANUP

###--------------------------------------------------------------------------
### Check Lisp system selection and preference work.

AT_SETUP([preferences])
AT_KEYWORDS([prefs common])
SETUP_RUNLISP_ENV

## Before we can make this happen, we need to decide on three Lisp systems,
## two of which actually work, and one other.  These are ordered by startup
## speed.
unset lisp0 lisp1 badlisp; win=nil
set -- cmucl sbcl ccl clisp ecl abcl
while :; do
  case $@%:@ in 0) break ;; esac
  lisp=$1; shift
  if RUNLISP_PATH -L$lisp -enil 2>/dev/null; then good=t; else good=nil; fi
  case ${lisp0+t},${badlisp+t},$good in
    ,*,t) lisp0=$lisp ;;
    t,*,t) lisp1=$lisp win=t; break ;;
    *,,nil) badlisp=$lisp ;;
  esac
done
AT_CHECK([case $win in nil) exit 77 ;; esac])
case ${badlisp+t} in t) ;; *) badlisp=$1 ;; esac
BADLISP=$(echo $badlisp | tr a-z A-Z)
eval $BADLISP=/notexist/definitely-wrong
export $BADLISP
echo Primary Lisp = $lisp0
echo Secondary Lisp = $lisp1
echo Bad Lisp = $badlisp

## Check that our selection worked.
AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp0 -d 'WHICH_LISP'],, ["$lisp0"NL])
AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp1 -d 'WHICH_LISP'],, ["$lisp1"NL])
AT_CHECK([RUNLISP_PATH -L$badlisp -d 'WHICH_LISP'], [127],,
	 [runlisp: no acceptable Lisp systems found[]NL])

## Unset all of the user preference mechanisms.
here=$(pwd)
mkdir HOME config
HOME=$here/HOME XDG_CONFIG_HOME=$here/config; export HOME XDG_CONFIG_HOME

## We generally take the first one listed that exists.
AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp0,$lisp1 -d 'WHICH_LISP'],, ["$lisp0"NL])
AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp1,$lisp0 -d 'WHICH_LISP'],, ["$lisp1"NL])
AT_CHECK_UNQUOTED([RUNLISP_PATH -L$badlisp,$lisp0,$lisp1 -d 'WHICH_LISP'],,
		  ["$lisp0"NL])

## Check parsing of embedded options.
for i in 0 1; do
  j=$(( 1 - $i )); eval lisp=\$lisp$i olisp=\$lisp$j
  cat >script$i <<EOF
@%:@! RUNLISP_PATH
;;; -z @RUNLISP: -L$lisp -*- -z -*- -L$olisp -- -z
(prin1 WHICH_LISP) (terpri)
EOF
  chmod +x script$i
  AT_CHECK_UNQUOTED([./script$i],, ["$lisp"NL])
done

## Preferences will override the order of acceptable implementations.
AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp,$lisp0 ./script0],, ["$lisp0"NL])
AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp,$lisp0 ./script1],, ["$lisp0"NL])

## But doesn't affect the preference order of unmentioned Lisps.
AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp ./script0],, ["$lisp0"NL])
AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp ./script1],, ["$lisp1"NL])

## Test configuration files and interactions with the environment.
for conf in HOME/.runlisp.conf config/runlisp.conf; do
  for i in 0 1; do
    j=$(( 1 - $i )); eval lisp=\$lisp$i olisp=\$lisp$j
    cat >$conf <<EOF
;;; -*-conf-*-
prefer = $lisp
EOF

    ## Basic check.
    AT_CHECK_UNQUOTED([./script0],, ["$lisp"NL])
    AT_CHECK_UNQUOTED([./script1],, ["$lisp"NL])

    ## Environment variable overrides.
    AT_CHECK_UNQUOTED([RUNLISP_PREFER=$olisp ./script0],, ["$olisp"NL])
    AT_CHECK_UNQUOTED([RUNLISP_PREFER=$olisp ./script1],, ["$olisp"NL])

  done
  rm -f $conf
done

AT_CLEANUP

###--------------------------------------------------------------------------
### Implementation-specific tests.

AT_SETUP([specific sbcl])
AT_KEYWORDS([specific sbcl])
PREPARE_LISP_TEST([sbcl])

AT_CHECK([RUNLISP_PATH -e"(require 'sb-bsd-sockets)"])

AT_CLEANUP

###----- That's all, folks --------------------------------------------------