# Commands covered:  load
#
# 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) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*

	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir pkgb$ext] pkgb child
    load -lazy [file join $testDir pkgb$ext] Pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \

    invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}

test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
    catch {load [file join $testDir pkga$ext] Pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
    load [file join $testDir pkga$ext] Pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    load -global [file join $testDir pkga$ext] Pkga
    load {} Pkga x
    info loaded x
} -cleanup {
    interp delete x
} -result [list [list [file join $testDir pkga$ext] pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
    catch {load foo foo}
} {1}

test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg test 1 0
    load {} test
    load {} test child
    teststaticpkg Test 1 0
    load {} Test
    load {} Test child
    list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg another 0 0
    load {} another
    child eval {set x "not loaded"}
    list [catch {load {} another child} msg] $msg \
	[child eval set x] [set x]
} {1 {can't use package in a safe interpreter: no another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg more 0 1
    teststaticpkg More 0 1
    load {} more
    set x
} {not loaded}
catch {load [file join $testDir pkga$ext] pkga}
catch {load [file join $testDir pkgb$ext] pkgb}
catch {load [file join $testDir pkge$ext] pkge}
catch {load [file join $testDir pkga$ext] Pkga}
catch {load [file join $testDir pkgb$ext] Pkgb}
catch {load [file join $testDir pkge$ext] Pkge}
set currentRealPackages [list [list [file join $testDir pkge$ext] pkge] [list [file join $testDir pkgb$ext] pkgb] [list [file join $testDir pkga$ext] pkga]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
    teststaticpkg test 1 0
    teststaticpkg another 0 0
    teststaticpkg more 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg double 0 1

test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} double} {{} more} {{} another} {{} test} [list [file join $testDir pkga$ext] pkga] [list [file join $testDir pkgb$ext] pkgb] {*}$alreadyLoaded]]
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} test} [list [file join $testDir pkgb$ext] pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [file join $testDir pkgb$ext] pkgb
    load [file join $testDir pkgb$ext] Pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] pkgb] {{} double} {{} more} {{} another} {{} test} [list [file join $testDir pkga$ext] pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup {
    interp create child1
    interp create child2

} -result {{{{} loadninepointone} {* tcl::test}} {{{} loadninepointone} {* tcl::test}}}

test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
    list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg
    list [catch {load simplefs:/pkgd$ext PKGD} msg] $msg
} -result {0 {}} -cleanup {
    testsimplefilesystem 0
    cd $dir
    unset dir
}

test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \