Tcl Source Code

Check-in [2064a18cad]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* tests/platform.test: * tests/fileName.test: Fixed broken tests.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 2064a18cad4cd52cf4f43dd991379d8ec6d0663a
User & Date: stanton 1999-04-05 23:14:18.000
Context
1999-04-05
23:14
* generic/tclFileName.c: Moved global regexps into thread local storage. check-in: 958a4f2ca0 user: stanton tags: core-8-1-branch-old
23:14
* tests/platform.test: * tests/fileName.test: Fixed broken tests. check-in: 2064a18cad user: stanton tags: core-8-1-branch-old
22:21
Fix DDE tests, don't run on Unix (pcOnly). check-in: 3fb0791223 user: redman tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/fileName.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file tests the filename manipulation routines.
#
# 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-1996 Sun Microsystems, Inc.
# Copyright (c) 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: fileName.test,v 1.1.2.6 1999/03/26 19:13:59 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testsetplatform] == {}} {
    puts "This application hasn't been compiled with the \"testsetplatform\""












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file tests the filename manipulation routines.
#
# 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-1996 Sun Microsystems, Inc.
# Copyright (c) 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: fileName.test,v 1.1.2.7 1999/04/05 23:14:18 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testsetplatform] == {}} {
    puts "This application hasn't been compiled with the \"testsetplatform\""
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
test filename-10.22 {Tcl_TranslateFileName} {
    testsetplatform windows
    list [catch {testtranslatefilename foo//bar} msg] $msg
} {0 {foo\bar}}

testsetplatform $platform

test filename-10.23 {Tcl_TranslateFileName} {nonPortable unixOnly} {
    # this test fails if ~ouster is not /home/ouster
    list [catch {testtranslatefilename ~ouster} msg] $msg
} {0 /home/ouster}
test filename-10.24 {Tcl_TranslateFileName} {nonPortable unixOnly} {
    # this test fails if ~ouster is not /home/ouster
    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
} {0 /home/ouster/foo}


test filename-11.1 {Tcl_GlobCmd} {
    list [catch {glob} msg] $msg







|



|







1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
test filename-10.22 {Tcl_TranslateFileName} {
    testsetplatform windows
    list [catch {testtranslatefilename foo//bar} msg] $msg
} {0 {foo\bar}}

testsetplatform $platform

test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} {
    # this test fails if ~ouster is not /home/ouster
    list [catch {testtranslatefilename ~ouster} msg] $msg
} {0 /home/ouster}
test filename-10.24 {Tcl_TranslateFileName} {unixOnly nonPortable} {
    # this test fails if ~ouster is not /home/ouster
    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
} {0 /home/ouster/foo}


test filename-11.1 {Tcl_GlobCmd} {
    list [catch {glob} msg] $msg
1375
1376
1377
1378
1379
1380
1381





1382





1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
test filename-16.10 {windows specific globbing} {pcOnly} {
    lsort [glob c:globTest\\\\*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.11 {windows specific globbing} {pcOnly} {
    lsort [glob c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}






catch {





    removeDirectory globTest
    makeDirectory globTest
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]
}

# the following tests rely upon the //gaspode/d directory's existence
set ::tcltest::testConfig(gaspodeExists) [expr {[catch {cd //gaspode/d}] == 0}]

test filename-16.12 {windows specific globbing} {pcOnly nonPortable gaspodeExists} {
    glob //gaspode/d/*Test
} //gaspode/d/globTest
test filename-16.13 {windows specific globbing} {pcOnly nonPortable gaspodeExists} {
    glob {\\\\gaspode\\d\\*Test}
} //gaspode/d/globTest

# cleanup
removeDirectory globTest
cd $temp
set env(HOME) $oldhome
testsetplatform $platform
catch {unset oldhome platform temp result}
::tcltest::cleanupTests
return








>
>
>
>
>
|
>
>
>
>
>





<
|
<
<
|
<
<
<
<
<
<


|







1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397

1398


1399






1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
test filename-16.10 {windows specific globbing} {pcOnly} {
    lsort [glob c:globTest\\\\*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.11 {windows specific globbing} {pcOnly} {
    lsort [glob c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}

test filename-16.12 {windows specific globbing} {pcOnly} {
    cd //[info hostname]/c
    removeDirectory globTest
    makeDirectory globTest
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]
    glob //[info hostname]/c/*Test
} //[info hostname]/c/globTest
test filename-16.13 {windows specific globbing} {pcOnly} {
    cd //[info hostname]/c
    removeDirectory globTest
    makeDirectory globTest
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]

    glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"


} //[info hostname]/c/globTest







# cleanup
file delete -force //[info hostname]/c/globTest
cd $temp
set env(HOME) $oldhome
testsetplatform $platform
catch {unset oldhome platform temp result}
::tcltest::cleanupTests
return

Changes to tests/platform.test.
12
13
14
15
16
17
18


19


20
21
22
23
24
25
26
# RCS: @(#) 

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test platform-1.1 {TclpSetVariables: tcl_platform} {


    lsort [array names tcl_platform]


} {byteOrder machine os osVersion platform user}

# cleanup
::tcltest::cleanupTests
return









>
>
|
>
>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# RCS: @(#) 

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    interp create i
    i eval {unset tcl_platform(debug)}
    set result [i eval {lsort [array names tcl_platform]}]
    interp delete i
    set result
} {byteOrder machine os osVersion platform user}

# cleanup
::tcltest::cleanupTests
return