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