----- Forwarded message from [EMAIL PROTECTED] -----
Date: Fri, 3 Mar 2000 21:14:14 +0100
Subject: CPAN Upload: JPRIT/Event-0.71.tar.gz
From: [EMAIL PROTECTED]
To: [EMAIL PROTECTED],
[EMAIL PROTECTED]
The uploaded file
Event-0.71.tar.gz
has entered CPAN as
file: $CPAN/authors/id/JPRIT/Event-0.71.tar.gz
size: 146137 bytes
md5: 5c54abe9dde36e897ab55a9dda348e48
No action is required on your part
Request entered by: JPRIT (Joshua N. Pritikin)
Request entered on: Fri, 03 Mar 2000 20:13:40 GMT
Request completed: Fri, 03 Mar 2000 20:14:14 GMT
Virtually Yours,
Id: paused,v 1.68 1999/10/22 14:39:12 k Exp k
----- End forwarded message -----
# This is a patch for Event-0.70 to update it to Event-0.71
#
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# If you have a decent Bourne-type shell:
# STEP 2: Run the shell with this file as input.
# If you don't have such a shell, you may need to manually create/delete
# the files as shown below.
# STEP 3: Run the 'patch' program with this file as input.
#
# These are the commands needed to create/delete files/directories:
#
rm -f 'lib/Event/semaphore.pm'
rm -f 'lib/Event/msg.pm'
touch 'Tutorial.pdf'
chmod 0444 'Tutorial.pdf'
touch 'demo/msg.pm'
chmod 0444 'demo/msg.pm'
touch 'demo/semaphore.pm'
chmod 0444 'demo/semaphore.pm'
#
# This command terminates the shell and need not be executed manually.
exit
#
#### End of Preamble ####
#### Patch data follows ####
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/ChangeLog'
'/usr/tmp/mp15690.d/new/Event-0.71/ChangeLog'
Index: ./ChangeLog
--- ./ChangeLog Fri Feb 25 12:09:13 2000
+++ ./ChangeLog Fri Mar 3 15:10:13 2000
@@ -1,3 +1,21 @@
+2000-03-03 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Release 0.71.
+
+ * Moved LoopLevel & ExitLevel from Perl to C, squeezing out some
+ potential bugs.
+
+ * Fixed SEGV triggered if $DebugLevel >= 4.
+
+ * Warn on unmatched unloop.
+
+2000-03-01 Joshua Pritikin <[EMAIL PROTECTED]>
+
+ * Added Tutorial.pdf (by Jochen).
+
+ * Moved semaphore & msg into demo directory. No one has ever
+ asked for them to be finished, so they aren't.
+
2000-02-25 Joshua Pritikin <[EMAIL PROTECTED]>
* Release 0.70.
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/Event.xs'
'/usr/tmp/mp15690.d/new/Event-0.71/Event.xs'
Index: ./Event.xs
--- ./Event.xs Tue Feb 15 15:19:38 2000
+++ ./Event.xs Fri Mar 3 13:32:45 2000
@@ -118,6 +118,7 @@ static void dbg_count_memory(int id, int
# define EvFree(id, ptr) safefree(ptr)
#endif
+static int LoopLevel, ExitLevel;
static int ActiveWatchers=0; /* includes WaACTIVE + queued events */
static int WarnCounter=16; /*XXX nuke */
static SV *DebugLevel;
@@ -261,6 +262,7 @@ MODULE = Event PACKAGE = Event
PROTOTYPES: DISABLE
BOOT:
+ LoopLevel = ExitLevel = 0;
DebugLevel = SvREFCNT_inc(perl_get_sv("Event::DebugLevel", 1));
Eval = SvREFCNT_inc(perl_get_sv("Event::Eval", 1));
Estat.on=0;
@@ -336,6 +338,31 @@ _memory_counters()
#endif
}
+void
+_incr_looplevel()
+ PPCODE:
+ ++LoopLevel;
+ ++ExitLevel;
+
+void
+_decr_looplevel()
+ PPCODE:
+ --LoopLevel;
+
+void
+unloop(...)
+ CODE:
+ pe_unloop(items? ST(0) : &PL_sv_undef);
+
+void
+unloop_all(...)
+ CODE:
+{
+ SV *rsv = perl_get_sv("Event::TopResult", 0);
+ sv_setsv(rsv, items? ST(0) : &PL_sv_undef);
+ ExitLevel = 0;
+}
+
bool
cache_time_api()
CODE:
@@ -450,11 +477,8 @@ one_event(...)
void
_loop()
CODE:
- SV *exitL = perl_get_sv("Event::ExitLevel", 1);
- SV *loopL = perl_get_sv("Event::LoopLevel", 1);
pe_check_recovery();
- assert(SvIOK(exitL) && SvIOK(loopL));
- while (SvIVX(exitL) >= SvIVX(loopL) && ActiveWatchers) {
+ while (ExitLevel >= LoopLevel && ActiveWatchers) {
ENTER;
SAVETMPS;
one_event(60);
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/MANIFEST'
'/usr/tmp/mp15690.d/new/Event-0.71/MANIFEST'
Index: ./MANIFEST
--- ./MANIFEST Tue Feb 22 17:56:01 2000
+++ ./MANIFEST Wed Mar 1 16:37:10 2000
@@ -8,6 +8,7 @@ MANIFEST.SKIP
Makefile.PL
README
TODO
+Tutorial.pdf
c/ev.c
c/group.c
c/hook.c
@@ -29,6 +30,8 @@ demo/process.pm
demo/rand_interval.t
demo/readline.t
demo/repeat.t
+demo/msg.pm
+demo/semaphore.pm
lib/Event.pm
lib/Event.pod
lib/Event/EventAPI.h
@@ -38,8 +41,6 @@ lib/Event/group.pm
lib/Event/idle.pm
lib/Event/inactivity.pm
lib/Event/io.pm
-lib/Event/msg.pm
-lib/Event/semaphore.pm
lib/Event/signal.pm
lib/Event/timer.pm
lib/Event/type.pm
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/c/ev.c'
'/usr/tmp/mp15690.d/new/Event-0.71/c/ev.c'
Index: ./c/ev.c
--- ./c/ev.c Tue Feb 8 17:21:26 2000
+++ ./c/ev.c Fri Mar 3 13:22:37 2000
@@ -248,8 +248,7 @@ static void pe_event_invoke(pe_event *ev
/* SETUP */
if (CurCBFrame+1 >= MAX_CB_NEST) {
- SV *exitL = perl_get_sv("Event::ExitLevel", 1);
- sv_setiv(exitL, 0);
+ ExitLevel = 0;
croak("Deep recursion detected; invoking unloop_all()\n");
}
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/c/queue.c'
'/usr/tmp/mp15690.d/new/Event-0.71/c/queue.c'
Index: ./c/queue.c
--- ./c/queue.c Thu Feb 24 08:43:07 2000
+++ ./c/queue.c Fri Mar 3 13:27:14 2000
@@ -150,7 +150,7 @@ static void pe_queue_pending() {
static int one_event(double tm) { /**INVOKE**/
/*if (SvIVX(DebugLevel) >= 4)
- warn("Event: ActiveWatchers=%d\n", ActiveWatchers);*/
+ warn("Event: ActiveWatchers=%d\n", ActiveWatchers); /**/
pe_signal_asynccheck();
if (!PE_RING_EMPTY(&AsyncCheck)) pe_map_check(&AsyncCheck);
@@ -205,9 +205,10 @@ static int safe_one_event(double maxtm)
}
static void pe_unloop(SV *why) {
- SV *exitL = perl_get_sv("Event::ExitLevel", 0);
- SV *result = perl_get_sv("Event::Result", 0);
- assert(exitL && result);
- sv_setsv(result, why);
- sv_dec(exitL);
+ SV *rsv = perl_get_sv("Event::Result", 0);
+ assert(rsv);
+ sv_setsv(rsv, why);
+ if (--ExitLevel < 0) {
+ warn("Event::unloop() to %d", ExitLevel);
+ }
}
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/c/watcher.c'
'/usr/tmp/mp15690.d/new/Event-0.71/c/watcher.c'
Index: ./c/watcher.c
--- ./c/watcher.c Wed Feb 9 09:00:33 2000
+++ ./c/watcher.c Fri Mar 3 12:03:29 2000
@@ -316,6 +316,7 @@ static void pe_watcher_cancel(pe_watcher
static void pe_watcher_suspend(pe_watcher *ev) {
STRLEN n_a;
+ assert(ev);
if (WaSUSPEND(ev))
return;
if (WaDEBUGx(ev) >= 4)
@@ -327,11 +328,12 @@ static void pe_watcher_suspend(pe_watche
static void pe_watcher_resume(pe_watcher *ev) {
STRLEN n_a;
+ assert(ev);
if (!WaSUSPEND(ev))
return;
WaSUSPEND_off(ev);
if (WaDEBUGx(ev) >= 4)
- warn("Event: resume '%s'%s%s\n", SvPV(ev->desc,n_a),
+ warn("Event: resume '%s'%s\n", SvPV(ev->desc,n_a),
WaACTIVE(ev)?" ACTIVE":"");
if (WaACTIVE(ev))
pe_watcher_on(ev, 0);
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/lib/Event.pm'
'/usr/tmp/mp15690.d/new/Event-0.71/lib/Event.pm'
Index: ./lib/Event.pm
--- ./lib/Event.pm Fri Feb 25 12:08:42 2000
+++ ./lib/Event.pm Fri Mar 3 15:10:31 2000
@@ -13,7 +13,7 @@ use Carp;
eval { require Carp::Heavy; }; # work around perl_call_pv bug XXX
use vars qw($VERSION @EXPORT_OK
$API $DebugLevel $Eval $DIED $Now);
-$VERSION = '0.70';
+$VERSION = '0.71';
# If we inherit DynaLoader then we inherit AutoLoader; Bletch!
require DynaLoader;
@@ -117,58 +117,46 @@ sub sweep {
}
}
-use vars qw($LoopLevel $ExitLevel $Result $TopResult);
-$LoopLevel = $ExitLevel = 0;
+use vars qw($Result $TopResult);
my $loop_timer;
sub loop {
use integer;
- if (@_ == 1) {
+ if (@_) {
my $how_long = shift;
if (!$loop_timer) {
$loop_timer = Event->timer(desc => "Event::loop timeout",
after => $how_long,
- cb => sub { unloop($how_long) });
+ cb => sub { unloop($how_long) },
+ parked=>1);
$loop_timer->prio(PRIO_HIGH());
} else {
$loop_timer->at(Event::time() + $how_long),
}
$loop_timer->start;
}
- $TopResult = undef;
+ $TopResult = undef; # allow re-entry of loop after unloop_all
local $Result = undef;
- local $LoopLevel = $LoopLevel+1;
- ++$ExitLevel;
+ _incr_looplevel();
my $errsv = '';
while (1) {
# like G_EVAL | G_KEEPERR
eval { $@ = $errsv; _loop() };
$errsv = $@;
if ($@) {
-# if ($Event::DebugLevel >= 2) {
-# my $e = all_running();
-# warn "Event: '$e->{desc}' died with: $@";
-# }
+ warn "Event::loop caught: $@"
+ if $Event::DebugLevel >= 4;
next
}
last;
}
+ _decr_looplevel();
$loop_timer->stop if $loop_timer;
my $r = $Result;
$r = $TopResult if !defined $r;
- warn "Event: [$LoopLevel]unloop(".(defined $r?$r:'<undef>').")\n"
+ warn "Event: unloop(".(defined $r?$r:'<undef>').")\n"
if $Event::DebugLevel >= 3;
$r
-}
-
-sub unloop {
- $Result = shift;
- --$ExitLevel;
-}
-
-sub unloop_all {
- $TopResult = shift;
- $ExitLevel = 0;
}
sub add_hooks {
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/lib/Event.pod'
'/usr/tmp/mp15690.d/new/Event-0.71/lib/Event.pod'
Index: ./lib/Event.pod
--- ./lib/Event.pod Thu Feb 24 17:20:12 2000
+++ ./lib/Event.pod Mon Feb 28 17:29:13 2000
@@ -695,7 +695,8 @@ descriptors.
=head1 ALSO SEE
-L<Time::HiRes>, L<NetServer::ProcessTop>, and L<Time::Warp>.
+L<Time::HiRes>, L<NetServer::ProcessTop>, L<IPC::LDT>, L<Event-tcp>,
+and L<Time::Warp>.
While Tk does not yet support Event, L<PerlQt> does.
gdiff -up '/usr/tmp/mp15690.d/old/Event-0.70/t/loop.t'
'/usr/tmp/mp15690.d/new/Event-0.71/t/loop.t'
Index: ./t/loop.t
--- ./t/loop.t Fri Feb 4 08:16:53 2000
+++ ./t/loop.t Fri Mar 3 13:31:10 2000
@@ -4,19 +4,22 @@ use strict;
use Test; plan tests => 3;
use Event qw(loop unloop);
-# $Event::DebugLevel = 2;
+# kill 2, $$;
+# $Event::DebugLevel = 4;
my %got;
my $sleep = 1;
-my $sleeping;
-my $early = Event->idle(repeat => 1, cb => sub {
+use vars qw($sleeping);
+$sleeping=0;
+
+my $early = Event->idle(desc => 'early', repeat => 1, cb => sub {
return if !$sleeping;
unloop 'early';
});
-Event->idle(desc => "main", repeat => 1, cb => sub {
+
+Event->idle(desc => "main", repeat => 1, reentrant => 0, cb => sub {
my $e = shift;
- $e->w->reentrant(0);
- $sleeping = 1;
+ local $sleeping = 1;
my $ret = loop($sleep);
if (!exists $got{$ret}) {
$got{$ret} = 1;
@@ -27,8 +30,6 @@ Event->idle(desc => "main", repeat => 1,
ok 1;
}
}
- $e->w->reentrant(1);
- $sleeping = 0;
unloop(0) if keys %got == 2;
});
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Fri Mar 3 15:19:39 2000
# Generated by : makepatch 2.00 (2.0BETA)
# Recurse directories : Yes
# r 'lib/Event/semaphore.pm' 1308 0
# r 'lib/Event/msg.pm' 1016 0
# p 'ChangeLog' 23484 952114213 0100444
# p 'Event.xs' 18448 952108365 0100444
# p 'MANIFEST' 898 951946630 0100444
# c 'Tutorial.pdf' 0 951318770 0100444
# p 'c/ev.c' 7857 952107757 0100444
# p 'c/queue.c' 5213 952108034 0100444
# p 'c/watcher.c' 9643 952103009 0100444
# c 'demo/msg.pm' 0 951946566 0100444
# c 'demo/semaphore.pm' 0 951946578 0100444
# p 'lib/Event.pm' 4254 952114231 0100444
# p 'lib/Event.pod' 24031 951776953 0100444
# p 't/loop.t' 644 952108270 0100444
#### End of ApplyPatch data ####
#### End of Patch kit [created: Fri Mar 3 15:19:39 2000] ####
#### Checksum: 1908 137172 41647 ####
--
"Never ascribe to malice that which can be explained by stupidity."
via, but not speaking for Deutsche Bank
