# 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
