# Commands covered:  none

 #

 # This file contains a collection of tests for Tcl_AsyncCreate and related

 # library procedures.  Sourcing this file into Tcl runs the tests and

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

 #

 # Copyright (c) 1993 The Regents of the University of California.

 # Copyright (c) 1994-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: async.test,v 1.5 2000/04/10 17:18:56 ericm Exp $

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

     package require tcltest

     namespace import -force ::tcltest::*

 }

 if {[info commands testasync] == {}} {

     puts "This application hasn't been compiled with the \"testasync\""

     puts "command, so I can't test Tcl_AsyncCreate et al."

     ::tcltest::cleanupTests

     return

 }

 proc async1 {result code} {

     global aresult acode

     set aresult $result

     set acode $code

     return "new result"

 }

 proc async2 {result code} {

     global aresult acode

     set aresult $result

     set acode $code

     return -code error "xyzzy"

 }

 proc async3 {result code} {

     global aresult

     set aresult "test pattern"

     return -code $code $result

 }

 set handler1 [testasync create async1]

 set handler2 [testasync create async2]

 set handler3 [testasync create async3]

 test async-1.1 {basic async handlers} {

     set aresult xxx

     set acode yyy

     list [catch {testasync mark $handler1 "original" 0} msg] $msg \

 	   $acode $aresult

 } {0 {new result} 0 original}

 test async-1.2 {basic async handlers} {

     set aresult xxx

     set acode yyy

     list [catch {testasync mark $handler1 "original" 1} msg] $msg \

 	   $acode $aresult

 } {0 {new result} 1 original}

 test async-1.3 {basic async handlers} {

     set aresult xxx

     set acode yyy

     list [catch {testasync mark $handler2 "old" 0} msg] $msg \

 	   $acode $aresult

 } {1 xyzzy 0 old}

 test async-1.4 {basic async handlers} {

     set aresult xxx

     set acode yyy

     list [catch {testasync mark $handler2 "old" 3} msg] $msg \

 	   $acode $aresult

 } {1 xyzzy 3 old}

 test async-1.5 {basic async handlers} {

     set aresult xxx

     list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult

 } {0 foobar {test pattern}}

 test async-1.6 {basic async handlers} {

     set aresult xxx

     list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult

 } {1 foobar {test pattern}}

 proc mult1 {result code} {

     global x

     lappend x mult1

     return -code 7 mult1

 }

 set hm1 [testasync create mult1]

 proc mult2 {result code} {

     global x

     lappend x mult2

     return -code 9 mult2

 }

 set hm2 [testasync create mult2]

 proc mult3 {result code} {

     global x hm1 hm2

     lappend x [catch {testasync mark $hm2 serial2 0}]

     lappend x [catch {testasync mark $hm1 serial1 0}]

     lappend x mult3

     return -code 11 mult3

 }

 set hm3 [testasync create mult3]

 test async-2.1 {multiple handlers} {

     set x {}

     list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x

 } {9 mult2 {0 0 mult3 mult1 mult2}}

 proc del1 {result code} {

     global x hm1 hm2 hm3 hm4

     lappend x [catch {testasync mark $hm3 serial2 0}]

     lappend x [catch {testasync mark $hm1 serial1 0}]

     lappend x [catch {testasync mark $hm4 serial1 0}]

     testasync delete $hm1

     testasync delete $hm2

     testasync delete $hm3

     lappend x del1

     return -code 13 del1

 }

 proc del2 {result code} {

     global x

     lappend x del2

     return -code 3 del2

 }

 testasync delete $handler1

 testasync delete $hm2

 testasync delete $hm3

 set hm2 [testasync create del1]

 set hm3 [testasync create mult2]

 set hm4 [testasync create del2]

 test async-3.1 {deleting handlers} {

     set x {}

     list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x

 } {3 del2 {0 0 0 del1 del2}}

 # cleanup

 testasync delete

 ::tcltest::cleanupTests

 return