From 06bc3bd4706606fbe079c39cb869e9422cef8fe9 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 16 Oct 2011 18:53:13 -0400 Subject: [PATCH] Lots of little changes and fixes, and an extensive testing script. (cherry picked from commit 08b2d7b595780e6e95a851b54611fcd643247d62) --- .../build/unix-installer/installer-header | 107 +++-- .../meta/build/unix-installer/test-installer | 447 ++++++++++++++++++ 2 files changed, 510 insertions(+), 44 deletions(-) create mode 100755 collects/meta/build/unix-installer/test-installer diff --git a/collects/meta/build/unix-installer/installer-header b/collects/meta/build/unix-installer/installer-header index 205835dd51..3edd4f7c4d 100644 --- a/collects/meta/build/unix-installer/installer-header +++ b/collects/meta/build/unix-installer/installer-header @@ -12,7 +12,9 @@ fi rm_on_abort="" failwith() { - echo "Error: $*" 1>&2 + err="Error: " + if test "x$1" = "x-noerror"; then err=""; shift; fi + echo "$err$*" 1>&2 if test ! "x$rm_on_abort" = "x" && test -e "$rm_on_abort"; then echon " (Removing installation files in $rm_on_abort)" "$rm" -rf "$rm_on_abort" @@ -21,9 +23,9 @@ failwith() { exit 1 } # intentional aborts -abort() { failwith "abort."; } +abort() { failwith -noerror "Aborting installation."; } # unexpected exits -exithandler() { failwith "Aborting..."; } +exithandler() { echo ""; failwith "Aborting..."; } trap exithandler 2 3 9 15 @@ -68,11 +70,11 @@ cat_installer() { echo "This program will extract and install $DISTNAME." echo "" echo "Note: the required diskspace for this installation is $ORIGSIZE." +echo "" ############################################################################### ## What kind of installation? -echo "" echo "Do you want a Unix-style distribution?" echo " In this distribution mode files go into different directories according" echo " to Unix conventions. A \"racket-uninstall\" script will be generated" @@ -96,12 +98,12 @@ while test "$unixstyle" = "x"; do * ) unixstyle="x" ;; esac done +echo "" ############################################################################### ## Where do you want it? ## sets $where to the location: target path for wholedir, prefix for unixstyle -echo "" if test "$unixstyle" = "Y"; then echo "Where do you want to base your installation of $DISTNAME?" echo " (If you've done such an installation in the past, either" @@ -176,12 +178,15 @@ unpack_installation() { test "$BINSUM" = "$SUM" || failwith "bad CRC checksum." echo "ok." # test that the target does not exists + here="N" if test -d "$T" || test -f "$T"; then - if test -d "$T"; then + if test -d "$T" && test -x "$T"; then # use the real name, so "/foo/.." shows as an explicit "/" - oldwd="`pwd`"; cd "$T"; T="`pwd`"; cd "$oldwd"; echon "\"$T\" exists" - else - echon "\"$T\" exists (as a file)" + oldwd="`pwd`"; cd "$T"; T="`pwd`"; cd "$oldwd" + fi + if test -f "$T"; then echon "\"$T\" exists (as a file)" + elif test ! "`pwd`" = "$T"; then echon "\"$T\" exists" + else here="Y"; echon "\"$T\" is where you ran the installer from" fi echon ", delete? " read R @@ -197,15 +202,23 @@ unpack_installation() { # unpack rm_on_abort="$T" "$mkdir" -p "$T" || failwith "could not create directory: $T" - oldwd="`pwd`"; cd "$T"; INSTDIR="`pwd`"; cd "$oldwd" - echon "Unpacking into \"$INSTDIR\" (Ctrl+C to abort)... " + if test "$here" = "Y"; then + cd "$T"; INSTDIR="$T" + echo "*** Note: your original directory was deleted, so you will need" + echo "*** to 'cd' back into it when the installer is done, otherwise" + echo "*** it will look like you have an empty directory." + sleep 1 + else oldwd="`pwd`"; cd "$T"; INSTDIR="`pwd`"; cd "$oldwd" + fi + rm_on_abort="$INSTDIR" + echo "Unpacking into \"$INSTDIR\" (Ctrl+C to abort)..." cat_installer | "$gunzip" -c \ | { cd "$INSTDIR" "$tar" xf - || failwith "problems during unpacking of binary archive." } test -d "$INSTDIR/collects" \ || failwith "unpack failed (could not find \"$T/collects\")." - echo "done." + echo "Done." } ############################################################################### @@ -227,7 +240,7 @@ wholedir_install() { if test "x$SYSDIR" = "x"; then : elif test ! -d "$SYSDIR"; then echo "\"$SYSDIR\" does not exist, skipping links." - elif test ! -w "$SYSDIR"; then + elif test ! -x "$SYSDIR" || test ! -w "$SYSDIR"; then echo "\"$SYSDIR\" is not writable, skipping links." else oldwd="`pwd`"; cd "$SYSDIR"; SYSDIR="`pwd`"; cd "$oldwd" @@ -235,7 +248,7 @@ wholedir_install() { install_links() { # tgtdir(absolute) srcdir(relative to INSTDIR) if ! test -d "$1"; then echo "\"$1\" does not exist, skipping." - elif ! test -w "$1"; then + elif ! test -x "$1" || ! test -w "$1"; then echo "\"$1\" is not writable, skipping" else echo "Installing links in \"$1\"..." @@ -263,10 +276,10 @@ wholedir_install() { ## Unix-style installations dir_createable() { - test_dir="`\"$dirname\" \"$1\"`" - if test -d "$test_dir" && test -w "$test_dir"; then return 0 - elif test "$test_dir" = "/"; then return 1 - else dir_createable "$test_dir"; fi + tdir="`\"$dirname\" \"$1\"`" + if test -d "$tdir" && test -x "$tdir" && test -w "$tdir"; then return 0 + elif test "$tdir" = "/"; then return 1 + else dir_createable "$tdir"; fi } show_dir_var() { if test -f "$2"; then status="error: not a directory!"; err="Y" @@ -288,54 +301,60 @@ unixstyle_install() { echon " should I create it? (default: yes) " read R; case "$R" in [nN]* ) abort ;; esac "$mkdir" -p "$where" || failwith "could not create directory: $where" + elif test ! -w "$where"; then + failwith "The entered base directory is not writable: $where" fi cd "$where" || failwith "Base directory does not exist: $where" where="`pwd`"; cd "$origwd" set_dirs "$where" # loop for possible changes - done="N" + done="N"; retry="N" while test ! "$done" = "Y" || test "x$err" = "xY" ; do - echo "" - echo "Target Directories:" err="N" - show_dir_var "[e] Executables " "$bindir" - show_dir_var "[r] Racket Code " "$collectsdir" - show_dir_var "[d] Core Docs " "$docdir" - show_dir_var "[l] C Libraries " "$libdir" - show_dir_var "[h] C headers " "$incrktdir" - show_dir_var "[o] Extra C Objs " "$librktdir" - show_dir_var "[m] Man Pages " "$mandir" - if test "$PNAME" = "full"; then - echo " (C sources are not kept)" - # show_dir_var "[s] Source Tree " "$srcdir" + if test "$retry" = "N"; then + echo "" + echo "Target Directories:" + show_dir_var "[e] Executables " "$bindir" + show_dir_var "[r] Racket Code " "$collectsdir" + show_dir_var "[d] Core Docs " "$docdir" + show_dir_var "[l] C Libraries " "$libdir" + show_dir_var "[h] C headers " "$incrktdir" + show_dir_var "[o] Extra C Objs " "$librktdir" + show_dir_var "[m] Man Pages " "$mandir" + if test "$PNAME" = "full"; then + echo " (C sources are not kept)" + # show_dir_var "[s] Source Tree " "$srcdir" + fi + echo "Enter a letter to change an entry, or enter to continue." fi - echo "Enter a letter to change an entry, or enter to continue" + retry="N" echon "> "; read change_what read_dir() { echon "New directory (absolute or relative to $where): "; read new_dir case "$new_dir" in - "/"* ) echo "$new_dir" ;; - * ) echo "$where/$new_dir" ;; + "/"* ) eval "$1=\"$new_dir\"" ;; + * ) eval "$1=\"$where/$new_dir\"" ;; esac } case "$change_what" in - [eE]* ) bindir="`read_dir`" ;; - [rR]* ) collectsdir="`read_dir`" ;; - [dD]* ) docdir="`read_dir`" ;; - [lL]* ) libdir="`read_dir`" ;; - [hH]* ) incrktdir="`read_dir`" ;; - [oO]* ) librktdir="`read_dir`" ;; - [mM]* ) mandir="`read_dir`" ;; - # [sS]* ) if test "$PNAME" = "full"; then srcdir="`read_dir`" + [eE]* ) read_dir bindir ;; + [rR]* ) read_dir collectsdir ;; + [dD]* ) read_dir docdir ;; + [lL]* ) read_dir libdir ;; + [hH]* ) read_dir incrktdir ;; + [oO]* ) read_dir librktdir ;; + [mM]* ) read_dir mandir ;; + # [sS]* ) if test "$PNAME" = "full"; then read_dir srcdir # else echo "Invalid response"; fi ;; "" ) if test "$err" = "N"; then done="Y" else echo "*** Please fix erroneous paths to proceed"; fi ;; - * ) echo "Invalid response" ;; + * ) retry="Y" ;; esac done if test -x "$bindir/racket-uninstall"; then + echo "" echo "A previous Racket uninstaller is found at" echo " \"$bindir/racket-uninstall\"," echon " should I run it? (default: yes) " @@ -370,7 +389,7 @@ unixstyle_install() { if test "$unixstyle" = "Y"; then unixstyle_install; else wholedir_install; fi echo "" -echo "All done." +echo "Installation complete." exit diff --git a/collects/meta/build/unix-installer/test-installer b/collects/meta/build/unix-installer/test-installer new file mode 100755 index 0000000000..55ed825f61 --- /dev/null +++ b/collects/meta/build/unix-installer/test-installer @@ -0,0 +1,447 @@ +#!/bin/sh +#| -*- scheme -*- +exec racket "$0" "$@" +|# + +#lang at-exp racket/base + +(require racket/list racket/file racket/match racket/system) + +(define testdir "/tmp/racket-installer-test") +(define installer "/tmp/r.sh") + +(define (err fmt . args) + (raise-user-error (format "Error: ~a" (apply format fmt args)))) + +(define (exe name [just-path? #f]) + (define path (or (find-executable-path name) + (err "no `~a' executable found" name))) + (λ args (unless (apply system* path args) + (err "`~a' signalled an error" name)))) + +(define expect-exe (exe "expect")) +(define sync-exe (exe "sync")) + +(unless (file-exists? installer) (err "missing installer at: ~a" installer)) +(when (directory-exists? testdir) (err "test directory exists: ~a" testdir)) +(make-directory testdir) +(current-directory testdir) +;; make identifiable prompts, predictable ls output, safe-for-play home +(void (putenv "PS1" "sh> ") (putenv "COLUMNS" "72") (putenv "HOME" testdir)) + +(define (transcript) + ;; the test transcript text: + ;; - text is matched against the process output (anchored) + ;; - `i' is for user input to send + ;; - `r' is for a regexp + ;; - `s' is a nested list to be spliced in + ;; - `N' is short for @r{[0-9.]+} + ;; - `...' makes the next match unanchored (so it's similar to a non-greedy + ;; ".*" regexp) + (define (i . xs) `(i . ,xs)) + (define (r . xs) `(r . ,xs)) + (define (s . xs) `(s . ,xs)) + (define break 'break) + (define N @r{[0-9.]+}) + (define ... '...) + @list{ + @; the first few puzzling interactions are testing that we generate the + @; right expect code -- which requires regexp and $-quoting. + sh> @i{echo "blah"} + blah + sh> @i{echo 'blah'} + blah + sh> @i{x=123} + sh> @i{echo "][@"}{"blah*$x*"} + ][@"}{"blah*123* + sh> @i{echo '[]{}blah*$x*'} + []{}blah*$x* + sh> @i{pwd} + @testdir + @; proper testing begins here + sh> @i{sh @installer} + This program will extract and install Racket v@|N|. + @|| + Note: the required diskspace for this installation is @|N|M. + @|| + Do you want a Unix-style distribution? + In this distribution mode files go into different directories according + to Unix conventions. A "racket-uninstall" script will be generated + to be used when you want to remove the installation. If you say 'no', + the whole Racket directory is kept in a single installation directory + (movable and erasable), possibly with external links into it -- this is + often more convenient, especially if you want to install multiple + versions or keep it in your home directory. + *** This is a nightly build: such a unix-style distribution is *not* + *** recommended because it cannot be used to install multiple versions. + Enter yes/no (default: no) > @i{bleh} + Enter yes/no (default: no) > @i{foo} + Enter yes/no (default: no) > @i{} + @|| + Where do you want to install the "racket-@N" directory tree? + 1 - /usr/racket-@N [default] + 2 - /usr/local/racket-@N + 3 - ~/racket-@N (@|testdir|/racket-@N) + 4 - ./racket-@N (here) + Or enter a different "racket" directory to install in. + > @i{4} + @|| + Checking the integrity of the binary archive... ok. + Unpacking into "@|testdir|/racket-@N" (Ctrl+C to abort)... + Done. + @|| + If you want to install new system links within the "bin" and + "man" subdirectories of a common directory prefix (for example, + "/usr/local") then enter the prefix of an existing directory + that you want to use. This might overwrite existing symlinks, + but not files. + (default: skip links) > @i{} + @|| + Installation complete. + sh> @i{ls -mF} + racket-@|N|/ + sh> @i{ls -mF racket-*} + README, bin/, collects/, doc/, include/, lib/, man/ + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{No} + @... + > @i{.} + @|| + Checking the integrity of the binary archive... ok. + "@|testdir|/racket-@N" exists, delete? @i{n} + Aborting installation. + sh> @i{ls -mF racket-*} + README, bin/, collects/, doc/, include/, lib/, man/ + sh> @i{chmod 000 racket*} + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{No} + @... + > @i{./} + @|| + Checking the integrity of the binary archive... ok. + "@|testdir|/racket-@N" exists, delete? @i{y} + Deleting old "@|testdir|/racket-@N"... @; + /bin/rm: cannot remove `@|testdir|/racket-@N': @; + Permission denied + Error: could not delete "@|testdir|/racket-@N". + sh> @i{chmod 755 racket*} + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{No} + @... + > @i{.} + @|| + Checking the integrity of the binary archive... ok. + "@|testdir|/racket-@N" exists, delete? @i{y} + Deleting old "@|testdir|/racket-@N"... done. + @... + (default: skip links) > @i{.} + "@|testdir|/bin" does not exist, skipping. + "@|testdir|/share/man/man1" does not exist, skipping. + @|| + Installation complete. + sh> @i{mkdir bin} + sh> @i{touch R bin/gracket} + sh> @i{export TGT=R} + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{} + @... + > @i{$TGT} + @|| + Checking the integrity of the binary archive... ok. + "R" exists (as a file), delete? @i{y} + Deleting old "R"... done. + Unpacking into "@|testdir|/R" (Ctrl+C to abort)... + Done. + @... + (default: skip links) > @i{.} + Installing links in "@|testdir|/bin"... + drracket, gracket skipped (non-link exists), gracket-text, mred, @; + mred-text, mzc, mzpp, mzscheme, mztext, pdf-slatex, planet, plt-games, @; + plt-help, plt-r5rs, plt-r6rs, plt-web-server, racket, raco, scribble, @; + setup-plt, slatex, slideshow, swindle, tex2page + done. + "@|testdir|/share/man/man1" does not exist, skipping. + @|| + Installation complete. + sh> @i{ls -mF .} + R/, bin/, racket-@|N|/ + sh> @i{ls -mF R} + README, bin/, collects/, doc/, include/, lib/, man/ + sh> @i{ls -mF bin} + @s|{drracket@, gracket, gracket-text@, mred@, mred-text@, mzc@, mzpp@, + mzscheme@, mztext@, pdf-slatex@, planet@, plt-games@, plt-help@, + plt-r5rs@, plt-r6rs@, plt-web-server@, racket@, raco@, scribble@, + setup-plt@, slatex@, slideshow@, swindle@, tex2page@}| + sh> @i{ls -l bin/ra*} + lrwxrwxrwx. @... bin/racket -> @|testdir|/R/bin/racket + lrwxrwxrwx. @... bin/raco -> @|testdir|/R/bin/raco + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{} + @... + > @i{$TGT`echo 1`} + @|| + Checking the integrity of the binary archive... ok. + Unpacking into "@|testdir|/R1" (Ctrl+C to abort)... + @break + Error: Aborting... + (Removing installation files in @|testdir|/R1) + sh> @i{ls -mF} + R/, bin/, racket-@|N|/ + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{} + @... + > @i{mmm} + @... + Unpacking into "@|testdir|/mmm" (Ctrl+C to abort)... + Done. + @... + (default: skip links) > @break + Error: Aborting... + sh> @i{ls -mF} + R/, bin/, mmm/, racket-5.2.0.1/ + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{} + @... + > @i{`pwd`} + @... + "@testdir" is where you ran the installer from, delete? @i{y} + Deleting old "@testdir"... done. + *** Note: your original directory was deleted, so you will need + *** to 'cd' back into it when the installer is done, otherwise + *** it will look like you have an empty directory. + Unpacking into "@testdir" (Ctrl+C to abort)... + Done. + @... + (default: skip links) > @i{/usr/local} + "/usr/local" is not writable, skipping links. + @|| + Installation complete. + sh> @i{ls -mF} + sh> @i{cd /} + sh> @i{cd @testdir} + sh> @i{ls -mF} + README, bin/, collects/, doc/, include/, lib/, man/ + sh> @i{rm -rf [a-zR]*} + sh> @i{ls -mF} + sh> @i{sh @installer} + @... + Do you want a Unix-style distribution? + @... + Enter yes/no (default: no) > @i{bleh} + Enter yes/no (default: no) > @i{yes} + @|| + Where do you want to base your installation of Racket v@|N|? + (If you've done such an installation in the past, either + enter the same directory, or run 'racket-uninstall' manually.) + 1 - /usr/... [default] + 2 - /usr/local/... + 3 - ~/... (@|testdir|/...) + 4 - ./... (here) + Or enter a different directory prefix to install in. + > @i{} + Error: The entered base directory is not writable: /usr + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{2} + Error: The entered base directory is not writable: /usr/local + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{3} + @|| + Target Directories: + [e] Executables @|testdir|/bin (will be created) + [r] Racket Code @|testdir|/lib/racket-@|N|/collects (will be created) + [d] Core Docs @|testdir|/share/racket-@|N|/doc (will be created) + [l] C Libraries @|testdir|/lib (will be created) + [h] C headers @|testdir|/include/racket-@|N| (will be created) + [o] Extra C Objs @|testdir|/lib/racket-@|N| (will be created) + [m] Man Pages @|testdir|/share/man (will be created) + Enter a letter to change an entry, or enter to continue. + > @i{z} + > @i{Q} + > @i{} + @|| + Checking the integrity of the binary archive... ok. + Unpacking into "@|testdir|/racket-@|N|-tmp-install" (Ctrl+C to abort)... + Done. + Moving bin -> @|testdir|/bin + Moving collects -> @|testdir|/lib/racket-@|N|/collects + Moving doc -> @|testdir|/share/racket-@|N|/doc + Moving include -> @|testdir|/include/racket-@|N| + Moving lib -> @|testdir|/lib/racket-@|N| + Moving man -> @|testdir|/share/man + Moving README -> @|testdir|/share/racket-@|N|/doc/README + Writing uninstaller at: @|testdir|/bin/racket-uninstall... + Rewriting configuration file at: @|testdir|/lib/racket-@|N|/@; + collects/config/config.rkt... + Recompiling to @|testdir|/lib/racket-@|N|/@; + collects/config/compiled/config_rkt.zo... + @|| + Installation complete. + sh> @i{ls -mF} + bin/, include/, lib/, share/ + sh> @i{ls -mF bin} + drracket*, gracket*, gracket-text*, mred*, mred-text*, mzc*, mzpp*, + mzscheme*, mztext*, pdf-slatex*, planet*, plt-games*, plt-help*, + plt-r5rs*, plt-r6rs*, plt-web-server*, racket*, racket-uninstall*, + raco*, scribble*, setup-plt*, slatex*, slideshow*, swindle*, tex2page* + sh> @i{ls -mF include && ls -mF lib && ls -mF share} + racket-@|N|/ + racket-@|N|/ + man/, racket-@|N|/ + sh> @i{ls -mF include/r*} + escheme.h, ext.exp, mzconfig.h, mzscheme3m.exp, scheme.h, schemef.h, + schemegc2.h, schemex.h, schemexm.h, schexn.h, schgc2obj.h, schthread.h, + schvers.h, sconfig.h, stypes.h, uconfig.h + sh> @i{ls -mF lib/r*} + buildinfo, collects/, libfit.so*, mzdyn3m.o, starter* + sh> @i{ls -mF share/r* && ls -mF share/r*/doc} + doc/ + README, @... xrepl/ + sh> @i{ls -mF share/man && ls -mF share/man/man1} + man1/ + drracket.1, gracket.1, mred.1, mzc.1, mzscheme.1, plt-help.1, racket.1, + raco.1, setup-plt.1, tex2page.1 + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{meh} + Base directory does not exist: meh + should I create it? (default: yes) @i{n} + Aborting installation. + sh> @i{touch m} + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{4} + @|| + Target Directories: + [e] Executables @|testdir|/bin (exists) + [r] Racket Code @|testdir|/lib/racket-@|N|/collects (exists) + [d] Core Docs @|testdir|/share/racket-@|N|/doc (exists) + [l] C Libraries @|testdir|/lib (exists) + [h] C headers @|testdir|/include/racket-@|N| (exists) + [o] Extra C Objs @|testdir|/lib/racket-@|N| (exists) + [m] Man Pages @|testdir|/share/man (exists) + Enter a letter to change an entry, or enter to continue. + > @i{m} + New directory (absolute or relative to @testdir): @i{m} + @|| + Target Directories: + [e] Executables @|testdir|/bin (exists) + [r] Racket Code @|testdir|/lib/racket-@|N|/collects (exists) + [d] Core Docs @|testdir|/share/racket-@|N|/doc (exists) + [l] C Libraries @|testdir|/lib (exists) + [h] C headers @|testdir|/include/racket-@|N| (exists) + [o] Extra C Objs @|testdir|/lib/racket-@|N| (exists) + [m] Man Pages @|testdir|/m (error: not a directory!) + Enter a letter to change an entry, or enter to continue. + > @i{} + *** Please fix erroneous paths to proceed + @... + Enter a letter to change an entry, or enter to continue. + > @i{m} + New directory (absolute or relative to @testdir): @i{man} + @|| + Target Directories: + [e] Executables @|testdir|/bin (exists) + [r] Racket Code @|testdir|/lib/racket-@|N|/collects (exists) + [d] Core Docs @|testdir|/share/racket-@|N|/doc (exists) + [l] C Libraries @|testdir|/lib (exists) + [h] C headers @|testdir|/include/racket-@|N| (exists) + [o] Extra C Objs @|testdir|/lib/racket-@|N| (exists) + [m] Man Pages @|testdir|/man (will be created) + Enter a letter to change an entry, or enter to continue. + > @i{} + @|| + A previous Racket uninstaller is found at + "@|testdir|/bin/racket-uninstall", + should I run it? (default: yes) @i{} + running uninstaller... done. + @|| + Checking the integrity of the binary archive... ok. + @... + Installation complete. + sh> @i{ls -mF} + bin/, include/, lib/, m, man/, share/ + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{4} + @... + > @i{} + @|| + A previous Racket uninstaller is found at + "@|testdir|/bin/racket-uninstall", + should I run it? (default: yes) @i{n} + Aborting installation. + sh> @i{rm -rf share} + sh> @i{sh @installer} + @... + Enter yes/no (default: no) > @i{y} + @... + > @i{4} + @... + [m] Man Pages @|testdir|/man (exists) + Enter a letter to change an entry, or enter to continue. + > @break + Error: Aborting... + sh> @i{ls -mF} + bin/, include/, lib/, m, man/ + sh> @i{exit} + @||}) + +(define (make-expect-script) + (printf "spawn sh\nproc abort {} { puts \"timeout!\\n\"; exit 1 }\n") + (printf "set timeout 60\n") + (define (tclq str) + ;; tcl uses $ and [] for variable & function call interpolation, and "}{" + ;; can confuse it; quote all of these + (regexp-replace* "[][{}$]" (format "~s" str) "\\\\&")) + (define (expect strs anchored?) + (unless (null? strs) + (define str (if (string? strs) strs (apply string-append strs))) + (let ([str (regexp-replace* "\r?\n" str "\r\n")]) + (printf "expect {\n timeout abort\n -re ~a\n}\n" + (tclq (if anchored? (string-append "^" str) str)))))) + (define (send strs) + (define str (if (string? strs) strs (apply string-append strs))) + (printf "send -- ~a\n" (tclq (string-append str "\n")))) + (let loop ([strs '()] [xs (transcript)] [anchored? #t]) + (define (do-expect) (expect (reverse strs) anchored?)) + (if (null? xs) + (do-expect) + (match (car xs) + ['... (do-expect) (loop '() (cdr xs) #f)] + [(? string? x) (loop (cons (regexp-quote x) strs) (cdr xs) anchored?)] + [`(s . ,sxs) (loop strs (append sxs (cdr xs)) anchored?)] + [`(r . ,rxs) (loop (append (reverse rxs) strs) (cdr xs) anchored?)] + [`(i . ,inps) (do-expect) (send inps) + (loop (map regexp-quote (reverse inps)) (cdr xs) #t)] + ['break (do-expect) (printf "send \"\\03\"\n") + (loop '("\\^C") (cdr xs) #t)] + [x (err "bad item in transcript: ~s" (car xs))]))) + (printf "expect eof\n")) + +(with-output-to-file "/tmp/racket-installer-expect-script" make-expect-script) +(sync-exe) ; we'll shuffle a lot of bytes, be prepared +(expect-exe "/tmp/racket-installer-expect-script") + +(delete-directory/files testdir) +(delete-file "/tmp/racket-installer-expect-script") + +(printf "\n--> All tests passed.\n")