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, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 load_lib libsup.exp
  20
  21 proc process_test { test } {
  22     global EXPECT
  23
  24     verbose "Running $test ..." 0
  25     set text "\[- A-Za-z0-9\,\.\;\"\_\:\'\`\(\)\!\#\=\+\/\?\&\*]*"
  26
  27     set timeout 150
  28
  29     if [file exists $test] {
  30         verbose "Processing test $test" 2
  31
  32         exp_send "interp create test_case\n"
  33         expect "interp create test_case*test_case*expect*>"
  34         exp_send {test_case eval {foreach { n v }} \
  35                       [list [array get default_vars]] {{ set $n $v }}}
  36         exp_send "\n"
  37         expect "expect*>"
  38         exp_send "test_case eval source $test"
  39         # wait for command to echo...
  40         expect "test_case eval source $test"
  41         exp_send "\n"
  42         expect "\n"
  43         expect {
  44             "no such file or directory" {
  45                 perror "$test wouldn't run" 0
  46             }
  47             -re {^[\r\n]+} { exp_continue }
  48             -re "^\[^\r\n\]*NOTSUPPORTED: $text\[\r\n\]*" {
  49                 unsupported "[lrange $expect_out(0,string) 1 end]"
  50                 exp_continue
  51             }
  52             -re "^\[^\r\n\]*NOTTESTED: $text\[\r\n\]*" {
  53                 untested "[lrange $expect_out(0,string) 1 end]"
  54                 exp_continue
  55             }
  56             -re "^\[^\r\n\]*PASSED: $text\[\r\n\]*" {
  57                 pass "[lrange $expect_out(0,string) 1 end]"
  58                 exp_continue
  59             }
  60             -re "^\[^\r\n\]*FAILED: $text\[\r\n\]*" {
  61                 fail "[lrange $expect_out(0,string) 1 end]"
  62                 exp_continue
  63             }
  64             -re "^\[^\r\n\]*WARNED: $text\[\r\n\]*" {
  65                 verbose $expect_out(0,string) 2
  66                 exp_continue
  67             }
  68             -re "^\[^\r\n\]*ERRORED: $text\[\r\n\]*" {
  69                 verbose $expect_out(0,string) 2
  70                 exp_continue
  71             }
  72             -re "^END \[^.\]+\\.test\[\r\n\]*" {
  73                 # done
  74             }
  75             -re "^\[^\r\n\]+\[\r\n\]+" {
  76                 exp_continue
  77             }
  78             -re {^expect[[:digit:]]+\.[[:digit:]]+>} {
  79                 perror "$test did not complete" 0
  80             }
  81             timeout {
  82                 perror "$test timed out" 0
  83                 exp_continue
  84             }
  85             eof {
  86                 perror "Expect process exited early" 0
  87             }
  88         }
  89         exp_send "interp delete test_case"
  90         # wait for command to echo...
  91         expect "interp delete test_case"
  92         exp_send "\n"
  93         expect "expect*>"
  94     } else {
  95         perror "$test doesn't exist" 0
  96     }
  97 }
  98
  99 start_expect
 100 foreach i [lsort -dictionary [glob [testsuite file -source -test *.test]]] {
 101     if { [runtest_file_p $runtests $i] } { process_test $i }
 102 }
 103 stop_expect