1# soapinteropB.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
2#
3# SOAP Interoperability Lab "Round 2" Proposal B Client Tests
4#
5# See http://www.whitemesa.com/interop.htm for details.
6#
7# -------------------------------------------------------------------------
8# This software is distributed in the hope that it will be useful, but
9# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10# or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
11# for more details.
12# -------------------------------------------------------------------------
13#
14# @(#)$Id: soapinteropB.tcl,v 1.4 2002/08/20 00:38:00 patthoyts Exp $
15
16package require -exact soapinterop::base 1.0
17package provide soapinterop::B 1.0
18
19namespace eval soapinterop {
20
21    rpcvar::typedef -namespace http://soapinterop.org/xsd { \
22	    varString string \
23	    varInt    int \
24	    varFloat  float \
25	    varStruct SOAPStruct } SOAPStructStruct
26
27    rpcvar::typedef -namespace http://soapinterop.org/xsd \
28	    string() Arrayofstring
29
30    # FIX ME
31    rpcvar::typedef -namespace http://soapinterop.org/xsd \
32	    string()() ArrayOfString2D
33
34    rpcvar::typedef -namespace http://soapinterop.org/xsd { \
35	    varString string \
36	    varInt    int \
37	    varFloat  float \
38	    varArray  Arrayofstring } SOAPArrayStruct
39}
40
41# -------------------------------------------------------------------------
42
43# Proposal B Methods
44proc soapinterop::create:proposalB {proxy args} {
45    variable action
46    variable uri
47
48    set action http://soapinterop.org/
49
50    SOAP::create echoStructAsSimpleTypes -proxy $proxy -uri $uri \
51	-action $action -params {inputStruct SOAPStruct}
52    SOAP::create echoSimpleTypesAsStruct -proxy $proxy -uri $uri \
53	-action $action \
54	-params {inputString string inputInteger int inputFloat float}
55    SOAP::create echo2DStringArray -proxy $proxy -uri $uri \
56	-action $action -params {input2DStringArray ArrayOfString2D}
57    SOAP::create echoNestedStruct -proxy $proxy -uri $uri -action $action \
58	-params {inputStruct SOAPStructStruct}
59    SOAP::create echoNestedArray -proxy $proxy -uri $uri -action $action \
60	-params {inputStruct SOAPArrayStruct}
61
62    if {$args != {}} {
63        foreach method [list echoStructAsSimpleTypes \
64                            echoSimpleTypesAsStruct\
65                            echo2DStringArray \
66                            echoNestedStruct \
67                            echoNestedArray] {
68           eval SOAP::configure $method $args
69       }
70    }
71}
72
73# -------------------------------------------------------------------------
74
75proc soapinterop::round2:proposalB {proxy args} {
76    if {$proxy != {}} {
77        eval create:proposalB [list $proxy] $args
78    }
79
80    catch {validate.echoStructAsSimpleTypes} msg ; puts "$msg"
81    catch {validate.echoSimpleTypesAsStruct} msg ; puts "$msg"
82    catch {validate.echoNestedArray} msg         ; puts "$msg"
83    catch {validate.echoNestedStruct} msg        ; puts "$msg"
84    catch {validate.echo2DStringArray} msg       ; puts "$msg"
85}
86
87# -------------------------------------------------------------------------
88
89# Description:
90#  Returns the struct parts individually.
91#  We check that each member value was returned (we cannot assume a
92#  particular order.
93#
94proc soapinterop::validate.echoStructAsSimpleTypes {} {
95    array set q [list varString [rand_string] \
96                     varInt    [rand_int] \
97                     varFloat  [rand_float]]
98    set r [echoStructAsSimpleTypes [array get q]]
99
100    foreach {n e} [array get q] {
101        if {[lsearch -exact $r $e] == -1} {
102            error "failed: member $n not found in \"$r\""
103        }
104    }
105    return "echoStructAsSimpleTypes"
106}
107
108# -------------------------------------------------------------------------
109
110proc soapinterop::validate.echoSimpleTypesAsStruct {} {
111    set s [rand_string]
112    set i [rand_int]
113    set f [rand_float]
114    array set r [echoSimpleTypesAsStruct $s $i $f]
115    if {[catch {validateSOAPStruct [array get q] [array get r]} err]} {
116        error "echoSimpleTypesAsStruct $err"
117    }
118    return "echoSimpleTypesAsStruct"
119}
120
121# -------------------------------------------------------------------------
122
123proc soapinterop::validate.echoNestedStruct {} {
124    array set q [list \
125                     varString [rand_string] \
126                     varFloat [rand_float] \
127                     varInt [rand_int] \
128                     varStruct [list \
129                                    varString [rand_string]\
130                                    varInt [rand_int]\
131                                    varFloat [rand_float]]]
132    array set r [echoNestedStruct [array get q]]
133    if {[catch {validateSOAPStruct [array get q] [array get r]} err]} {
134        error "echoNestedStruct $err"
135    }
136    array set aq $q(varStruct)
137    array set ar $r(varStruct)
138    if {[catch {validateSOAPStruct [array get aq] [array get ar]} err]} {
139        error "echoNestedStruct substruct $err"
140    }
141    return "echoNestedStruct"
142}
143
144# -------------------------------------------------------------------------
145
146proc soapinterop::validate.echoNestedArray {} {
147    array set q [list \
148                     varString [rand_string] \
149                     varFloat [rand_float] \
150                     varInt [rand_int] \
151                     varArray [list red green blue]]
152    array set r [echoNestedArray [array get q]]
153    if {[catch {validateSOAPStruct [array get q] [array get r]} err]} {
154        error "echoNestedArray $err"
155    }
156    if {[llength $r(varArray)] != [llength $q(varArray)]} {
157        error "echoNestedArray failed: lists are different:\
158                $q(varArray) != $r(varArray)"
159    }
160    set max [llength $q(varArray)]
161    for {set n 0} {$n < $max} {incr n} {
162	if {! [string match [lindex $q(varArray) $n] [lindex $r(varArray) $n]]} {
163	    error "echoNestedArray failed: element $n is different:\
164                   $q(varArray) != $r(varArray)"
165	}
166    }
167    return "echoNestedArray"
168}
169
170# -------------------------------------------------------------------------
171
172proc soapinterop::validate.echo2DStringArray {} {
173    set q [list r0c0 r0c1 r0c2 r1c0 r1c1 r1c2]
174    return -code error "echo2DStringArray not implemented"
175}
176
177# -------------------------------------------------------------------------
178#
179# Local variables:
180#   mode: tcl
181#   indent-tabs-mode: nil
182# End:
183