Artifact
0c07fd7ddb7e0e8183f3593e8313d131a4cd075281b786c3d43a043e8f6e4c34
0000: 23 20 61 6c 6c 2e 74 63 6c 20 2d 2d 0a 23 0a 23 # all.tcl --.#.#
0010: 20 54 68 69 73 20 66 69 6c 65 20 63 6f 6e 74 61 This file conta
0020: 69 6e 73 20 61 20 74 6f 70 2d 6c 65 76 65 6c 20 ins a top-level
0030: 73 63 72 69 70 74 20 74 6f 20 72 75 6e 20 61 6c script to run al
0040: 6c 20 6f 66 20 74 68 65 20 54 63 6c 0a 23 20 74 l of the Tcl.# t
0050: 65 73 74 73 2e 20 20 45 78 65 63 75 74 65 20 69 ests. Execute i
0060: 74 20 62 79 20 69 6e 76 6f 6b 69 6e 67 20 22 73 t by invoking "s
0070: 6f 75 72 63 65 20 61 6c 6c 2e 74 65 73 74 22 20 ource all.test"
0080: 77 68 65 6e 20 72 75 6e 6e 69 6e 67 20 74 63 6c when running tcl
0090: 74 65 73 74 0a 23 20 69 6e 20 74 68 69 73 20 64 test.# in this d
00a0: 69 72 65 63 74 6f 72 79 2e 0a 23 0a 0a 73 65 74 irectory..#..set
00b0: 20 70 61 74 68 20 5b 66 69 6c 65 20 6e 6f 72 6d path [file norm
00c0: 61 6c 69 7a 65 20 5b 66 69 6c 65 20 64 69 72 6e alize [file dirn
00d0: 61 6d 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ame [file join [
00e0: 70 77 64 5d 20 5b 69 6e 66 6f 20 73 63 72 69 70 pwd] [info scrip
00f0: 74 5d 5d 5d 5d 0a 73 65 74 20 61 75 74 6f 5f 70 t]]]].set auto_p
0100: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
0110: 74 6f 5f 70 61 74 68 20 30 20 5b 66 69 6c 65 20 to_path 0 [file
0120: 64 69 72 6e 61 6d 65 20 24 70 61 74 68 5d 20 24 dirname $path] $
0130: 70 61 74 68 5d 0a 0a 69 66 20 7b 22 3a 3a 74 63 path]..if {"::tc
0140: 6c 74 65 73 74 22 20 6e 69 20 5b 6e 61 6d 65 73 ltest" ni [names
0150: 70 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 7d 20 pace children]}
0160: 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 65 {. package re
0170: 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 20 quire tcltest.
0180: 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 6f namespace impo
0190: 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 rt -force ::tclt
01a0: 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 41 64 64 20 est::*.}..# Add
01b0: 75 73 65 72 20 70 72 6f 76 69 64 65 64 20 61 72 user provided ar
01c0: 67 73 20 73 75 63 68 20 61 73 20 2d 6c 6f 61 64 gs such as -load
01d0: 0a 74 63 6c 74 65 73 74 3a 3a 63 6f 6e 66 69 67 .tcltest::config
01e0: 75 72 65 20 7b 2a 7d 24 61 72 67 76 20 2d 74 65 ure {*}$argv -te
01f0: 73 74 64 69 72 20 24 70 61 74 68 0a 23 74 63 6c stdir $path.#tcl
0200: 74 65 73 74 3a 3a 63 6f 6e 66 69 67 75 72 65 20 test::configure
0210: 2d 76 65 72 62 6f 73 65 20 74 70 73 65 0a 0a 23 -verbose tpse..#
0220: 20 50 72 69 6e 74 20 73 74 61 74 73 20 61 74 20 Print stats at
0230: 65 6e 64 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 end.set ::tcltes
0240: 74 3a 3a 74 65 73 74 53 69 6e 67 6c 65 46 69 6c t::testSingleFil
0250: 65 20 66 61 6c 73 65 0a 23 74 63 6c 74 65 73 74 e false.#tcltest
0260: 3a 3a 63 6f 6e 66 69 67 75 72 65 20 2d 73 69 6e ::configure -sin
0270: 67 6c 65 70 72 6f 63 20 31 0a 0a 23 20 47 65 74 gleproc 1..# Get
0280: 20 63 6f 6d 6d 6f 6e 20 66 75 6e 63 74 69 6f 6e common function
0290: 73 2c 20 69 66 20 61 6e 79 0a 69 66 20 7b 5b 66 s, if any.if {[f
02a0: 69 6c 65 20 65 78 69 73 74 73 20 5b 66 69 6c 65 ile exists [file
02b0: 20 6a 6f 69 6e 20 24 70 61 74 68 20 63 6f 6d 6d join $path comm
02c0: 6f 6e 2e 74 63 6c 5d 5d 7d 20 7b 0a 20 20 20 20 on.tcl]]} {.
02d0: 73 6f 75 72 63 65 20 2d 65 6e 63 6f 64 69 6e 67 source -encoding
02e0: 20 75 74 66 2d 38 20 5b 66 69 6c 65 20 6a 6f 69 utf-8 [file joi
02f0: 6e 20 24 70 61 74 68 20 63 6f 6d 6d 6f 6e 2e 74 n $path common.t
0300: 63 6c 5d 0a 7d 0a 0a 23 0a 23 20 52 75 6e 20 61 cl].}..#.# Run a
0310: 6c 6c 20 74 65 73 74 73 20 69 6e 20 63 75 72 72 ll tests in curr
0320: 65 6e 74 20 61 6e 64 20 61 6e 79 20 73 75 62 20 ent and any sub
0330: 64 69 72 65 63 74 6f 72 69 65 73 20 77 69 74 68 directories with
0340: 20 61 6e 20 61 6c 6c 2e 74 63 6c 20 66 69 6c 65 an all.tcl file
0350: 2e 0a 23 0a 73 65 74 20 3a 3a 65 78 69 74 43 6f ..#.set ::exitCo
0360: 64 65 20 30 0a 69 66 20 7b 5b 70 61 63 6b 61 67 de 0.if {[packag
0370: 65 20 76 73 61 74 69 73 66 69 65 73 20 5b 70 61 e vsatisfies [pa
0380: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 63 ckage require tc
0390: 6c 74 65 73 74 5d 20 32 2e 35 2d 5d 7d 20 7b 0a ltest] 2.5-]} {.
03a0: 20 20 20 20 69 66 20 7b 5b 3a 3a 74 63 6c 74 65 if {[::tclte
03b0: 73 74 3a 3a 72 75 6e 41 6c 6c 54 65 73 74 73 5d st::runAllTests]
03c0: 20 3d 3d 20 31 7d 20 7b 0a 09 73 65 74 20 3a 3a == 1} {..set ::
03d0: 65 78 69 74 43 6f 64 65 20 31 0a 20 20 20 20 7d exitCode 1. }
03e0: 0a 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 23 ..} else {. #
03f0: 20 48 6f 6f 6b 20 74 6f 20 64 65 74 65 72 6d 69 Hook to determi
0400: 6e 65 20 69 66 20 61 6e 79 20 6f 66 20 74 68 65 ne if any of the
0410: 20 74 65 73 74 73 20 66 61 69 6c 65 64 2e 20 54 tests failed. T
0420: 68 65 6e 20 77 65 20 63 61 6e 20 65 78 69 74 20 hen we can exit
0430: 77 69 74 68 20 74 68 65 0a 20 20 20 20 23 20 70 with the. # p
0440: 72 6f 70 65 72 20 65 78 69 74 20 63 6f 64 65 3a roper exit code:
0450: 20 30 3d 61 6c 6c 20 70 61 73 73 65 64 2c 20 31 0=all passed, 1
0460: 3d 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 66 61 69 =one or more fai
0470: 6c 65 64 0a 20 20 20 20 70 72 6f 63 20 74 63 6c led. proc tcl
0480: 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 test::cleanupTes
0490: 74 73 48 6f 6f 6b 20 7b 7d 20 7b 0a 09 76 61 72 tsHook {} {..var
04a0: 69 61 62 6c 65 20 6e 75 6d 54 65 73 74 73 0a 09 iable numTests..
04b0: 73 65 74 20 3a 3a 65 78 69 74 43 6f 64 65 20 5b set ::exitCode [
04c0: 65 78 70 72 20 7b 24 6e 75 6d 54 65 73 74 73 28 expr {$numTests(
04d0: 54 6f 74 61 6c 29 20 3d 3d 20 30 20 7c 7c 20 24 Total) == 0 || $
04e0: 6e 75 6d 54 65 73 74 73 28 46 61 69 6c 65 64 29 numTests(Failed)
04f0: 20 3e 20 30 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 > 0}]. }.
0500: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 72 75 6e 41 ::tcltest::runA
0510: 6c 6c 54 65 73 74 73 0a 7d 0a 0a 23 20 52 65 74 llTests.}..# Ret
0520: 75 72 6e 20 65 78 69 74 20 63 6f 64 65 20 66 6f urn exit code fo
0530: 72 20 75 73 65 20 62 79 20 74 65 73 74 20 66 72 r use by test fr
0540: 61 6d 65 77 6f 72 6b 73 3a 20 30 3d 61 6c 6c 20 ameworks: 0=all
0550: 70 61 73 73 65 64 2c 20 31 3d 6f 6e 65 20 6f 72 passed, 1=one or
0560: 20 6d 6f 72 65 20 66 61 69 6c 65 64 0a 69 66 20 more failed.if
0570: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e {[info exists en
0580: 76 28 45 52 52 4f 52 5f 4f 4e 5f 46 41 49 4c 55 v(ERROR_ON_FAILU
0590: 52 45 53 29 5d 7d 20 7b 0a 20 20 20 20 65 78 69 RES)]} {. exi
05a0: 74 20 24 3a 3a 65 78 69 74 43 6f 64 65 0a 7d 20 t $::exitCode.}
05b0: 65 6c 73 65 20 7b 0a 20 20 20 20 65 78 69 74 20 else {. exit
05c0: 30 0a 7d 0a 0.}.