Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixNotfy.test@bde4ae8d615e

     1 # This file contains tests for tclUnixNotfy.c.

2 #

     3 # This file contains a collection of tests for one or more of the Tcl

     4 # built-in commands.  Sourcing this file into Tcl runs the tests and

     5 # generates output for errors.  No output means no errors were found.

6 #

     7 # Copyright (c) 1997 by Sun Microsystems, Inc.

     8 # Copyright (c) 1998-1999 by Scriptics Corporation.

9 #

    10 # See the file "license.terms" for information on usage and redistribution

    11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    12 #

    13 # RCS: @(#) $Id: unixNotfy.test,v 1.11.2.4 2005/05/14 20:52:31 das Exp $

    15 # The tests should not be run if you have a notifier which is unable to

    16 # detect infinite vwaits, as the tests below will hang. The presence of

    17 # the "testthread" command indicates that this is the case.

    19 if {[lsearch [namespace children] ::tcltest] == -1} {

    20     package require tcltest 2

    21     namespace import -force ::tcltest::*

    22 }

    24 if {[info exists tk_version]} {

    25     puts "When run in a Tk shell, these tests run hang.  Skipping tests ..."

    26     ::tcltest::cleanupTests

    27     return

    28 }

    30 set ::tcltest::testConstraints(testthread) \

    31 	[expr {[info commands testthread] != {}}]

    32 # Darwin always uses a threaded notifier

    33 testConstraint unthreaded [expr {

    34     (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded))

    35     && $tcl_platform(os) ne "Darwin"

    36 }]

    38 # The next two tests will hang if threads are enabled because the notifier

    39 # will not necessarily wait for ever in this case, so it does not generate

    40 # an error.

    42 test unixNotfy-1.1 {Tcl_DeleteFileHandler} \

    43     -constraints {unixOnly && unthreaded} \

    44     -body {

    45 	catch {vwait x}

    46 	set f [open [makeFile "" foo] w]

    47 	fileevent $f writable {set x 1}

    48 	vwait x

    49 	close $f

    50 	list [catch {vwait x} msg] $msg

    51     } \

    52     -result {1 {can't wait for variable "x":  would wait forever}} \

    53     -cleanup {

    54 	catch { close $f }

    55 	catch { removeFile foo }

    56     }

    58 test unixNotfy-1.2 {Tcl_DeleteFileHandler} \

    59     -constraints {unixOnly && unthreaded} \

    60     -body {

    61 	catch {vwait x}

    62 	set f1 [open [makeFile "" foo] w]

    63 	set f2 [open [makeFile "" foo2] w]

    64 	fileevent $f1 writable {set x 1}

    65 	fileevent $f2 writable {set y 1}

    66 	vwait x

    67 	close $f1

    68 	vwait y

    69 	close $f2

    70 	list [catch {vwait x} msg] $msg

    71     } \

    72     -result {1 {can't wait for variable "x":  would wait forever}} \

    73     -cleanup {

    74 	catch { close $f1 }

    75 	catch { close $f2 }

    76 	catch { removeFile foo }

    77 	catch { removeFile foo2 }

    78     }

    80 test unixNotfy-2.1 {Tcl_DeleteFileHandler} \

    81     -constraints {unixOnly testthread} \

    82     -body {

    83 	update

    84 	set f [open [makeFile "" foo] w]

    85 	fileevent $f writable {set x 1}

    86 	vwait x

    87 	close $f

    88 	testthread create "testthread send [testthread id] {set x ok}"

    89 	vwait x

    90 	threadReap

    91 	set x

    92     } \

    93     -result {ok} \

    94     -cleanup {

    95 	catch { close $f }

    96 	catch { removeFile foo }

    97     }

    99 test unixNotfy-2.2 {Tcl_DeleteFileHandler} \

   100     -constraints {unixOnly testthread} \

   101     -body {

   102 	update

   103 	set f1 [open [makeFile "" foo] w]

   104 	set f2 [open [makeFile "" foo2] w]

   105 	fileevent $f1 writable {set x 1}

   106 	fileevent $f2 writable {set y 1}

   107 	vwait x

   108 	close $f1

   109 	vwait y

   110 	close $f2

   111 	testthread create "testthread send [testthread id] {set x ok}"

   112 	vwait x

   113 	threadReap

   114 	set x

   115     } \

   116     -result {ok} \

   117     -cleanup {

   118 	catch { close $f1 }

   119 	catch { close $f2 }

   120 	catch { removeFile foo }

   121 	catch { removeFile foo2 }

   122     }

   124 # cleanup

   125 ::tcltest::cleanupTests

   126 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--