Posted to tcl by patthoyts at Thu Oct 01 00:05:42 GMT 2009view raw

  1. Index: tests/zlib.test
  2. ===================================================================
  3. RCS file: /cvsroot/tcl/tcl/tests/zlib.test,v
  4. retrieving revision 1.11
  5. diff -u -r1.11 zlib.test
  6. --- tests/zlib.test 10 Jul 2009 17:37:19 -0000 1.11
  7. +++ tests/zlib.test 13 Jul 2009 10:00:45 -0000
  8. @@ -458,7 +458,7 @@
  9. rename bgerror {}
  10. } -result {error {incorrect header check}}
  11.  
  12. -test zlib-10.1 "bug #2818131 (close with null interp)" -constraints {
  13. +test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
  14. zlib
  15. } -setup {
  16. proc bgerror {s} {set ::total [list error $s]}
  17. @@ -497,6 +497,80 @@
  18. rename bgerror {}
  19. } -returnCodes error \
  20. -result {bad event name "xyzzy": must be readable or writable}
  21. +test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
  22. + zlib
  23. +} -setup {
  24. + proc bgerror {s} {set ::total [list error $s]}
  25. + proc zlibRead {c} {
  26. + set d [read $c]
  27. + if {[eof $c]} {
  28. + chan event $c readable {}
  29. + close $c
  30. + set ::total [list eof [string length $d]]
  31. + }
  32. + }
  33. + set srv [socket -myaddr localhost -server {apply {{c a p} {
  34. + chan configure $c -translation binary -buffering none
  35. + zlib push inflate $c
  36. + chan event $c readable [list zlibRead $c]
  37. + }}} 0]
  38. +} -body {
  39. + lassign [chan configure $srv -sockname] addr name port
  40. + after 1000 {set ::total timeout}
  41. + set s [socket $addr $port]
  42. + chan configure $s -translation binary -buffering none
  43. + zlib push gzip $s
  44. + chan event $s readable [list zlibRead $s]
  45. + after idle [list apply {{s} {
  46. + puts $s test
  47. + chan close $s
  48. + after 100 {set ::total done}
  49. + }} $s]
  50. + vwait ::total
  51. + set ::total
  52. +} -cleanup {
  53. + close $srv
  54. + rename bgerror {}
  55. + rename zlibRead {}
  56. +} -result {error {invalid block type}}
  57. +test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
  58. + zlib
  59. +} -setup {
  60. + proc bgerror {s} {set ::total [list error $s]}
  61. + proc zlibRead {c} {
  62. + if {[gets $c line] < 0} {
  63. + close $c
  64. + set ::total [list error -1]
  65. + } elseif {[eof $c]} {
  66. + chan event $c readable {}
  67. + close $c
  68. + set ::total [list eof [string length $d]]
  69. + }
  70. + }
  71. + set srv [socket -myaddr localhost -server {apply {{c a p} {
  72. + chan configure $c -translation binary -buffering none
  73. + zlib push inflate $c
  74. + chan event $c readable [list zlibRead $c]
  75. + }}} 0]
  76. +} -body {
  77. + lassign [chan configure $srv -sockname] addr name port
  78. + after 1000 {set ::total timeout}
  79. + set s [socket $addr $port]
  80. + chan configure $s -translation binary -buffering none
  81. + zlib push gzip $s
  82. + chan event $s readable [list zlibRead $s]
  83. + after idle [list apply {{s} {
  84. + puts $s test
  85. + chan close $s
  86. + after 100 {set ::total done}
  87. + }} $s]
  88. + vwait ::total
  89. + set ::total
  90. +} -cleanup {
  91. + close $srv
  92. + rename bgerror {}
  93. + rename zlibRead {}
  94. +} -result {error {invalid block type}}
  95.  
  96. ::tcltest::cleanupTests
  97. return