Attachment "safe-extras.test" to
ticket [2964715fff]
added by
kjnash
2010-03-10 23:39:22.
# safe.test --
#
# This file contains a collection of tests for safe Tcl, packages loading,
# and using safe interpreters. Sourcing this file into tcl runs the tests
# and generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: safe.test,v 1.22.4.1 2008/06/25 17:16:30 dgp Exp $
package require Tcl 8.5
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
foreach i [interp slaves] {
interp delete $i
}
set saveAutoPath $::auto_path
set ::auto_path [info library]
# Force actual loading of the safe package
# because we use un exported (and thus un-autoindexed) APIs
# in this test result arguments:
catch {safe::interpConfigure}
proc equiv {x} {return $x}
#### Tests from 8.5, 8.6 cvs, modified for patches @ Bug 2964715
test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob ../*
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {when glob is used in the Safe Base, option "-directory" must be specified}
test safe-12.2 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob -directory .. *
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {directory is not in the access path}
test safe-12.3 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob -join .. *
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {when glob is used in the Safe Base, option "-directory" must be specified}
test safe-12.4 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob -nocomplain ../*
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {when glob is used in the Safe Base, option "-directory" must be specified}
test safe-12.5 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob -directory .. -nocomplain *
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {directory is not in the access path}
test safe-12.6 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob -nocomplain -join .. *
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {when glob is used in the Safe Base, option "-directory" must be specified}
#### New tests for Safe base glob, with patches @ Bug 2964715
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
$i eval glob *
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {when glob is used in the Safe Base, option "-directory" must be specified}
test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 deleteme.tm]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir2
} -body {
set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
if {$result eq [list $testfile]} {
set out {glob match}
} else {
set out "no match: $result"
}
set out
} -returnCodes ok -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {glob match}
test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 deleteme.tm]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
} -body {
$i eval glob -nocomplain -directory $testdir2 *.tm
} -returnCodes error -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {directory is not in the access path}
test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 deleteme.tm]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir
::safe::interpAddToAccessPath $i $testdir2
} -body {
set result [$i eval glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
if {$result eq [list $testfile]} {
set out {glob match}
} else {
set out "no match: $result"
}
set out
} -returnCodes ok -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {glob match}
test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 deleteme.tm]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir2
} -body {
$i eval glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
} -returnCodes error -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {directory is not in the access path}
test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 deleteme.tm]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir
} -body {
$i eval glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
} -returnCodes ok -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {}
test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 pkgIndex.tcl]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir
::safe::interpAddToAccessPath $i $testdir2
} -body {
$i eval glob -directory $testdir -join -nocomplain * pkgIndex.tcl
} -returnCodes error -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {Safe base rejecting glob call apparently from tclPkgUnknown}
test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 notIndex.tcl]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir
::safe::interpAddToAccessPath $i $testdir2
} -body {
set result [$i eval glob -directory $testdir -join -nocomplain * notIndex.tcl]
if {$result eq [list $testfile]} {
set out {glob match}
} else {
set out "no match: $result"
}
set out
} -returnCodes ok -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {glob match}
test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 notIndex.tcl]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir2
} -body {
set result [$i eval glob -directory $testdir -join -nocomplain * notIndex.tcl]
if {$result eq [list $testfile]} {
set out {glob match}
} else {
set out "no match: $result"
}
set out
} -returnCodes error -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {directory is not in the access path}
test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
set i [safe::interpCreate]
proc mkfile {filename} {
close [open $filename w]
return
}
set testdir [file join [temporaryDirectory] deletethisdir]
set testdir2 [file join $testdir deletemetoo]
set testfile [file join $testdir2 notIndex.tcl]
file mkdir $testdir
file mkdir $testdir2
mkfile $testfile
::safe::interpAddToAccessPath $i $testdir
} -body {
$i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
} -returnCodes ok -cleanup {
safe::interpDelete $i
rename mkfile {}
file delete $testfile
file delete $testdir2
file delete $testdir
} -result {}
#### Test for the module path
test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
set tm1 [::tcl::tm::path list]
set tm2 [$i eval ::tcl::tm::path list]
set tm3 {}
foreach token $tm2 {
lappend tm3 [dict get [set ::safe::S${i}(access_path,map)] $token]
}
if {$tm1 eq $tm3} {
set out {module paths match}
} else {
set out "no match: slave has\n$tm3\nbut master has\n$tm1"
}
set out
} -returnCodes ok -cleanup {
safe::interpDelete $i
} -result {module paths match}
set ::auto_path $saveAutoPath
# cleanup
::tcltest::cleanupTests
return
