OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [async.test] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  none
2 
#
3 
# This file contains a collection of tests for Tcl_AsyncCreate and related
4 
# library procedures.  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) 1993 The Regents of the University of California.
8 
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
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: async.test,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $
14 
 
15 
if {[info commands testasync] == {}} {
16 
    puts "This application hasn't been compiled with the \"testasync\""
17 
    puts "command, so I can't test Tcl_AsyncCreate et al."
18 
    return
19 
}
20 
 
21 
if {[string compare test [info procs test]] == 1} then {source defs}
22 
 
23 
proc async1 {result code} {
24 
    global aresult acode
25 
    set aresult $result
26 
    set acode $code
27 
    return "new result"
28 
}
29 
proc async2 {result code} {
30 
    global aresult acode
31 
    set aresult $result
32 
    set acode $code
33 
    return -code error "xyzzy"
34 
}
35 
proc async3 {result code} {
36 
    global aresult
37 
    set aresult "test pattern"
38 
    return -code $code $result
39 
}
40 
 
41 
set handler1 [testasync create async1]
42 
set handler2 [testasync create async2]
43 
set handler3 [testasync create async3]
44 
test async-1.1 {basic async handlers} {
45 
    set aresult xxx
46 
    set acode yyy
47 
    list [catch {testasync mark $handler1 "original" 0} msg] $msg \
48 
           $acode $aresult
49 
} {0 {new result} 0 original}
50 
test async-1.2 {basic async handlers} {
51 
    set aresult xxx
52 
    set acode yyy
53 
    list [catch {testasync mark $handler1 "original" 1} msg] $msg \
54 
           $acode $aresult
55 
} {0 {new result} 1 original}
56 
test async-1.3 {basic async handlers} {
57 
    set aresult xxx
58 
    set acode yyy
59 
    list [catch {testasync mark $handler2 "old" 0} msg] $msg \
60 
           $acode $aresult
61 
} {1 xyzzy 0 old}
62 
test async-1.4 {basic async handlers} {
63 
    set aresult xxx
64 
    set acode yyy
65 
    list [catch {testasync mark $handler2 "old" 3} msg] $msg \
66 
           $acode $aresult
67 
} {1 xyzzy 3 old}
68 
test async-1.5 {basic async handlers} {
69 
    set aresult xxx
70 
    list [catch {testasync mark $handler3 "foobar" 0} msg] $msg $aresult
71 
} {0 foobar {test pattern}}
72 
test async-1.6 {basic async handlers} {
73 
    set aresult xxx
74 
    list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult
75 
} {1 foobar {test pattern}}
76 
 
77 
proc mult1 {result code} {
78 
    global x
79 
    lappend x mult1
80 
    return -code 7 mult1
81 
}
82 
set hm1 [testasync create mult1]
83 
proc mult2 {result code} {
84 
    global x
85 
    lappend x mult2
86 
    return -code 9 mult2
87 
}
88 
set hm2 [testasync create mult2]
89 
proc mult3 {result code} {
90 
    global x hm1 hm2
91 
    lappend x [catch {testasync mark $hm2 serial2 0}]
92 
    lappend x [catch {testasync mark $hm1 serial1 0}]
93 
    lappend x mult3
94 
    return -code 11 mult3
95 
}
96 
set hm3 [testasync create mult3]
97 
 
98 
test async-2.1 {multiple handlers} {
99 
    set x {}
100 
    list [catch {testasync mark $hm3 "foobar" 5} msg] $msg $x
101 
} {9 mult2 {0 0 mult3 mult1 mult2}}
102 
 
103 
proc del1 {result code} {
104 
    global x hm1 hm2 hm3 hm4
105 
    lappend x [catch {testasync mark $hm3 serial2 0}]
106 
    lappend x [catch {testasync mark $hm1 serial1 0}]
107 
    lappend x [catch {testasync mark $hm4 serial1 0}]
108 
    testasync delete $hm1
109 
    testasync delete $hm2
110 
    testasync delete $hm3
111 
    lappend x del1
112 
    return -code 13 del1
113 
}
114 
proc del2 {result code} {
115 
    global x
116 
    lappend x del2
117 
    return -code 3 del2
118 
}
119 
testasync delete $handler1
120 
testasync delete $hm2
121 
testasync delete $hm3
122 
set hm2 [testasync create del1]
123 
set hm3 [testasync create mult2]
124 
set hm4 [testasync create del2]
125 
 
126 
test async-3.1 {deleting handlers} {
127 
    set x {}
128 
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
129 
} {3 del2 {0 0 0 del1 del2}}
130 
 
131 
testasync delete

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.