1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
-
+
|
# 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.13.4.9 2009/11/06 03:24:39 dgp Exp $
# RCS: @(#) $Id: safe.test,v 1.13.4.10 2009/11/23 16:44:49 dgp Exp $
package require Tcl 8.5
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
|
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
+
-
+
-
+
-
+
-
+
-
+
-
+
|
if {[catch {package require Tcltest} msg]} {
testConstraint TcltestPackage 0
} else {
testConstraint TcltestPackage 1
# we use the Tcltest package , which has no Safe_Init
}
teststaticpkg Safepkg1 0 0
test safe-10.1 {testing statics loading} TcltestPackage {
set i [safe::interpCreate]
list \
[catch {interp eval $i {load {} Tcltest}} msg] \
[catch {interp eval $i {load {} Safepkg1}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
} {1 {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} {}}
test safe-10.2 {testing statics loading / -nostatics} TcltestPackage {
set i [safe::interpCreate -nostatics]
list \
[catch {interp eval $i {load {} Tcltest}} msg] \
[catch {interp eval $i {load {} Safepkg1}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {permission denied (static package)} {}}
test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage {
set i [safe::interpCreate]
list \
[catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
[catch {interp eval $i {interp create x; load {} Safepkg1 x}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {permission denied (nested load)} {}}
test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage {
set i [safe::interpCreate -nestedloadok]
list \
[catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
[catch {interp eval $i {interp create x; load {} Safepkg1 x}} msg] \
$msg \
[safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
} {1 {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} {}}
test safe-11.1 {testing safe encoding} {
set i [safe::interpCreate]
list \
[catch {interp eval $i encoding} msg] \
$msg \
[safe::interpDelete $i];
|