testsuite/runtest.libs/utils.test

   1 # Test procedures in lib/utils.exp.                             -*- Tcl -*-
   2 #
   3 # Copyright (C) 1996-2019, 2020 Free Software Foundation, Inc.
   4 #
   5 # This file is part of DejaGnu.
   6 #
   7 # DejaGnu is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # DejaGnu is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with DejaGnu; if not, write to the Free Software Foundation,
  19 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  20
  21 if [ file exists $srcdir/$subdir/default_procs.tcl ] {
  22     source $srcdir/$subdir/default_procs.tcl
  23 } else {
  24     puts "ERROR: $srcdir$subdir/default_procs.tcl doesn't exist"
  25 }
  26
  27 set file $srcdir/../lib/utils.exp
  28 if [ file exists $file] {
  29     source $file
  30 } else {
  31     puts "ERROR: $file doesn't exist"
  32 }
  33
  34 # Test getdirs:
  35 #
  36 run_tests [subst {
  37     { lib_pat_test getdirs
  38         {[file join $srcdir runtest.libs]}
  39         [file join $srcdir runtest.libs topdir]
  40         "getdirs toplevel, no arguments" }
  41     { lib_pat_test getdirs
  42         {[file join $srcdir runtest.libs] "top*"}
  43         [file join $srcdir runtest.libs topdir]
  44         "getdirs toplevel, one subdir" }
  45     { lib_pat_test getdirs
  46         {[file join $srcdir runtest.libs topdir]}
  47         "*topdir*subdir\[12\]*topdir*subdir\[12\]"
  48         "getdirs toplevel, two subdirs" }
  49     { lib_pat_test getdirs
  50         {[file join $srcdir runtest.libs nothere]}
  51         ""
  52         "getdirs toplevel, non-existent subdir"}
  53 }]
  54
  55 # Test relative_filename:
  56 #
  57 run_tests {
  58     { lib_ret_test relative_filename {"/foo/test" "/foo/test/bar/baz"} "bar/baz"
  59         "relative_filename, simple prefix" }
  60     { lib_ret_test relative_filename {"/foo/test" "/bar/test"} "../../bar/test"
  61         "relative_filename, up to top" }
  62     { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/bar/test"} "../bar/test"
  63         "relative_filename, up one level" }
  64     { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/foo-test"} ""
  65         "relative_filename, same name" }
  66 }
  67
  68 # Test find:
  69 #
  70 run_tests [subst {
  71     { lib_pat_test find
  72         {[file join $srcdir runtest.libs topdir subdir2] "sub*"}
  73         "*/subdir2/subfile2"
  74         "find, only one level deep" }
  75     { lib_regexp_test find
  76         {[file join $srcdir runtest.libs topdir subdir1] "sub*"}
  77         ".*/subdir1/subsubdir1/subsubfile1( |$)"
  78         "find, two levels deep" }
  79 }]
  80
  81 # Environment varible utility tests.
  82 #
  83
  84 if [info exists env(TESTRUN)] {
  85     unset env(TESTRUN)
  86 }
  87
  88 # Test setenv:
  89 #
  90 setenv TESTRUN FooBar
  91 if [info exists env(TESTRUN)] {
  92     if { $env(TESTRUN) eq "FooBar" } {
  93         pass "setenv, set an environment variable"
  94     } else {
  95         fail "setenv, set an environment variable"
  96     }
  97 } else {
  98     fail "setenv, set an environment variable"
  99 }
 100
 101 # Test getenv:
 102 #
 103 if [info exists env(TESTRUN)] {
 104     if { [getenv TESTRUN] eq "FooBar" } {
 105         pass "getenv, get an environment variable"
 106     } else {
 107         fail "getenv, get an environment variable"
 108     }
 109 } else {
 110     untested "getenv, get an environment variable"
 111 }
 112
 113 # Test unsetenv:
 114 #
 115 if [info exists env(TESTRUN)] {
 116     unsetenv TESTRUN
 117     if [info exists env(TESTRUN)] {
 118         fail "unsetenv, unset an environment variable"
 119     } else {
 120         pass "unsetenv, unset an environment variable"
 121     }
 122 } else {
 123     untested "unsetenv, unset an environment variable"
 124 }
 125
 126 # Test 'which' using a relative path.
 127 #
 128 if {[which ./config.status] != 0} {
 129   pass "which, relative path to config.status"
 130 } else {
 131   fail "which, relative path to config.status"
 132 }
 133
 134 # Test 'which' using an absolute path.
 135 #
 136 if {[which [file join $objdir .. config.status]] != 0} {
 137   pass "which, absolute path to config.status"
 138 } else {
 139   fail "which, absolute path to config.status"
 140 }
 141
 142 # Test 'which sh'.
 143 #
 144 if {[which sh] != 0} {
 145   pass "which, sh"
 146 } else {
 147   fail "which, sh"
 148 }
 149
 150 ### Do not adjust the comment on the next line. The grep test case
 151 ### depends on it.
 152
 153 # Test grep!
 154 if {[llength [grep $srcdir/runtest.libs/utils.test "^# Test grep!"]] == 1} {
 155   pass "grep, no options"
 156 } else {
 157   fail "grep, no options"
 158 }
 159
 160 # Test grep with line option.
 161 set result [grep $srcdir/runtest.libs/utils.test "^# Test grep!" line]
 162 if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]} {
 163   pass "grep, line option"
 164 } else {
 165   fail "grep, line option"
 166 }
 167
 168 # Test grep with -n option.
 169 set result [grep -n $srcdir/runtest.libs/utils.test "^# Test grep!"]
 170 if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]} {
 171   pass "grep, -n option"
 172 } else {
 173   fail "grep, -n option"
 174 }
 175
 176 # Test diff proc.
 177
 178 # Setup.
 179 set f1 [open diff1.txt w]
 180 set f2 [open diff2.txt w]
 181 foreach f [list $f1 $f2] {
 182   puts $f "Hello world"
 183   close $f
 184 }
 185
 186 # Two identical files; expect 1.
 187 if {[diff diff1.txt diff2.txt] == 1} {
 188   pass "diff, identical files"
 189 } else {
 190   fail "diff, identical files"
 191 }
 192
 193 # Now remove one file; expect 0.
 194 file delete diff1.txt
 195 if {[diff diff1.txt diff2.txt] == 0} {
 196   pass "diff, one file missing"
 197 } else {
 198   fail "diff, one file missing"
 199 }
 200
 201 # diff1.txt differs from diff2.txt; expect -1.
 202 set f [open diff1.txt w]
 203 puts $f "Hello Cygnus"
 204 close $f
 205 if {[diff diff1.txt diff2.txt] == -1} {
 206   pass "diff, different files"
 207 } else {
 208   fail "diff, different files"
 209 }
 210
 211 # diff teardown.
 212 file delete -force diff1.txt diff2.txt
 213
 214
 215 # Test runtest_file_p.
 216
 217 run_tests {
 218     { lib_bool_test runtest_file_p {{foo.exp} foo.c} true
 219         "runtest_file_p, bare foo.exp matches foo.c" }
 220     { lib_bool_test runtest_file_p {{foo.exp foo.c} foo.c} true
 221         "runtest_file_p, foo.exp=foo.c matches foo.c" }
 222     { lib_bool_test runtest_file_p {{foo.exp foo.*} foo.c} true
 223         "runtest_file_p, foo.exp=foo.* matches foo.c" }
 224     { lib_bool_test runtest_file_p {{foo.exp bar.*} foo.c} false
 225         "runtest_file_p, foo.exp=bar.* excludes foo.c" }
 226 }
 227
 228 puts "END utils.test"