testsuite/runtest.libs/libs.exp

   1 # Copyright (C) 1997-2016, 2018, 2019 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software: you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 load_lib libsup.exp
  19
  20 proc process_test { test } {
  21     global EXPECT
  22
  23     verbose "Running $test ..." 0
  24     set text "\[- A-Za-z0-9\,\.\;\"\_\:\'\`\(\)\!\#\=\+\/\?\&\*]*"
  25
  26     set timeout 150
  27
  28     if [file exists $test] {
  29         verbose "Processing test $test" 2
  30
  31         exp_send "interp create test_case\n"
  32         expect "interp create test_case*test_case*expect*>"
  33         exp_send {test_case eval {foreach { n v }} \
  34                       [list [array get default_vars]] {{ set $n $v }}}
  35         exp_send "\n"
  36         expect "expect*>"
  37         exp_send "test_case eval source $test"
  38         # wait for command to echo...
  39         expect "test_case eval source $test"
  40         exp_send "\n"
  41         expect "\n"
  42         expect {
  43             "no such file or directory" {
  44                 perror "$test wouldn't run" 0
  45             }
  46             -re {^[\r\n]+} { exp_continue }
  47             -re "^\[^\r\n\]*NOTSUPPORTED: $text\[\r\n\]*" {
  48                 unsupported "[lrange $expect_out(0,string) 1 end]"
  49                 exp_continue
  50             }
  51             -re "^\[^\r\n\]*NOTTESTED: $text\[\r\n\]*" {
  52                 untested "[lrange $expect_out(0,string) 1 end]"
  53                 exp_continue
  54             }
  55             -re "^\[^\r\n\]*PASSED: $text\[\r\n\]*" {
  56                 pass "[lrange $expect_out(0,string) 1 end]"
  57                 exp_continue
  58             }
  59             -re "^\[^\r\n\]*FAILED: $text\[\r\n\]*" {
  60                 fail "[lrange $expect_out(0,string) 1 end]"
  61                 exp_continue
  62             }
  63             -re "^\[^\r\n\]*WARNED: $text\[\r\n\]*" {
  64                 verbose $expect_out(0,string) 2
  65                 exp_continue
  66             }
  67             -re "^\[^\r\n\]*ERRORED: $text\[\r\n\]*" {
  68                 verbose $expect_out(0,string) 2
  69                 exp_continue
  70             }
  71             -re "^END \[^.\]+\\.test\[\r\n\]*" {
  72                 # done
  73             }
  74             -re "^\[^\r\n\]+\[\r\n\]+" {
  75                 exp_continue
  76             }
  77             -re {^expect[[:digit:]]+\.[[:digit:]]+>} {
  78                 perror "$test did not complete" 0
  79             }
  80             timeout {
  81                 perror "$test timed out" 0
  82                 exp_continue
  83             }
  84             eof {
  85                 perror "Expect process exited early" 0
  86             }
  87         }
  88         exp_send "interp delete test_case"
  89         # wait for command to echo...
  90         expect "interp delete test_case"
  91         exp_send "\n"
  92         expect "expect*>"
  93     } else {
  94         perror "$test doesn't exist" 0
  95     }
  96 }
  97
  98 start_expect
  99 foreach i [lsort -dictionary [glob [testsuite file -source -test *.test]]] {
 100     if { [runtest_file_p $runtests $i] } { process_test $i }
 101 }
 102 stop_expect