--- AnyEvent/lib/AnyEvent/Strict.pm	2010/02/21 09:28:19	1.20
+++ AnyEvent/lib/AnyEvent/Strict.pm	2011/09/02 04:35:03	1.35
@@ -13,58 +13,120 @@
 
 Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the
 expense of being slower (often the argument checking takes longer than the
-actual function).
+actual function). It also wraps all callbacks to check for modifications
+of C<$_>, which indicates a programming bug inside the watcher callback.
 
 Normally, you don't load this module yourself but instead use it
 indirectly via the C<PERL_ANYEVENT_STRICT> environment variable (see
-L<AnyEvent>). However, this module can be loaded at any time.
+L<AnyEvent>). However, this module can be loaded manually at any time.
 
 =cut
 
 package AnyEvent::Strict;
 
 use Carp qw(croak);
+use Errno ();
+use POSIX ();
 
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
 
-our @ISA;
+AnyEvent::_isa_hook 1 => "AnyEvent::Strict", 1;
 
-AnyEvent::post_detect {
-   # assume the first ISA member is the implementation
-   # # and link us in before it in the chain.
-   my $MODEL = shift @AnyEvent::ISA;
-   unshift @ISA, $MODEL;
-   unshift @AnyEvent::ISA, AnyEvent::Strict::
+BEGIN {
+   if (defined &Internals::SvREADONLY) {
+      # readonly available (at least 5.8.9+, working better in 5.10.1+)
+      *wrap = sub {
+         my $cb = shift;
+
+         sub {
+            Internals::SvREADONLY $_, 1;
+            &$cb;
+            Internals::SvREADONLY $_, 0;
+         }
+      };
+   } else {
+      # or not :/
+      my $magic = []; # a unique magic value
+
+      *wrap = sub {
+         my $cb = shift;
+
+         sub {
+            local $_ = $magic;
+
+            &$cb;
+
+            if (!ref $_ || $_ != $magic) {
+               require AnyEvent::Debug;
+               die "callback $cb (" . AnyEvent::Debug::cb2str ($cb) . ") modified \$_ without restoring it.\n";
+            }
+         }
+      };
+   }
+}
+
+our (@FD_INUSE, $FD_I);
+our $FD_CHECK_W = AE::timer 4, 4, sub {
+   my $cnt = (@FD_INUSE < 100 * 10 ? int @FD_INUSE * 0.1 : 100) || 10;
+
+   if ($FD_I <= 0) {
+      #pop @FD_INUSE while @FD_INUSE && !$FD_INUSE[-1];
+      ($FD_I = @FD_INUSE) >= 0
+         or return; # empty
+   }
+
+   $cnt = $FD_I if $cnt > $FD_I;
+
+   eval {
+      do {
+         !$FD_INUSE[--$FD_I]
+            or (POSIX::lseek $FD_I, 0, 1) != -1
+            or $! != Errno::EBADF
+            or die;
+      } while --$cnt;
+      1
+   } or AE::log crit => "file descriptor $FD_I registered with AnyEvent but prematurely closed, event loop might malfunction.\n";
 };
 
 sub io {
    my $class = shift;
-   my %arg = @_;
+   my (%arg, $fh, $cb, $fd) = @_;
 
    ref $arg{cb}
       or croak "AnyEvent->io called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   $cb = wrap delete $arg{cb};
  
    $arg{poll} =~ /^[rw]$/
       or croak "AnyEvent->io called with illegal poll argument '$arg{poll}'";
 
-   if (defined fileno $arg{fh} or ref $arg{fh} or $arg{fh} !~ /^\s*\d+\s*$/) {
-      defined fileno $arg{fh}
-         or croak "AnyEvent->io called with illegal fh argument '$arg{fh}'";
+   $fh = delete $arg{fh};
+
+   if ($fh =~ /^\s*\d+\s*$/) {
+      $fd = $fh;
+      $fh = AnyEvent::_dupfh $arg{poll}, $fh;
    } else {
-      $arg{fh} = AnyEvent::_dupfh $arg{poll}, $arg{fh};
+      defined eval { $fd = fileno $fh }
+         or croak "AnyEvent->io called with illegal fh argument '$fh'";
    }
 
-   -f $arg{fh}
+   -f $fh
       and croak "AnyEvent->io called with fh argument pointing to a file";
 
    delete $arg{poll};
-   delete $arg{fh};
  
    croak "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::io (@_)
+   ++$FD_INUSE[$fd];
+
+   bless [
+      $fd,
+      $class->SUPER::io (@_, cb => $cb)
+   ], "AnyEvent::Strict::io";
+}
+
+sub AnyEvent::Strict::io::DESTROY {
+   --$FD_INUSE[$_[0][0]];
 }
 
 sub timer {
@@ -73,7 +135,7 @@
 
    ref $arg{cb}
       or croak "AnyEvent->timer called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   my $cb = wrap delete $arg{cb};
  
    exists $arg{after}
       or croak "AnyEvent->timer called without mandatory 'after' parameter";
@@ -86,7 +148,7 @@
    croak "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::timer (@_)
+   $class->SUPER::timer (@_, cb => $cb)
 }
 
 sub signal {
@@ -95,7 +157,7 @@
 
    ref $arg{cb}
       or croak "AnyEvent->signal called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   my $cb = wrap delete $arg{cb};
  
    defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0
       or croak "AnyEvent->signal called with illegal signal name '$arg{signal}'";
@@ -104,7 +166,7 @@
    croak "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::signal (@_)
+   $class->SUPER::signal (@_, cb => $cb)
 }
 
 sub child {
@@ -113,7 +175,7 @@
 
    ref $arg{cb}
       or croak "AnyEvent->child called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   my $cb = wrap delete $arg{cb};
  
    $arg{pid} =~ /^-?\d+$/
       or croak "AnyEvent->child called with malformed pid value '$arg{pid}'";
@@ -122,7 +184,7 @@
    croak "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::child (@_)
+   $class->SUPER::child (@_, cb => $cb)
 }
 
 sub idle {
@@ -131,12 +193,12 @@
 
    ref $arg{cb}
       or croak "AnyEvent->idle called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   my $cb = wrap delete $arg{cb};
  
    croak "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::idle (@_)
+   $class->SUPER::idle (@_, cb => $cb)
 }
 
 sub condvar {
@@ -145,12 +207,12 @@
 
    !exists $arg{cb} or ref $arg{cb}
       or croak "AnyEvent->condvar called with illegal cb argument '$arg{cb}'";
-   delete $arg{cb};
+   my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : ();
  
    croak "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg
       if keys %arg;
 
-   $class->SUPER::condvar (@_)
+   $class->SUPER::condvar (@cb);
 }
 
 sub time {