#!/bin/sh #| -*- scheme -*- exec racket "$0" "$@" |# #lang at-exp racket/base (require racket/list racket/file racket/match racket/system) (define (err fmt . args) (raise-user-error (format "Error: ~a" (apply format fmt args)))) (define testdir "/tmp/racket-installer-test") (define installer (match (current-command-line-arguments) [(vector installer) installer] [(vector _ ...) (err "usage: test-installer ")])) (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' signaled 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) ;; plain interaction, identifiable prompts, safe-for-play home (void (putenv "TERM" "dumb") (putenv "PS1" "sh> ") (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 ... '...) (define not-recommended (let ([s (string-append "*** This is a nightly build: such a unix-style distribution" " is *not*\n" "*** recommended because it cannot be used to install multiple" " versions.\n")]) (format "(?:~a)?" (regexp-quote s)))) @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 @; utilities sh> @i{LS() { ls --width=72 -mF "$@"@""@";" }} @; 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. @r{@not-recommended}@; 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} racket@|N|/ sh> @i{LS 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 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, plt-games, @; plt-help, plt-r5rs, plt-r6rs, plt-web-server, racket, raco, scribble, @; setup-plt, slatex, slideshow, swindle done. "@|testdir|/share/man/man1" does not exist, skipping. @|| Installation complete. sh> @i{LS .} R/, bin/, racket@|N|/ sh> @i{LS R} README, bin/, collects/, doc/, include/, lib/, man/ sh> @i{LS bin} @s|{drracket@, gracket, gracket-text@, mred@, mred-text@, mzc@, mzpp@, mzscheme@, mztext@, pdf-slatex@, plt-games@, plt-help@, plt-r5rs@, plt-r6rs@, plt-web-server@, racket@, raco@, scribble@, setup-plt@, slatex@, slideshow@, swindle@}| 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} 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} R/, bin/, mmm/, racket@|N|/ 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} sh> @i{cd /} sh> @i{cd @testdir} sh> @i{LS} README, bin/, collects/, doc/, include/, lib/, man/ sh> @i{rm -rf [a-zR]*} sh> @i{LS} 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} bin/, include/, lib/, share/ sh> @i{LS bin} drracket*, gracket*, gracket-text*, mred*, mred-text*, mzc*, mzpp*, mzscheme*, mztext*, pdf-slatex*, plt-games*, plt-help*, plt-r5rs*, plt-r6rs*, plt-web-server*, racket*, racket-uninstall*, raco*, scribble*, setup-plt*, slatex*, slideshow*, swindle* sh> @i{LS include && LS lib && LS share} racket@|N|/ racket@|N|/ man/, racket@|N|/ sh> @i{LS 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 lib/r*} buildinfo, collects/, mzdyn3m.o, starter* sh> @i{LS share/r* && LS share/r*/doc} doc/ README, @|...|xrepl/ sh> @i{LS share/man && LS share/man/man1} man1/ drracket.1, gracket.1, mred.1, mzc.1, mzscheme.1, plt-help.1, racket.1, raco.1, setup-plt.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} 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} 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")