Fwd: CPAN Upload: JPRIT/Event-0.71.tar.gz

[email protected] (Joshua N Pritikin)
Newsgroups perl.loop
Message-ID <[email protected]> 
----- 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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.