X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=tests%2Fautotest;h=5dc5ad70409a1a49abf8d89da78363fcf66d5c7c;hb=413be458170c3e3e0eaf15d7e0d525228bf9651c;hp=43f4080ceae9ac5672da4f0992595289e02c1f4c;hpb=4848e0d386cf626b2179aeda2582a53cb07b9e50;p=cgi-auth-flexible.git diff --git a/tests/autotest b/tests/autotest index 43f4080..5dc5ad7 100755 --- a/tests/autotest +++ b/tests/autotest @@ -1,33 +1,61 @@ #!/usr/bin/expect -f -set tt tests/tmp +# 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] + +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 -spawn -nottycopy \ -w3m -config /dev/null -o cgi_bin=$pwd/tests file:///cgi-bin/wrap/Tsuffix - proc timeout-abort {} { 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 } @@ -41,7 +69,16 @@ proc epage {str} { etxt $str } -epage {You need to log in} +proc dospawn {} { + global pwd spawn_id + + 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} +} proc fillformfield {value} { send "\t\r$value\r" @@ -53,16 +90,13 @@ proc submitform-expect {wanttxt} { epage $wanttxt } -fillformfield alice -fillformfield bogus -send "\t" -submitform-expect "wrong password" - -fillformfield alice -fillformfield sesame -send "\t" -submitform-expect "ACCESSGRANTED" +proc loginas {user {password sesame} {wanttxt ACCESSGRANTED}} { + fillformfield $user + fillformfield $password + send "\t" + submitform-expect $wanttxt +} -etxt {path = '/Tsuffix'} +source $testfile -puts ok +puts "$id: ok"