Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Rework constraint detection and add constraints that cater for the fact, that both address families might be available, but localhost only resolves to one of the loopback addreses. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
86730a63b23d96a559dd174b15223797 |
| User & Date: | max 2011-06-28 15:43:30 |
Context
|
2011-07-02
| ||
| 22:21 | Dummy merge from rmax's commit for TCL_STACK_GROWS_UP, to avoid merge conflicts on the next merge. check-in: 923e63eeee user: kbk tags: trunk | |
|
2011-06-28
| ||
| 15:43 | Rework constraint detection and add constraints that cater for the fact, that both address families ... check-in: 86730a63b2 user: max tags: trunk | |
| 14:42 | replace socket-14.3 with a test that is more useful and less likely to randomly fail depending on th... check-in: 2eb58b2d67 user: max tags: trunk | |
Changes
Changes to tests/socket.test.
| ︙ | ︙ | |||
111 112 113 114 115 116 117 118 119 120 121 122 123 124 |
if 0 {
# activate this to time the tests
proc test {args} {
set name [lindex $args 0]
puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name"
}
}
foreach {af localhost} {
any 127.0.0.1
inet 127.0.0.1
inet6 ::1
} {
set ::tcl::unsupported::socketAF $af
| > > > > > > > > > > > > > > > > > < < < < | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
if 0 {
# activate this to time the tests
proc test {args} {
set name [lindex $args 0]
puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name"
}
}
foreach {af localhost} {
inet 127.0.0.1
inet6 ::1
} {
# Check if the family is supported and set the constraint accordingly
testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}]
catch {close $sock}
}
testConstraint supported_any [expr {[testConstraint supported_inet] || [testConstraint supported_inet6]}]
set sock [socket -server foo -myaddr localhost 0]
set sockname [fconfigure $sock -sockname]
close $sock
testConstraint localhost_v4 [expr {"127.0.0.1" in $sockname}]
testConstraint localhost_v6 [expr {"::1" in $sockname}]
foreach {af localhost} {
any 127.0.0.1
inet 127.0.0.1
inet6 ::1
} {
set ::tcl::unsupported::socketAF $af
#
# Check if we're supposed to do tests against the remote server
#
set doTestsWithRemoteServer 1
if {![info exists remoteServerIP]} {
set remoteServerIP $localhost
|
| ︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 |
catch {sendCommand exit}
}
catch {close $commandSocket}
catch {close $remoteProcChan}
}
unset ::tcl::unsupported::socketAF
test socket-14.0 {[socket -async] when server only listens on IPv4} \
| | | 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 |
catch {sendCommand exit}
}
catch {close $commandSocket}
catch {close $remoteProcChan}
}
unset ::tcl::unsupported::socketAF
test socket-14.0 {[socket -async] when server only listens on IPv4} \
-constraints [list socket supported_any localhost_v4] \
-setup {
proc accept {s a p} {
global x
puts $s bye
close $s
set x ok
}
|
| ︙ | ︙ | |||
1745 1746 1747 1748 1749 1750 1751 |
-setup {
proc accept {s a p} {
global x
puts $s bye
close $s
lappend x ok
}
| | | 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 |
-setup {
proc accept {s a p} {
global x
puts $s bye
close $s
lappend x ok
}
set server [socket -server accept -myaddr localhost 0]
set port [lindex [fconfigure $server -sockname] 2]
set x ""
} -body {
set client [socket -async localhost $port]
fileevent $client writable {
lappend x [fconfigure $client -error]
}
|
| ︙ | ︙ | |||
1781 1782 1783 1784 1785 1786 1787 |
set x
} -cleanup {
after cancel $after
close $client
unset x
} -result "connection refused"
test socket-14.3 {[socket -async] when server only listens on IPv6} \
| | | 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 |
set x
} -cleanup {
after cancel $after
close $client
unset x
} -result "connection refused"
test socket-14.3 {[socket -async] when server only listens on IPv6} \
-constraints [list socket supported_any localhost_v6] \
-setup {
proc accept {s a p} {
global x
puts $s bye
close $s
set x ok
}
|
| ︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 |
test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
-constraints [list socket supported_any] \
-setup {
proc accept {s a p} {
puts $s bye
close $s
}
| | | 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 |
test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
-constraints [list socket supported_any] \
-setup {
proc accept {s a p} {
puts $s bye
close $s
}
set server [socket -server accept -myaddr localhost 0]
set port [lindex [fconfigure $server -sockname] 2]
set x ""
} -body {
set client [socket -async localhost $port]
fileevent $client writable {
lappend x [fconfigure $client -error]
fileevent $client writable {}
|
| ︙ | ︙ | |||
1832 1833 1834 1835 1836 1837 1838 |
after cancel $after
close $client
close $server
} -result {{} bye}
test socket-14.5 {[socket -async] which fails before any connect() can be made} \
-constraints [list socket supported_any] \
-body {
| | | 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 |
after cancel $after
close $client
close $server
} -result {{} bye}
test socket-14.5 {[socket -async] which fails before any connect() can be made} \
-constraints [list socket supported_any] \
-body {
# address from rfc5737
socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
} \
-returnCodes 1 \
-result {couldn't open socket: cannot assign requested address}
::tcltest::cleanupTests
flush stdout
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:
|