# Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # Contributions from Don Porter, NIST, 2003. (not subject to US copyright) # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: source.test,v 1.1.1.1 2007/07/10 15:04:24 duncan Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } namespace eval ::tcl::test::source { namespace import ::tcltest::test namespace import ::tcltest::testConstraint namespace import ::tcltest::cleanupTests namespace import ::tcltest::makeFile namespace import ::tcltest::removeFile namespace import ::tcltest::customMatch test source-1.1 {source command} -setup { set x "old x value" set y "old y value" set z "old z value" set sourcefile [makeFile { set x 22 set y 33 set z 44 } source.file] } -body { source $sourcefile list $x $y $z } -cleanup { removeFile source.file } -result {22 33 44} test source-1.2 {source command} -setup { set sourcefile [makeFile {list result} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -result result test source-1.3 {source command} -setup { set sourcefile [makeFile {} source.file] set fd [open $sourcefile w] fconfigure $fd -translation lf puts $fd "list a b c \\" puts $fd "d e f" close $fd } -body { source $sourcefile } -cleanup { removeFile source.file } -result {a b c d e f} proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 } foreach e $expected a $actual { if {![string match $e $a]} { return 0 } } return 1 } customMatch listGlob [namespace which ListGlobMatch] test source-2.3 {source error conditions} -setup { set sourcefile [makeFile { set x 146 error "error in sourced file" set y $x } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo } -cleanup { removeFile source.file } -match listGlob -result [list 1 {error in sourced file} \ {error in sourced file while executing "error "error in sourced file"" (file "*source.file" line 3) invoked from within "source $sourcefile"}] test source-2.4 {source error conditions} -setup { set sourcefile [makeFile {break} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break test source-2.5 {source error conditions} -setup { set sourcefile [makeFile {continue} source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes continue test source-2.6 {source error conditions} -setup { set sourcefile [makeFile {} _non_existent_] removeFile _non_existent_ } -body { list [catch {source $sourcefile} msg] $msg $::errorCode } -match listGlob -result [list 1 \ {couldn't read file "*_non_existent_": no such file or directory} \ {POSIX ENOENT {no such file or directory}}] test source-3.1 {return in middle of source file} -setup { set sourcefile [makeFile { set x new-x return allDone set y new-y } source.file] } -body { set x old-x set y old-y set z [source $sourcefile] list $x $y $z } -cleanup { removeFile source.file } -result {new-x old-y allDone} test source-3.2 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code break "Silly result" set y new-y } source.file] } -body { source $sourcefile } -cleanup { removeFile source.file } -returnCodes break -result {Silly result} test source-3.3 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error "Simulated error" set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {Simulated error} {Simulated error while executing "source $sourcefile"} NONE} test source-3.4 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} NONE} test source-3.5 {return with special code etc.} -setup { set sourcefile [makeFile { set x new-x return -code error -errorinfo "Simulated errorInfo stuff" \ -errorcode {a b c} set y new-y } source.file] } -body { list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode } -cleanup { removeFile source.file } -result {1 {} {Simulated errorInfo stuff invoked from within "source $sourcefile"} {a b c}} # Test for the Macintosh specfic features of the source command test source-4.1 {source error conditions} -constraints macOnly -body { source -rsrc _no_exist_ } -result {The resource "_no_exist_" could not be loaded from application.} \ -returnCodes error test source-4.2 {source error conditions} -constraints macOnly -body { source -rsrcid bad_id } -returnCodes error -result {expected integer but got "bad_id"} test source-4.3 {source error conditions} -constraints macOnly -body { source -rsrc rsrcName fileName extra } -returnCodes error -result {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} test source-4.4 {source error conditions} -constraints macOnly -body { source non_switch rsrcName } -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} test source-4.5 {source error conditions} -constraints macOnly -body { source -bad_switch argument } -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"} testConstraint testWriteTextResource \ [llength [info commands testWriteTextResource]] test source-5.1 {source resource files} -constraints macOnly -setup { set sourcefile [makeFile {} bad_file] removeFile bad_file } -body { source -rsrc rsrcName $sourcefile } -returnCodes error -match glob -result {Error finding the file: "*bad_file".} test source-5.2 {source resource files} -constraints macOnly -setup { set sourcefile [makeFile {return} source.file] } -body { source -rsrc rsrcName $sourcefile } -cleanup { removeFile source.file } -returnCodes error -match glob \ -result {Error reading the file: "*source.file".} test source-5.3 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrc rsrcName -file $rsrc.file {set msg2 ok; return} } -body { set result [catch {source -rsrc rsrcName rsrc.file} msg] list $msg2 $result $msg } -cleanup { removeFile rsrc.file } -result [list ok 0 {}] test source-5.4 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrsFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrc fileRsrcName \ -file $rsrcFile {set msg2 ok; return} } -body { source -rsrc fileRsrcName $rsrcFile set result [catch {source -rsrc fileRsrcName} msg] list $msg2 $result $msg } -cleanup { removeFile rsrc.file } -result [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}] test source-5.5 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrcid 200 \ -file $rsrcFile {set msg2 hello; set msg3 bye} } -body { set result [catch {source -rsrcid 200 $rsrcFile} msg] list $msg2 $result $msg } -cleanup { removeFile rsrc.file } -result [list hello 0 bye] test source-5.6 {source resource files} -constraints { macOnly testWriteTextResource } -setup { set msg2 unset set rsrcFile [makeFile {} rsrc.file] removeFile rsrc.file testWriteTextResource -rsrcid 200 \ -file $rsrcFile {set msg2 hello; error bad; set msg3 bye} } -body { set result [catch {source -rsrcid 200 rsrc.file} msg] list $msg2 $result $msg } -cleanup { removeFile rsrc.file } -result [list hello 1 bad] test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. set sourcefile [makeFile [list set x "a b\0c"] source.file] } -body { set x {} source $sourcefile string length $x } -cleanup { removeFile source.file } -result 5 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup { set sourcefile [makeFile "set x ab\32c" source.file] } -body { set x {} source $sourcefile string length $x } -cleanup { removeFile source.file } -result 2 cleanupTests } namespace delete ::tcl::test::source return