Tcl Source Code

Check-in [286eddfbe6]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[4e5007ea1b285527] Added all code path tests for ::http::formatQuery.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-452
Files: files | file ages | folders
SHA1: 286eddfbe6c81a2d06354c2f45b3fdf8d0ba4036
User & Date: gerald 2017-06-19 22:21:36
Original Comment: Added all code path tests for ::http::formatQuery.

Fixed bug [4e5007ea1b2855277b349964ef1512ad884edace (6970)] on formatQuery.

Context
2017-06-19
22:45
Fix for [c81183a2a71adeff28d846b5dcf8ca5bb15bbf30]. check-in: 52264f7439 user: gerald tags: tip-452
22:21
[4e5007ea1b285527] Added all code path tests for ::http::formatQuery. check-in: 286eddfbe6 user: gerald tags: tip-452
21:40
Test complete for http::geturl -- all code paths covered.

Also fix for tcloo code in TIP 452. check-in: b8e209a539 user: gerald tags: tip-452

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/http/http.tcl.

1415
1416
1417
1418
1419
1420
1421






1422
1423
1424
1425
1426
1427
1428
# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {






    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {






>
>
>
>
>
>







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {
    if {[llength $args] % 2} {
        return \
            -code error \
            -errorcode [list HTTP BADARGCNT $args] \
            {Incorrect number of arguments, must be an even number.}
    }
    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {

Changes to tests/http-tip-452.test.

1902
1903
1904
1905
1906
1907
1908
1909
1910





1911




1912
1913
1914


1915
1916
1917
1918
1919


































































1920
1921
1922
1923
1924
1925
1926
    -result {1 TestError {::after,count 0 ::fileevent,count 1 ::http::cleanup,count 1 ::http::Finish,count 0 ::http::reset,count 1 ::http::wait,count 1 ::socket,count 1}}



##
## Test http::formatQuery
##
::tcltest::test http-3.1 {http::formatQuery}  \
    -setup {










    } \
    -body {
        list Test Not Yet Implemented


    } \
    -cleanup {
        ::tcltest::testCleanup
    } \
    -result {}




































































##
## Test http::reset
##

##






|

>
>
>
>
>
|
>
>
>
>


<
>
>




|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922

1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
    -result {1 TestError {::after,count 0 ::fileevent,count 1 ::http::cleanup,count 1 ::http::Finish,count 0 ::http::reset,count 1 ::http::wait,count 1 ::socket,count 1}}



##
## Test http::formatQuery
##
::tcltest::test http-3.1 {http::formatQuery -- no arguments}  \
    -setup {
        ::tcltest::testSetup {
            ::http::mapReply {
                * {
                    use {
                        prefix {return}
                    }
                    code {ok}
                }
            }
        }
    } \
    -body {

        set status [catch {::http::formatQuery} result]
        list $status $result
    } \
    -cleanup {
        ::tcltest::testCleanup
    } \
    -result {0 {}}

::tcltest::test http-3.2 {http::formatQuery -- one set arguments}  \
    -setup {
        ::tcltest::testSetup {
            ::http::mapReply {
                * {
                    use {
                        prefix {return}
                    }
                    code {ok}
                }
            }
        }
    } \
    -body {
        set status [catch {::http::formatQuery arg1 val1} result]
        list $status $result
    } \
    -cleanup {
        ::tcltest::testCleanup
    } \
    -result {0 arg1=val1}

::tcltest::test http-3.3 {http::formatQuery -- two set arguments}  \
    -setup {
        ::tcltest::testSetup {
            ::http::mapReply {
                * {
                    use {
                        prefix {return}
                    }
                    code {ok}
                }
            }
        }
    } \
    -body {
        set status [catch {::http::formatQuery arg1 val1 arg2 val2} result]
        list $status $result
    } \
    -cleanup {
        ::tcltest::testCleanup
    } \
    -result {0 arg1=val1&arg2=val2}

::tcltest::test http-3.4 {http::formatQuery -- odd set arguments (Ticket: 4e5007ea1b2855277b349964ef1512ad884edace (6970))}  \
    -setup {
        ::tcltest::testSetup {
            ::http::mapReply {
                * {
                    use {
                        prefix {return}
                    }
                    code {ok}
                }
            }
        }
    } \
    -body {
        set status [catch {::http::formatQuery arg1 val1 arg2} result]
        list $status $result
    } \
    -cleanup {
        ::tcltest::testCleanup
    } \
    -result {1 {Incorrect number of arguments, must be an even number.}}


##
## Test http::reset
##

##