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 (c) 1991-1993 The Regents of the University of California. 8# Copyright (c) 1994-1996 Sun Microsystems, Inc. 9# Copyright (c) 1998-2000 by 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.1}]} { 16 puts stderr "Skipping tests in [info script]. tcltest 2.1 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 list [catch {source $sourcefile} msg] $msg $::errorCode 107} -match listGlob -result [list 1 \ 108 {couldn't read file "*_non_existent_": no such file or directory} \ 109 {POSIX ENOENT {no such file or directory}}] 110test source-2.7 {utf-8 with BOM} -setup { 111 set sourcefile [makeFile {} source.file] 112} -body { 113 set out [open $sourcefile w] 114 fconfigure $out -encoding utf-8 115 puts $out "\ufeffset y new-y" 116 close $out 117 set y old-y 118 source -encoding utf-8 $sourcefile 119 return $y 120} -cleanup { 121 removeFile $sourcefile 122} -result {new-y} 123 124test source-3.1 {return in middle of source file} -setup { 125 set sourcefile [makeFile { 126 set x new-x 127 return allDone 128 set y new-y 129 } source.file] 130} -body { 131 set x old-x 132 set y old-y 133 set z [source $sourcefile] 134 list $x $y $z 135} -cleanup { 136 removeFile source.file 137} -result {new-x old-y allDone} 138test source-3.2 {return with special code etc.} -setup { 139 set sourcefile [makeFile { 140 set x new-x 141 return -code break "Silly result" 142 set y new-y 143 } source.file] 144} -body { 145 source $sourcefile 146} -cleanup { 147 removeFile source.file 148} -returnCodes break -result {Silly result} 149test source-3.3 {return with special code etc.} -setup { 150 set sourcefile [makeFile { 151 set x new-x 152 return -code error "Simulated error" 153 set y new-y 154 } source.file] 155} -body { 156 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 157} -cleanup { 158 removeFile source.file 159} -result {1 {Simulated error} {Simulated error 160 while executing 161"source $sourcefile"} NONE} 162test source-3.4 {return with special code etc.} -setup { 163 set sourcefile [makeFile { 164 set x new-x 165 return -code error -errorinfo "Simulated errorInfo stuff" 166 set y new-y 167 } source.file] 168} -body { 169 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 170} -cleanup { 171 removeFile source.file 172} -result {1 {} {Simulated errorInfo stuff 173 invoked from within 174"source $sourcefile"} NONE} 175test source-3.5 {return with special code etc.} -setup { 176 set sourcefile [makeFile { 177 set x new-x 178 return -code error -errorinfo "Simulated errorInfo stuff" \ 179 -errorcode {a b c} 180 set y new-y 181 } source.file] 182} -body { 183 list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode 184} -cleanup { 185 removeFile source.file 186} -result {1 {} {Simulated errorInfo stuff 187 invoked from within 188"source $sourcefile"} {a b c}} 189 190test source-4.1 {continuation line parsing} -setup { 191 set sourcefile [makeFile [string map {CL \\\n} { 192 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]" 193 }] source.file] 194} -body { 195 source $sourcefile 196} -cleanup { 197 removeFile source.file 198} -result {source: 3 4 5} 199 200test source-6.1 {source is binary ok} -setup { 201 # Note [makeFile] writes in the system encoding. 202 # [source] defaults to reading in the system encoding. 203 set sourcefile [makeFile [list set x "a b\0c"] source.file] 204} -body { 205 set x {} 206 source $sourcefile 207 string length $x 208} -cleanup { 209 removeFile source.file 210} -result 5 211test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { 212 set sourcefile [makeFile "set x ab\32c" source.file] 213} -body { 214 set x {} 215 source $sourcefile 216 string length $x 217} -cleanup { 218 removeFile source.file 219} -result 2 220 221test source-7.1 {source -encoding test} -setup { 222 set sourcefile [makeFile {} source.file] 223 file delete $sourcefile 224 set f [open $sourcefile w] 225 fconfigure $f -encoding utf-8 226 puts $f "set symbol(square-root) \u221A; set x correct" 227 close $f 228} -body { 229 set x unset 230 source -encoding utf-8 $sourcefile 231 set x 232} -cleanup { 233 removeFile source.file 234} -result correct 235test source-7.2 {source -encoding test} -setup { 236 # This tests for bad interactions between [source -encoding] 237 # and use of the Control-Z character (\u001A) as a cross-platform 238 # EOF character by [source]. Here we write out and the [source] a 239 # file that contains the byte \x1A, although not the character \u001A in 240 # the indicated encoding. 241 set sourcefile [makeFile {} source.file] 242 file delete $sourcefile 243 set f [open $sourcefile w] 244 fconfigure $f -encoding unicode 245 puts $f "set symbol(square-root) \u221A; set x correct" 246 close $f 247} -body { 248 set x unset 249 source -encoding unicode $sourcefile 250 set x 251} -cleanup { 252 removeFile source.file 253} -result correct 254test source-7.3 {source -encoding: syntax} -body { 255 # Have to spell out the -encoding option 256 source -e utf-8 no_file 257} -returnCodes 1 -match glob -result {bad option*} 258test source-7.4 {source -encoding: syntax} -setup { 259 set sourcefile [makeFile {} source.file] 260} -body { 261 source -encoding no-such-encoding $sourcefile 262} -cleanup { 263 removeFile source.file 264} -returnCodes 1 -match glob -result {unknown encoding*} 265test source-7.5 {source -encoding: correct operation} -setup { 266 set sourcefile [makeFile {} source.file] 267 file delete $sourcefile 268 set f [open $sourcefile w] 269 fconfigure $f -encoding utf-8 270 puts $f "proc \u20ac {} {return foo}" 271 close $f 272} -body { 273 source -encoding utf-8 $sourcefile 274 \u20ac 275} -cleanup { 276 removeFile source.file 277 rename \u20ac {} 278} -result foo 279test source-7.6 {source -encoding: mismatch encoding error} -setup { 280 set sourcefile [makeFile {} source.file] 281 file delete $sourcefile 282 set f [open $sourcefile w] 283 fconfigure $f -encoding utf-8 284 puts $f "proc \u20ac {} {return foo}" 285 close $f 286} -body { 287 source -encoding ascii $sourcefile 288 \u20ac 289} -cleanup { 290 removeFile source.file 291} -returnCodes error -match glob -result {invalid command name*} 292 293cleanupTests 294} 295namespace delete ::tcl::test::source 296return 297