X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=blobdiff_plain;f=tests%2Fautotest;h=525d1fdedc6de6feb2f1941fc4eb9d952b11bbb7;hp=b3118d32047bc413eba482da362444a6bafa2a0f;hb=44cd7013424bdd3811550a47aeff9d01a2a9ce8e;hpb=352a6b4904774e3368a4ed1dbccc28787d942bc5 diff --git a/tests/autotest b/tests/autotest index b3118d3..525d1fd 100755 --- a/tests/autotest +++ b/tests/autotest @@ -1,33 +1,62 @@ #!/usr/bin/expect -f +# This is part of CGI::Auth::Flexible, a perl CGI authentication module. +# +# Copyright 2012,2013,2015 Ian Jackson. +# Copyright 2012,2013,2015 Citrix. +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version, with the "CAF Login Exception" +# as published by Ian Jackson (version 1, or at your option any +# later version) as an Additional Permission. +# +# This program 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 Affero General Public License for more details. + set testfile [lindex $argv 0] -set tt tests/tmp +switch -glob -- $testfile { + tests/*.at { + regsub {^tests/} $testfile {} id + regsub {\.at$} $id {} id + set tt "tests/tmp/$id" + } + * { + set id "\[[info pid]\]" + set tt tests/tmp/[info pid] + } +} exec rm -rf $tt -exec mkdir $tt +file mkdir tests/tmp $tt set pwd [pwd] set env(HOME) $tt set env(CAFTEST_CAF) $pwd +set env(CAFTEST_TMP) $pwd/$tt set env(TERM) vt100 set env(CAFTEST_NOSRCDUMP) 1 +set env(LC_ALL) en_GB.utf-8 log_user 0 log_file -a $tt/expect.log proc timeout-abort {} { + global id send_log "\r\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" - error "aborting due to timeout" + error "$id: aborting due to timeout" } -set timeout 5 - -expect_after timeout timeout-abort +set timeout 10 proc elog {args} { + global id set m "[list expect [lindex $args end]]" - puts stderr $m + puts stderr "$id: $m" # send_log "\n$m\n" eval expect $args } @@ -47,6 +76,8 @@ proc dospawn {} { spawn -nottycopy \ w3m -config /dev/null -o cgi_bin=$pwd/tests file:///cgi-bin/wrap/Tsuffix + expect_after timeout timeout-abort + epage {You need to log in} } @@ -69,4 +100,4 @@ proc loginas {user {password sesame} {wanttxt ACCESSGRANTED}} { source $testfile -puts ok +puts "$id: ok"