1# Commands covered: source 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994-1996 Sun Microsystems, Inc. 9# Copyright © 1998-2000 Scriptics Corporation. 10# Contributions from Don Porter, NIST, 2003. (not subject to US copyright) 11# 12# See the file "license.terms" for information on usage and redistribution 13# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 15if {[catch {package require tcltest 2.5}]} { 16 puts stderr "Skipping tests in [info script]. tcltest 2.5 required." 17 return 18} 19 20namespace eval ::tcl::test::source { 21 namespace import ::tcltest::* 22 23test source-1.1 {source command} -setup { 24 set x "old x value" 25 set y "old y value" 26 set z "old z value" 27 set sourcefile [makeFile { 28 set x 22 29 set y 33 30 set z 44 31 } source.file] 32} -body { 33 source $sourcefile 34 list $x $y $z 35} -cleanup { 36 removeFile source.file 37} -result {22 33 44} 38test source-1.2 {source command} -setup { 39 set sourcefile [makeFile {list result} source.file] 40} -body { 41 source $sourcefile 42} -cleanup { 43 removeFile source.file 44} -result result 45test source-1.3 {source command} -setup { 46 set sourcefile [makeFile {} source.file] 47 set fd [open $sourcefile w] 48 fconfigure $fd -translation lf 49 puts $fd "list a b c \\" 50 puts $fd "d e f" 51 close $fd 52} -body { 53 source $sourcefile 54} -cleanup { 55 removeFile source.file 56} -result {a b c d e f} 57 58proc ListGlobMatch {expected actual} { 59 if {[llength $expected] != [llength $actual]} { 60 return 0 61 } 62 foreach e $expected a $actual { 63 if {![string match $e $a]} { 64 return 0 65 } 66 } 67 return 1 68} 69customMatch listGlob [namespace which ListGlobMatch] 70 71test source-2.3 {source error conditions} -setup { 72 set sourcefile [makeFile { 73 set x 146 74 error "error in sourced file" 75 set y $x 76 } source.file] 77} -body { 78 list [catch {source $sourcefile} msg] $msg $::errorInfo 79} -cleanup { 80 removeFile source.file 81} -match listGlob -result [list 1 {error in sourced file} \ 82 {error in sourced file 83 while executing 84"error "error in sourced file"" 85 (file "*source.file" line 3) 86 invoked from within 87"source $sourcefile"}] 88test source-2.4 {source error conditions} -setup { 89 set sourcefile [makeFile {break} source.file] 90} -body { 91 source $sourcefile 92} -cleanup { 93 removeFile source.file 94} -returnCodes break 95test source-2.5 {source error conditions} -setup { 96 set sourcefile [makeFile {continue} source.file] 97} -body { 98 source $sourcefile 99} -cleanup { 100 removeFile source.file 101} -returnCodes continue 102test source-2.6 {source error conditions} -setup { 103 set sourcefile [makeFile {} _non_existent_] 104 removeFile _non_existent_ 105} -body { 106 source $sourcefile 107} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \ 108 -errorCode {POSIX ENOENT {no such file or directory}} 109test source-2.7 {utf-8 with BOM} -setup { 110 set sourcefile [makeFile {} source.file] 111} -body { 112 set out [open $sourcefile w] 113 fconfigure $out -encoding utf-8 114 puts $out "\uFEFFset y new-y" 115 close $out 116 set y old-y 117 source -encoding utf-8 $sourcefile 118 return $y 119} -cleanup { 120 removeFile $sourcefile 121} -result {new-y} 122 123test source-3.1 {return in middle of source file} -setup { 124 set sourcefile [makeFile { 125 set x new-x 126 return allDone 127 set y new-y 128 } source.file] 129} -body { 130 set x old-x 131 set y old-y 132 set z [source $sourcefile] 133 list $x $y $z 134} -cleanup { 135 removeFile source.file 136} -result {new-x old-y allDone} 137test source-3.2 {return with special code etc.} -setup { 138 set sourcefile [makeFile { 139 set x new-x 140 return -code break "Silly result" 141 set y new-y 142 } source.file] 143} -body { 144 source $sourcefile 145} -cleanup { 146 removeFile source.file 147} -returnCodes break -result {Silly result} 148test source-3.3 {return with special code etc.} -setup { 149 set sourcefile [makeFile { 150 set x new-x 151 return -code error "Simulated error" 152 set y new-y 153 } source.file] 154} -body { 155 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 156} -cleanup { 157 removeFile source.file 158} -result {1 {Simulated error} {Simulated error 159 while executing 160"source $sourcefile"} NONE} 161test source-3.4 {return with special code etc.} -setup { 162 set sourcefile [makeFile { 163 set x new-x 164 return -code error -errorinfo "Simulated errorInfo stuff" 165 set y new-y 166 } source.file] 167} -body { 168 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 169} -cleanup { 170 removeFile source.file 171} -result {1 {} {Simulated errorInfo stuff 172 invoked from within 173"source $sourcefile"} NONE} 174test source-3.5 {return with special code etc.} -setup { 175 set sourcefile [makeFile { 176 set x new-x 177 return -code error -errorinfo "Simulated errorInfo stuff" \ 178 -errorcode {a b c} 179 set y new-y 180 } source.file] 181} -body { 182 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 183} -cleanup { 184 removeFile source.file 185} -result {1 {} {Simulated errorInfo stuff 186 invoked from within 187"source $sourcefile"} {a b c}} 188 189test source-4.1 {continuation line parsing} -setup { 190 set sourcefile [makeFile [string map {CL \\\n} { 191 format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]" 192 }] source.file] 193} -body { 194 source $sourcefile 195} -cleanup { 196 removeFile source.file 197} -result {source: 3 4 5} 198 199test source-6.1 {source is binary ok} -setup { 200 # Note [makeFile] writes in the system encoding. 201 # [source] defaults to reading in the system encoding. 202 set sourcefile [makeFile [list set x "a b\x00c"] source.file] 203} -body { 204 set x {} 205 source $sourcefile 206 string length $x 207} -cleanup { 208 removeFile source.file 209} -result 5 210test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { 211 set sourcefile [makeFile "set x ab\x1Ac" source.file] 212} -body { 213 set x {} 214 source $sourcefile 215 string length $x 216} -cleanup { 217 removeFile source.file 218} -result 2 219 220test source-7.1 {source -encoding test} -setup { 221 set sourcefile [makeFile {} source.file] 222 file delete $sourcefile 223 set f [open $sourcefile w] 224 fconfigure $f -encoding utf-8 225 puts $f "set symbol(square-root) √; set x correct" 226 close $f 227} -body { 228 set x unset 229 source -encoding utf-8 $sourcefile 230 set x 231} -cleanup { 232 removeFile source.file 233} -result correct 234test source-7.2 {source -encoding test} -setup { 235 # This tests for bad interactions between [source -encoding] 236 # and use of the Control-Z character (\x1A) as a cross-platform 237 # EOF character by [source]. Here we write out and the [source] a 238 # file that contains the byte \x1A, although not the character \x1A in 239 # the indicated encoding. 240 set sourcefile [makeFile {} source.file] 241 file delete $sourcefile 242 set f [open $sourcefile w] 243 fconfigure $f -encoding utf-16 244 puts $f "set symbol(square-root) √; set x correct" 245 close $f 246} -body { 247 set x unset 248 source -encoding utf-16 $sourcefile 249 set x 250} -cleanup { 251 removeFile source.file 252} -result correct 253test source-7.3 {source -encoding: syntax} -body { 254 # Have to spell out the -encoding option 255 source -e utf-8 no_file 256} -returnCodes 1 -match glob -result {bad option*} 257test source-7.4 {source -encoding: syntax} -setup { 258 set sourcefile [makeFile {} source.file] 259} -body { 260 source -encoding no-such-encoding $sourcefile 261} -cleanup { 262 removeFile source.file 263} -returnCodes 1 -match glob -result {unknown encoding*} 264test source-7.5 {source -encoding: correct operation} -setup { 265 set sourcefile [makeFile {} source.file] 266 file delete $sourcefile 267 set f [open $sourcefile w] 268 fconfigure $f -encoding utf-8 269 puts $f "proc € {} {return foo}" 270 close $f 271} -body { 272 source -encoding utf-8 $sourcefile 273 € 274} -cleanup { 275 removeFile source.file 276 rename € {} 277} -result foo 278test source-7.6 {source -encoding: mismatch encoding error} -setup { 279 set sourcefile [makeFile {} source.file] 280 file delete $sourcefile 281 set f [open $sourcefile w] 282 fconfigure $f -encoding utf-8 283 puts $f "proc € {} {return foo}" 284 close $f 285} -body { 286 source -encoding ascii $sourcefile 287 € 288} -cleanup { 289 removeFile source.file 290} -returnCodes error -match glob -result {invalid command name*} 291 292test source-8.1 {source and coroutine/yield} -setup { 293 set sourcefile [makeFile {} source.file] 294 file delete $sourcefile 295} -body { 296 makeFile {yield 1; yield 2; return 3;} $sourcefile 297 coroutine coro apply {f {yield;source $f}} $sourcefile 298 list [coro] [coro] [coro] [info exist coro] 299} -cleanup { 300 catch {rename coro {}} 301 removeFile source.file 302} -result {1 2 3 0} 303 304cleanupTests 305} 306namespace delete ::tcl::test::source 307return 308 309# Local Variables: 310# mode: tcl 311# End: 312