wibble test

Function wibble::getblock hangs tcl under cetrain conditions, when using Internet Explorer 8. For a discussion on this see http://wiki.tcl.tk/23626

To figure out whether this is a wibble or a tcl bug, the problem can be reproduced with the following: 

Put the html code into a file 'wibble_test.html' in wibble's root directory:

<html>
<head>
<script>
ajax = function (url,f,p,m) {
  // f=callback, m=method (GET|POST), p=post data
  var req = null; 
  if (window.XMLHttpRequest) {
	req = new XMLHttpRequest();
	if (req.overrideMimeType) {
	  req.overrideMimeType('application/jsonrequest');
	}
  } else if (window.ActiveXObject) {
	try {
	  req = new ActiveXObject("Msxml2.XMLHTTP");
	} catch (e)	{
	  try {
		req = new ActiveXObject("Microsoft.XMLHTTP");
	  } catch (e) {}
	}
  }
  req.onreadystatechange = function() { 
	if(req.readyState == 4)	{
	  if(req.status == 200 || req.status == 304)	{
		f(req.responseText);
	  } else {
		//alert("Error: returned status code " + req.status + " " + req.statusText);
	  }	
	} 
  }; 
  req.open((m?m:"GET"), url, true);
  if (m) {
	req.setRequestHeader("Content-type", "application/x-www-form-urlencoded'; charset=utf-8'");
  }
  req.send(p); 
};
gotReply = function (h) {
  var el=document.createElement("p");
  el.innerHTML = h;
  element.parentNode.appendChild(el);
};
askWibble = function (el) {
  element = el;
  ajax("/test",gotReply,encodeURI("a=this&b=is&c=a&d=test"),"POST");
  el=document.createElement("p");
  el.innerHTML = "asking wibble...<br/>";
  element.parentNode.appendChild(el);
};
</script>						 
</head>
<body>
<input type='button' value='Press this' onclick='askWibble(this)'/>
</body>
</html>


Replace wibble::getblock with:

proc ::wibble::getblock {chan size} {
  puts stderr size=$size
  while {1} {
    set chunklet [chan read $chan $size]
    puts stderr "{$size - [string length $chunklet]}"
    set size [expr {$size - [string length $chunklet]}]
    append chunk $chunklet
    if {$size == 0} {
      puts stderr "return size==0"
      return $chunk
    } elseif {[chan eof $chan]} {
      chan close $chan
      puts stderr "return eof"
      return -level [info level]
    } else {
      puts stderr "before yield"
      yield
      puts stderr "after yield"
    }
  }
}


Add test zone proc 'mytest':

proc ::mytest {request response} {
  dict set response content "<tt style='color:#080'>This is Wibble. Ask me more!</tt>"
  dict set response header content-type text/html
  dict set response status "200 ok"
  ::wibble::sendresponse $response
}


Add test zone handler 

...
    # Define zone handlers.

    # Add test zone handler.
    wibble::handle /test ::mytest

    wibble::handle /vars vars
...

Run wibble and direct IE8 (only Internet Explorer has the problem) to:
http://localhost:8080/wibble_test.html

Tcl hangs with 100% CPU load.