This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mailine
authorNick Ing-Simmons <nik@tiuk.ti.com>
Sun, 19 May 2002 18:26:39 +0000 (18:26 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Sun, 19 May 2002 18:26:39 +0000 (18:26 +0000)
p4raw-id: //depot/perlio@16696

35 files changed:
Changes
Makefile.SH
ext/Storable/Storable.pm
ext/Storable/t/malice.t
ext/threads/shared/shared.pm
ext/threads/shared/shared.xs
ext/threads/shared/t/cond.t
ext/threads/t/thread.t
ext/threads/threads.pm
handy.h
lib/Benchmark.pm
lib/ExtUtils/Changes
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/t/testlib.t
lib/ExtUtils/testlib.pm
lib/Pod/t/eol.t
lib/open.pm
lib/warnings.pm
patchlevel.h
pod/perlapi.pod
pod/perlclib.pod
pod/perldelta.pod
pod/perldiag.pod
pod/perlfunc.pod
pod/perlhack.pod
pod/perllexwarn.pod
pod/perlmodlib.pod
pod/perlunicode.pod
pod/perluniintro.pod
scope.c
sv.c
t/op/recurse.t
util.c
warnings.h
warnings.pl

diff --git a/Changes b/Changes
index 1e350b8..72b2ca5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -28,6 +28,318 @@ example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/
 Version v5.7.X         Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 16693] By: jhi                                   on 2002/05/19  14:28:37
+        Log: Subject: [PATCH] Benchmark.pm: empty loop too slow
+             From: Slaven Rezic <slaven.rezic@berlin.de>
+             Date: Sun, 19 May 2002 16:03:12 +0200 (CEST)
+             Message-Id: <200205191403.g4JE3ClB025990@vran.herceg.de>
+     Branch: perl
+          ! lib/Benchmark.pm
+____________________________________________________________________________
+[ 16692] By: jhi                                   on 2002/05/19  03:05:41
+        Log: Document once more the difference between :utf8
+             and :encoding(...).
+     Branch: perl
+          ! lib/open.pm pod/perluniintro.pod
+____________________________________________________________________________
+[ 16691] By: jhi                                   on 2002/05/19  02:24:30
+        Log: Third Degree: make the options more portable between
+             Tru64 versions.
+     Branch: perl
+          ! Makefile.SH
+____________________________________________________________________________
+[ 16690] By: jhi                                   on 2002/05/19  01:41:54
+        Log: IRIX SMP turned up a few hundred "Use of uninitialized
+             value in numeric eq" warnings: initialise the $counter2.
+     Branch: perl
+          ! ext/threads/shared/t/cond.t
+____________________________________________________________________________
+[ 16689] By: jhi                                   on 2002/05/19  00:29:36
+        Log: Subject: Re: [PATCH threads] revised warnings + more tests + docs
+             From: Dave Mitchell <davem@fdgroup.com>
+             Date: Sun, 19 May 2002 00:50:43 +0100
+             Message-ID: <20020519005043.F7275@fdgroup.com>
+     Branch: perl
+          ! ext/threads/shared/t/cond.t
+____________________________________________________________________________
+[ 16688] By: jhi                                   on 2002/05/19  00:28:51
+        Log: Sarathy pointed out that instead of zeroing heap
+             it is more prudent to poison it.
+     Branch: perl
+          ! handy.h pod/perlapi.pod pod/perlclib.pod pod/perlhack.pod
+          ! scope.c sv.c util.c
+____________________________________________________________________________
+[ 16687] By: jhi                                   on 2002/05/18  22:03:29
+        Log: The thread warnings aren't quite yet working as planned.
+     Branch: perl
+          ! ext/threads/shared/t/cond.t
+____________________________________________________________________________
+[ 16686] By: jhi                                   on 2002/05/18  20:48:03
+        Log: Forgotten from #16685.
+     Branch: perl
+          ! ext/threads/shared/t/cond.t
+____________________________________________________________________________
+[ 16685] By: jhi                                   on 2002/05/18  20:46:13
+        Log: Subject: [PATCH threads] revised warnings + more tests + docs
+             From: Dave Mitchell <davem@fdgroup.com>
+             Date: Sat, 18 May 2002 22:24:51 +0100
+             Message-ID: <20020518222451.E7275@fdgroup.com>
+     Branch: perl
+          ! ext/threads/shared/shared.pm ext/threads/shared/shared.xs
+          ! ext/threads/t/thread.t ext/threads/threads.pm lib/warnings.pm
+          ! pod/perldiag.pod pod/perllexwarn.pod warnings.h warnings.pl
+____________________________________________________________________________
+[ 16684] By: jhi                                   on 2002/05/18  20:10:53
+        Log: Storable status tweak.
+     Branch: perl
+          ! pod/perldelta.pod
+____________________________________________________________________________
+[ 16683] By: rgs                                   on 2002/05/18  19:39:42
+        Log: perlfunc and perldelta updates about caller().
+     Branch: perl
+          ! pod/perldelta.pod pod/perlfunc.pod
+____________________________________________________________________________
+[ 16682] By: jhi                                   on 2002/05/18  19:33:51
+        Log: Subject: [PATCH] RE: perl@16678
+             From: "Paul Marquess" <Paul.Marquess@ntlworld.com>
+             Date: Sat, 18 May 2002 21:15:43 +0100
+             Message-ID: <AIEAJICLCBDNAAOLLOKLCEAPELAA.Paul.Marquess@ntlworld.com>
+             
+             Making the symbols generated by warnings.pl future-proof.
+     Branch: perl
+          ! lib/warnings.pm warnings.h warnings.pl
+____________________________________________________________________________
+[ 16681] By: jhi                                   on 2002/05/18  18:44:32
+        Log: Subject: [PATCH] ExtUtils::MakeMaker 5.94_02 -> 5.95_01
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Sat, 18 May 2002 14:53:50 -0400
+             Message-ID: <20020518185350.GB2878@ool-18b93024.dyn.optonline.net>
+     Branch: perl
+          ! lib/ExtUtils/Changes lib/ExtUtils/MakeMaker.pm
+          ! lib/ExtUtils/t/testlib.t lib/ExtUtils/testlib.pm
+____________________________________________________________________________
+[ 16680] By: jhi                                   on 2002/05/18  18:43:35
+        Log: Prettyprinting.
+     Branch: perl
+          ! t/op/recurse.t
+____________________________________________________________________________
+[ 16679] By: jhi                                   on 2002/05/18  18:42:08
+        Log: Companion to #16601: cxinc would create uninitialized
+             PERL_CONTEXTs.  The bug was tickled by the test
+             lib/Math/BigInt/t/upgrade.t, the new test of recurse.t
+             added to check that I got the context stack extension right.
+             Also rewrite recurse.t to use test.pl.
+     Branch: perl
+          ! scope.c t/op/recurse.t
+____________________________________________________________________________
+[ 16678] By: jhi                                   on 2002/05/18  16:38:29
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
+[ 16677] By: jhi                                   on 2002/05/18  15:50:25
+        Log: URL and other tiny tweaks.
+     Branch: perl
+          ! pod/perluniintro.pod
+____________________________________________________________________________
+[ 16676] By: jhi                                   on 2002/05/18  15:40:35
+        Log: Subject: [Patch] doc patch on Unicode
+             From: SADAHIRO Tomoyuki <bqw10602@nifty.com>
+             Date: Sun, 19 May 2002 01:01:58 +0900
+             Message-Id: <20020519005515.18F0.BQW10602@nifty.com>
+     Branch: perl
+          ! pod/perlmodlib.pod pod/perlunicode.pod pod/perluniintro.pod
+____________________________________________________________________________
+[ 16675] By: ams                                   on 2002/05/18  15:06:35
+        Log: s/2.0/2.00/ to be CPAN friendly.
+     Branch: perl
+          ! ext/Storable/Storable.pm
+____________________________________________________________________________
+[ 16674] By: ams                                   on 2002/05/18  14:47:07
+        Log: Subject: Re: Change 16621: 1. Not hardcoding \x0A and \x0D seems to help
+             EBCDIC, amazing.
+             From: Philip Newton <Philip.Newton@gmx.net>
+             Date: Sat, 18 May 2002 09:54:13 +0200
+             Message-Id: <432ceucrfducg2iitau6uggeb02lu209a2@4ax.com>
+     Branch: perl
+          ! lib/Pod/t/eol.t
+____________________________________________________________________________
+[ 16673] By: ams                                   on 2002/05/18  14:41:00
+        Log: Subject: Storable test for 64 bit 5.6.1
+             From: Nicholas Clark <nick@unfortu.net>
+             Date: Sat, 18 May 2002 15:48:55 +0100
+             Message-Id: <20020518144854.GD304@Bagpuss.unfortu.net>
+             (Private mail.)
+     Branch: perl
+          ! ext/Storable/t/malice.t
+____________________________________________________________________________
+[ 16672] By: nick                                  on 2002/05/18  09:47:51
+        Log: Integrate mainline
+     Branch: perlio
+         +> t/lib/sample-tests/shbang_misparse t/op/caller.t
+          - t/lib/st-dump.pl
+         !> (integrate 67 files)
+____________________________________________________________________________
+[ 16671] By: jhi                                   on 2002/05/18  04:31:00
+        Log: No more true.
+     Branch: perl
+          ! lib/vars.pm
+____________________________________________________________________________
+[ 16670] By: jhi                                   on 2002/05/18  04:14:25
+        Log: Make use vars grok UTF-8.
+     Branch: perl
+          ! lib/vars.pm t/run/fresh_perl.t
+____________________________________________________________________________
+[ 16669] By: jhi                                   on 2002/05/18  03:53:27
+        Log: Subject: [PATCH] Re: t/op/tie.t #19 TODO ENOTWORKING  
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 17 May 2002 23:54:29 -0400  
+             Message-ID: <20020518035429.GA704@ool-18b93024.dyn.optonline.net>
+     Branch: perl
+          ! t/op/tie.t t/run/fresh_perl.t
+____________________________________________________________________________
+[ 16668] By: jhi                                   on 2002/05/18  03:44:57
+        Log: Subject: [PATCH] Test::Harness 2.21 -> 2.22
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 17 May 2002 20:37:26 -0400  
+             Message-ID: <20020518003726.GB358@ool-18b93024.dyn.optonline.net>
+     Branch: perl
+          + t/lib/sample-tests/shbang_misparse
+          ! MANIFEST lib/Test/Harness.pm lib/Test/Harness/Changes
+          ! lib/Test/Harness/Straps.pm lib/Test/Harness/t/strap-analyze.t
+          ! lib/Test/Harness/t/test-harness.t
+____________________________________________________________________________
+[ 16667] By: jhi                                   on 2002/05/18  03:41:34
+        Log: Subject: [PATCH] Re: [PATCH] Storable stand alone tests
+             From: Nicholas Clark <nick@unfortu.net>
+             Date: Sat, 18 May 2002 00:18:39 +0100  
+             Message-ID: <20020517231838.GI290@Bagpuss.unfortu.net>
+             
+             Use Storable's st-dump.pl.
+     Branch: perl
+          - t/lib/st-dump.pl
+          ! MANIFEST ext/Storable/t/blessed.t ext/Storable/t/compat06.t
+          ! ext/Storable/t/dclone.t ext/Storable/t/freeze.t
+          ! ext/Storable/t/lock.t ext/Storable/t/overload.t
+          ! ext/Storable/t/recurse.t ext/Storable/t/restrict.t
+          ! ext/Storable/t/retrieve.t ext/Storable/t/store.t
+          ! ext/Storable/t/tied.t ext/Storable/t/tied_hook.t
+          ! ext/Storable/t/tied_items.t ext/Storable/t/utf8.t
+____________________________________________________________________________
+[ 16666] By: jhi                                   on 2002/05/17  21:46:04
+        Log: Forgotten from #16656.
+     Branch: perl
+          ! ext/B/B.xs
+____________________________________________________________________________
+[ 16665] By: jhi                                   on 2002/05/17  21:40:55
+        Log: Subject: [PATCH] Storable ChangeLog ready for release 
+             From: Nicholas Clark <nick@unfortu.net>
+             Date: Fri, 17 May 2002 23:17:34 +0100  
+             Message-ID: <20020517221733.GH290@Bagpuss.unfortu.net>
+     Branch: perl
+          ! ext/Storable/ChangeLog
+____________________________________________________________________________
+[ 16664] By: jhi                                   on 2002/05/17  21:39:37
+        Log: Subject: [PATCH] Storable stand alone tests
+             From: Nicholas Clark <nick@unfortu.net>
+             Date: Fri, 17 May 2002 22:43:35 +0100  
+             Message-ID: <20020517214334.GG290@Bagpuss.unfortu.net>
+     Branch: perl
+          ! ext/Storable/t/blessed.t ext/Storable/t/canonical.t
+          ! ext/Storable/t/compat06.t ext/Storable/t/croak.t
+          ! ext/Storable/t/dclone.t ext/Storable/t/downgrade.t
+          ! ext/Storable/t/forgive.t ext/Storable/t/freeze.t
+          ! ext/Storable/t/lock.t ext/Storable/t/malice.t
+          ! ext/Storable/t/overload.t ext/Storable/t/recurse.t
+          ! ext/Storable/t/restrict.t ext/Storable/t/retrieve.t
+          ! ext/Storable/t/store.t ext/Storable/t/tied.t
+          ! ext/Storable/t/tied_hook.t ext/Storable/t/tied_items.t
+          ! ext/Storable/t/utf8.t ext/Storable/t/utf8hash.t
+____________________________________________________________________________
+[ 16663] By: jhi                                   on 2002/05/17  21:35:45
+        Log: Subject: [PATCH] ExtUtils::MakeMaker 5.92_01 -> 5.94_02
+             From: Michael G Schwern <schwern@pobox.com>
+             Date: Fri, 17 May 2002 17:17:54 -0400  
+             Message-ID: <20020517211754.GK13131@ool-18b93024.dyn.optonline.net>
+     Branch: perl
+          ! lib/ExtUtils/Changes lib/ExtUtils/Command.pm
+          ! lib/ExtUtils/Command/MM.pm lib/ExtUtils/Install.pm
+          ! lib/ExtUtils/Installed.pm lib/ExtUtils/Liblist.pm
+          ! lib/ExtUtils/Liblist/Kid.pm lib/ExtUtils/MM_BeOS.pm
+          ! lib/ExtUtils/MM_MacOS.pm lib/ExtUtils/MM_NW5.pm
+          ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+          ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
+          ! lib/ExtUtils/Mksymlists.pm lib/ExtUtils/Packlist.pm
+          ! lib/ExtUtils/t/00setup_dummy.t lib/ExtUtils/t/Command.t
+          ! lib/ExtUtils/t/INST.t lib/ExtUtils/t/Installed.t
+          ! lib/ExtUtils/t/MM_Cygwin.t lib/ExtUtils/t/MM_Unix.t
+          ! lib/ExtUtils/t/Manifest.t lib/ExtUtils/t/Mkbootstrap.t
+          ! lib/ExtUtils/t/Packlist.t lib/ExtUtils/t/VERSION_FROM.t
+          ! lib/ExtUtils/t/basic.t lib/ExtUtils/t/hints.t
+____________________________________________________________________________
+[ 16662] By: rgs                                   on 2002/05/17  20:07:21
+        Log: More regression tests for caller() and fix one bug of #16658.
+     Branch: perl
+          ! pp_ctl.c t/op/caller.t
+____________________________________________________________________________
+[ 16661] By: jhi                                   on 2002/05/17  19:13:18
+        Log: Integrate perlio;
+             
+             Fix the crlf.t buffer leak
+             - actually a generic PerlIOBuf_xxx derived leak-on-pop, but :crlf
+             flagged it because it is more often popped without stream
+             being closed.
+             - Define non-noop PerlIOBuf_popped(), use it and export it.
+     Branch: perl
+         !> makedef.pl perlio.c perliol.h
+____________________________________________________________________________
+[ 16660] By: rgs                                   on 2002/05/17  19:09:03
+        Log: Add a note about Cwd::fastcwd() returning tainted data.
+             Sort modules alphabetically.
+     Branch: perl
+          ! pod/perldelta.pod
+____________________________________________________________________________
+[ 16659] By: rgs                                   on 2002/05/17  19:05:11
+        Log: Remove O from the untested modules list.
+     Branch: perl
+          ! t/lib/1_compile.t
+____________________________________________________________________________
+[ 16658] By: rgs                                   on 2002/05/17  19:03:06
+        Log: Fix bug 20020517.003 : segfault with caller().
+             Add regression tests for caller.
+     Branch: perl
+          + t/op/caller.t
+          ! MANIFEST pp_ctl.c
+____________________________________________________________________________
+[ 16657] By: nick                                  on 2002/05/17  17:18:18
+        Log: Fix the crlf.t buffer leak
+             - actually a generic PerlIOBuf_xxx derived leak-on-pop, but :crlf
+             flagged it because it is more often popped without stream
+             being closed.
+             - Define non-noop PerlIOBuf_popped(), use it and export it.
+     Branch: perlio
+          ! makedef.pl perlio.c perliol.h
+____________________________________________________________________________
+[ 16656] By: jhi                                   on 2002/05/17  16:52:15
+        Log: PERL_HASH() casting games so that our hashed data is "unsigned
+             char" but old code using just a "char" doesn't need changes.
+             (The change is using a temporary pointer instead of a direct
+             cast to unsigned char* which would blindly cast anything,
+             not just char pointers.)  (The problem arose in MacOS Classic,
+             as seen by Pudge, the cure by Nicholas Clark.)
+     Branch: perl
+          ! hv.c hv.h op.c sv.c vms/vms.c
+____________________________________________________________________________
+[ 16655] By: nick                                  on 2002/05/17  14:59:20
+        Log: Integrate mainline
+     Branch: perlio
+         !> (integrate 28 files)
+____________________________________________________________________________
+[ 16654] By: jhi                                   on 2002/05/17  12:24:07
+        Log: Update Changes.
+     Branch: perl
+          ! Changes patchlevel.h
+____________________________________________________________________________
 [ 16653] By: jhi                                   on 2002/05/17  12:18:54
         Log: FAQ sync.
      Branch: perl
index 01fab27..a5addfb 100644 (file)
@@ -565,7 +565,7 @@ perl.third.config: config.sh
        @grep "^usemymalloc='n'" config.sh >/dev/null || exit 1
 
 perl.third: /usr/bin/atom perl.third.config perl
-       atom -tool third -L. -all -gp -toolargs="-pthread -fork -quiet -invalid -uninit heap+stack+partword+copy -min 0" perl
+       atom -tool third -L. -all -gp -toolargs="-invalid -uninit heap+stack+copy -min 0" perl
        @echo "Now you may run perl.third and then study perl.3log."
 
 # Pixie Perls (Tru64 and IRIX only)
index 664f6e7..50fc105 100644 (file)
@@ -70,7 +70,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
 use AutoLoader;
 use vars qw($forgive_me $VERSION);
 
-$VERSION = '2.0';
+$VERSION = '2.00';
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;            # Grrr...
 
 #
index d9de077..639fc36 100644 (file)
@@ -27,10 +27,28 @@ sub BEGIN {
 }
 
 use strict;
-use vars qw($file_magic_str $other_magic $network_magic $major $minor
-            $minor_write $fancy);
+use vars qw($file_magic_str $other_magic $network_magic $byteorder
+            $major $minor $minor_write $fancy);
+
+$byteorder = $Config{byteorder};
+
+if ($] < 5.007003 && $] >= 5.006 && $^O ne 'MSWin32'
+    && $Config{longsize} != $Config{ivsize}) {
+  # 5.6.x, not on Windows, built with IVs as long long
+  # config.h and Config.sh differ in their idea of the value of byteorder
+  # Storable's header is written out using C (hence config.h), but we're
+  # testing with perl
+  if ($byteorder eq '12345678') {
+    $byteorder = '1234';
+  } elsif ($byteorder eq '87654321') {
+    $byteorder = '4321';
+  } else {
+    die "I don't recognise Your byteorder: '$byteorder'";
+  }
+}
+
 $file_magic_str = 'pst0';
-$other_magic = 7 + length($Config{byteorder});
+$other_magic = 7 + length $byteorder;
 $network_magic = 2;
 $major = 2;
 $minor = 5;
@@ -46,7 +64,7 @@ use Test::More;
 # present in files, but not in things store()ed to memory
 $fancy = ($] > 5.007 ? 2 : 0);
 
-plan tests => 378 + length($Config{byteorder}) * 4 + $fancy * 8;
+plan tests => 368 + length ($byteorder) * 4 + $fancy * 8;
 
 use Storable qw (store retrieve freeze thaw nstore nfreeze);
 
@@ -76,9 +94,10 @@ sub test_header {
   is ($header->{major}, $major, "major number");
   is ($header->{minor}, $minor_write, "minor number");
   is (!!$header->{netorder}, !!$isnetorder, "is network order");
- SKIP: {
-    skip "Network order header has no sizes", 5 if ($isnetorder);
-    is ($header->{byteorder}, $Config{byteorder}, "byte order");
+  if ($isnetorder) {
+    # Network order header has no sizes
+  } else {
+    is ($header->{byteorder}, $byteorder, "byte order");
     is ($header->{intsize}, $Config{intsize}, "int size");
     is ($header->{longsize}, $Config{longsize}, "long size");
     is ($header->{ptrsize}, $Config{ptrsize}, "long size");
index 4ffe261..7536495 100644 (file)
@@ -72,6 +72,8 @@ threads::shared - Perl extension for sharing data structures between threads
   use threads;
   use threads::shared;
 
+  my $var : shared;
+
   my($scalar, @array, %hash);
   share($scalar);
   share(@array);
@@ -79,21 +81,22 @@ threads::shared - Perl extension for sharing data structures between threads
   my $bar = share([]);
   $hash{bar} = share({});
 
-  lock(%hash);
-  unlock(%hash);
+  { lock(%hash); ...  }
+
   cond_wait($scalar);
   cond_broadcast(@array);
   cond_signal(%hash);
 
 =head1 DESCRIPTION
 
-This modules allows you to share() variables. These variables will
-then be shared across different threads (and pseudoforks on
-win32). They are used together with the threads module.
+By default, variables are private to each thread, and each newly created
+thread gets a private copy of each existing variable.  This module allows
+you to share variables across different threads (and pseudoforks on
+win32). It is used together with the threads module.
 
 =head1 EXPORT
 
-C<share>, C<lock>, C<unlock>, C<cond_wait>, C<cond_signal>, C<cond_broadcast>
+C<share>, C<lock>, C<cond_wait>, C<cond_signal>, C<cond_broadcast>
 
 =head1 FUNCTIONS
 
@@ -107,14 +110,16 @@ hash, scalar ref, array ref or hash ref. C<share> will return the shared value.
 C<share> will traverse up references exactly I<one> level.
 C<share(\$a)> is equivalent to C<share($a)>, while C<share(\\$a)> is not.
 
+A variable can also be marked as shared at compile time by using the
+C<shared> attribute: C<my $var : shared>.
+
 =item lock VARIABLE
 
 C<lock> places a lock on a variable until the lock goes out of scope.  If
 the variable is locked by another thread, the C<lock> call will block until
 it's available. C<lock> is recursive, so multiple calls to C<lock> are
 safe -- the variable will remain locked until the outermost lock on the
-variable goes out of scope or C<unlock> is called enough times to match
-the number of calls to <lock>.
+variable goes out of scope.
 
 If a container object, such as a hash or array, is locked, all the elements
 of that container are not locked. For example, if a thread does a C<lock
@@ -123,15 +128,9 @@ of that container are not locked. For example, if a thread does a C<lock
 C<lock> will traverse up references exactly I<one> level.
 C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
 
-
-=item unlock VARIABLE
-
-C<unlock> takes a B<locked> variable and decrements the lock count.
-If the lock count is zero the variable is unlocked. It is not necessary
-to call C<unlock> but it can be useful to reduce lock contention.
-
-C<unlock> will traverse up references exactly I<one> level.
-C<unlock(\$a)> is equivalent to C<unlock($a)>, while C<unlock(\\$a)> is not.
+Note that you cannot explicitly unlock a variable; you can only wait for
+the lock to go out of scope. If you need more fine-grained control, see
+L<threads::shared::semaphore>.
 
 =item cond_wait VARIABLE
 
@@ -141,8 +140,10 @@ or C<cond_broadcast> for that same locked variable. The variable that
 C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
 If there are multiple threads C<cond_wait>ing on the same variable, all but
 one will reblock waiting to reacquire the lock on the variable. (So if
-you're only using C<cond_wait> for synchronization, give up the lock as
-soon as possible)
+you're only using C<cond_wait> for synchronisation, give up the lock as
+soon as possible). The two actions of unlocking the variable and entering
+the blocked wait state are atomic, The two actions of exiting from the
+blocked wait state and relocking the variable are not.
 
 It is important to note that the variable can be notified even if no
 thread C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
@@ -157,7 +158,14 @@ one thread is blocked in a C<cond_wait> on that variable, only one (and
 which one is indeterminate) will be unblocked.
 
 If there are no threads blocked in a C<cond_wait> on the variable, the
-signal is discarded.
+signal is discarded. By always locking before signaling, you can (with
+care), avoid signaling before another thread has entered cond_wait().
+
+C<cond_signal> will normally generate a warning if you attempt to use it
+on an unlocked variable. On the rare occasions where doing this may be
+sensible, you can skip the warning with
+
+    { no warnings 'threads'; cond_signal($foo) }
 
 =item cond_broadcast VARIABLE
 
index 9b0ca50..14524f6 100644 (file)
@@ -732,7 +732,7 @@ Perl_sharedsv_locksv(pTHX_ SV *sv)
 
     if(SvROK(sv))
        sv = SvRV(sv);
-    shared = Perl_sharedsv_find(aTHX, sv);
+    shared = Perl_sharedsv_find(aTHX_ sv);
     if(!shared)
        croak("lock can only be used on shared values");
     Perl_sharedsv_lock(aTHX_ shared);
@@ -962,7 +962,7 @@ share(SV *ref)
        ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
-       Perl_sharedsv_share(aTHX, ref);
+       Perl_sharedsv_share(aTHX_ ref);
 
 void
 lock_enabled(SV *ref)
@@ -972,7 +972,7 @@ lock_enabled(SV *ref)
        ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
-       shared = Perl_sharedsv_find(aTHX, ref);
+       shared = Perl_sharedsv_find(aTHX_ ref);
        if(!shared)
           croak("lock can only be used on shared values");
        Perl_sharedsv_lock(aTHX_ shared);
@@ -1017,6 +1017,9 @@ cond_signal_enabled(SV *ref)
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX_ ref);
+       if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX)
+           Perl_warner(aTHX_ packWARN(WARN_THREADS),
+                           "cond_signal() called on unlocked variable");
        if(!shared)
            croak("cond_signal can only be used on shared values");
        COND_SIGNAL(&shared->user_cond);
@@ -1032,6 +1035,9 @@ cond_broadcast_enabled(SV *ref)
        shared = Perl_sharedsv_find(aTHX_ ref);
        if(!shared)
            croak("cond_broadcast can only be used on shared values");
+       if (ckWARN(WARN_THREADS) && shared->lock.owner != aTHX)
+           Perl_warner(aTHX_ packWARN(WARN_THREADS),
+                           "cond_broadcast() called on unlocked variable");
        COND_BROADCAST(&shared->user_cond);
 
 #endif /* USE_ITHREADS */
index 28de99c..aa80aab 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 $|++;
-print "1..5\n";
+print "1..29\n";
 use strict;
 
 
@@ -18,25 +18,255 @@ use threads;
 
 use threads::shared;
 
-my $lock : shared;
+# We can't use the normal ok() type stuff here, as part of the test is
+# to check that the numbers get printed in the right order. Instead, we
+# set a 'base' number for each part of the test and specify the ok()
+# number as an offset from that base.
 
-sub foo {
-    lock($lock);
-    print "ok 1\n";
-    my $tr2 = threads->create(\&bar);
-    cond_wait($lock);
-    $tr2->join();
-    print "ok 5\n";
+my $Base = 0;
+
+sub ok {
+    my ($offset, $bool, $text) = @_;
+    print "not " unless $bool;
+    print "ok ", $Base + $offset, " - $text\n";
 }
 
-sub bar {
-    print "ok 2\n";
-    lock($lock);
-    print "ok 3\n";
+# test locking
+
+{
+    my $lock : shared;
+    my $tr;
+
+    # test that a subthread can't lock until parent thread has unlocked
+
+    {
+       lock($lock);
+       ok(1,1,"set first lock");
+       $tr = async {
+           lock($lock);
+           ok(3,1,"set lock in subthread");
+       };
+       threads->yield;
+       ok(2,1,"still got lock");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # ditto with ref to thread
+
+    {
+       my $lockref = \$lock;
+       lock($lockref);
+       ok(1,1,"set first lockref");
+       $tr = async {
+           lock($lockref);
+           ok(3,1,"set lockref in subthread");
+       };
+       threads->yield;
+       ok(2,1,"still got lockref");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # make sure recursive locks unlock at the right place
+    {
+       lock($lock);
+       ok(1,1,"set first recursive lock");
+       lock($lock);
+       threads->yield;
+       {
+           lock($lock);
+           threads->yield;
+       }
+       $tr = async {
+           lock($lock);
+           ok(3,1,"set recursive lock in subthread");
+       };
+       {
+           lock($lock);
+           threads->yield;
+           {
+               lock($lock);
+               threads->yield;
+               lock($lock);
+               threads->yield;
+           }
+       }
+       ok(2,1,"still got recursive lock");
+    }
+    $tr->join;
+
+    $Base += 3;
+
+    # Make sure a lock factory gives out fresh locks each time 
+    # for both attribute and run-time shares
+
+    sub lock_factory1 { my $lock : shared; return \$lock; }
+    sub lock_factory2 { my $lock; share($lock); return \$lock; }
+
+    my (@locks1, @locks2);
+    push @locks1, lock_factory1() for 1..2;
+    push @locks1, lock_factory2() for 1..2;
+    push @locks2, lock_factory1() for 1..2;
+    push @locks2, lock_factory2() for 1..2;
+
+    ok(1,1,"lock factory: locking all locks");
+    lock $locks1[0];
+    lock $locks1[1];
+    lock $locks1[2];
+    lock $locks1[3];
+    ok(2,1,"lock factory: locked all locks");
+    $tr = async {
+       ok(3,1,"lock factory: child: locking all locks");
+       lock $locks2[0];
+       lock $locks2[1];
+       lock $locks2[2];
+       lock $locks2[3];
+       ok(4,1,"lock factory: child: locked all locks");
+    };
+    $tr->join;
+       
+    $Base += 4;
+}
+
+# test cond_signal()
+
+{
+    my $lock : shared;
+
+    sub foo {
+       lock($lock);
+       ok(1,1,"cond_signal: created first lock");
+       my $tr2 = threads->create(\&bar);
+       cond_wait($lock);
+       $tr2->join();
+       ok(5,1,"cond_signal: joined");
+    }
+
+    sub bar {
+       ok(2,1,"cond_signal: child before lock");
+       lock($lock);
+       ok(3,1,"cond_signal: child locked");
+       cond_signal($lock);
+       ok(4,1,"cond_signal: signalled");
+    }
+
+    my $tr  = threads->create(\&foo);
+    $tr->join();
+
+    $Base += 5;
+
+    # ditto, but with lockrefs
+
+    my $lockref = \$lock;
+    sub foo2 {
+       lock($lockref);
+       ok(1,1,"cond_signal: ref: created first lock");
+       my $tr2 = threads->create(\&bar2);
+       cond_wait($lockref);
+       $tr2->join();
+       ok(5,1,"cond_signal: ref: joined");
+    }
+
+    sub bar2 {
+       ok(2,1,"cond_signal: ref: child before lock");
+       lock($lockref);
+       ok(3,1,"cond_signal: ref: child locked");
+       cond_signal($lockref);
+       ok(4,1,"cond_signal: ref: signalled");
+    }
+
+    $tr  = threads->create(\&foo2);
+    $tr->join();
+
+    $Base += 5;
+
+}
+
+
+# test cond_broadcast()
+
+{
+    my $counter : shared = 0;
+
+    sub waiter {
+       lock($counter);
+       $counter++;
+       cond_wait($counter);
+       $counter += 10;
+    }
+
+    my $tr1 = threads->new(\&waiter);
+    my $tr2 = threads->new(\&waiter);
+    my $tr3 = threads->new(\&waiter);
+
+    while (1) {
+       lock $counter;
+       # make sure all 3 threads are waiting
+       next unless $counter == 3;
+       cond_broadcast $counter;
+       last;
+    }
+    $tr1->join(); $tr2->join(); $tr3->join();
+    ok(1, $counter == 33, "cond_broadcast: all three threads woken");
+    print "# counter=$counter\n";
+
+    $Base += 1;
+
+    # ditto with refs and shared()
+
+    my $counter2 = 0;
+    share($counter2);
+    my $r = \$counter2;
+
+    sub waiter2 {
+       lock($r);
+       $$r++;
+       cond_wait($r);
+       $$r += 10;
+    }
+
+    $tr1 = threads->new(\&waiter2);
+    $tr2 = threads->new(\&waiter2);
+    $tr3 = threads->new(\&waiter2);
+
+    while (1) {
+       lock($r);
+       # make sure all 3 threads are waiting
+       next unless $$r == 3;
+       cond_broadcast $r;
+       last;
+    }
+    $tr1->join(); $tr2->join(); $tr3->join();
+    ok(1, $$r == 33, "cond_broadcast: ref: all three threads woken");
+    print "# counter=$$r\n";
+
+    $Base += 1;
+
+}
+
+# test warnings;
+
+{
+    my $warncount = 0;
+    local $SIG{__WARN__} = sub { $warncount++ };
+
+    my $lock : shared;
+
     cond_signal($lock);
-    print "ok 4\n";
+    ok(1, $warncount == 1, 'get warning on cond_signal');
+    cond_broadcast($lock);
+    ok(2, $warncount == 2, 'get warning on cond_broadcast');
+    no warnings 'threads';
+    cond_signal($lock);
+    ok(3, $warncount == 2, 'get no warning on cond_signal');
+    cond_broadcast($lock);
+    ok(4, $warncount == 2, 'get no warning on cond_broadcast');
+
+    $Base += 4;
 }
 
-my $tr  = threads->create(\&foo);
-$tr->join();
+
 
index 435f3bd..9a2bb28 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 use ExtUtils::testlib;
 use strict;
-BEGIN { $| = 1; print "1..21\n" };
+BEGIN { $| = 1; print "1..24\n" };
 use threads;
 use threads::shared;
 
@@ -121,3 +121,23 @@ sub threaded {
     ok($thr6->join());
     ok($thr7->join());
 }
+
+# test that 'yield' is importable
+
+package Test1;
+
+use threads 'yield';
+yield;
+main::ok(1);
+
+package main;
+
+
+# test async
+
+{
+    my $th = async {return 1 };
+    ok($th);
+    ok($th->join());
+}
+
index d74e85f..43d1f0a 100755 (executable)
@@ -83,30 +83,28 @@ threads - Perl extension allowing use of interpreter based threads from perl
 
 =head1 SYNOPSIS
 
-use threads;
+    use threads;
 
-sub start_thread {
-    print "Thread started\n";
-}
-
-my $thread = threads->create("start_thread","argument");
-
-$thread->create(sub { print "I am a thread"},"argument");
-
-$thread->join();
+    sub start_thread {
+       print "Thread started\n";
+    }
 
-$thread->detach();
+    my $thread  = threads->create("start_thread","argument");
+    my $thread2 = $thread->create(sub { print "I am a thread"},"argument");
+    my $thread3 = async { foreach (@files) { ... } };
 
-$thread = threads->self();
+    $thread->join();
+    $thread->detach();
 
-threads->tid();
-threads->self->tid();
+    $thread = threads->self();
 
-$thread->tid();
+    $thread->tid();
+    threads->tid();
+    threads->self->tid();
 
-threads->yield();
+    threads->yield();
 
-threads->list();
+    threads->list();
 
 =head1 DESCRIPTION
 
@@ -123,7 +121,7 @@ important to note that variables are not shared between threads, all
 variables are per default thread local.  To use shared variables one
 must use threads::shared.
 
-It is also important to note that you preferably enable threads by
+It is also important to note that you must enable threads by
 doing C<use threads> as early as possible and that it is not possible
 to enable threading inside an eval "";  In particular, if you are
 intending to share variables with threads::shared, you must
@@ -136,32 +134,43 @@ a warning if you do it the other way around.
 
 This will create a new thread with the entry point function and give
 it LIST as parameters.  It will return the corresponding threads
-object.
+object. The new() method is an alias for create().
 
 =item $thread->join
 
-This will wait for the corresponding thread to join. When it finishes
-join will return the return values of the entry point function.  If a
-thread has been detached, an error will be thrown..
+This will wait for the corresponding thread to join. When the thread finishes,
+join() will return the return values of the entry point function. If the
+thread has been detached, an error will be thrown. If the program
+exits without all other threads having been either joined or detached,
+then a warning will be issued. (A program exits either because one of its
+threads explicitly calls exit(), or in the case of the main thread, reaches
+the end of the main program file.)
 
 =item $thread->detach
 
-Will throw away the return value from the thread and make it
-non-joinable.
+Will make the thread unjoinable, and cause any eventual return value to be
+discarded.
 
 =item threads->self
 
-This will return the object for the current thread.
+This will return the thread object for the current thread.
 
 =item $thread->tid
 
-This will return the id of the thread.  threads->tid() is a quick way 
-to get current thread id if you don't have your thread handy.
+This will return the id of the thread.  Thread IDs are integers, with the
+main thread in a program being 0.  Currently Perl assigns a unique tid to
+every thread ever created in your program, assigning the first thread to
+be created a tid of 1, and increasing the tid by 1 for each new thread
+that's created.
+
+NB the class method C<< threads->tid() >> is a quick way to get the
+current thread id if you don't have your thread object handy.
 
 =item threads->yield();
 
-This will tell the OS to let this thread yield CPU time to other threads.
-However this is highly depending on the underlying thread implementation.
+This is a suggestion to the OS to let this thread yield CPU time to other
+threads.  What actually happens is highly dependent upon the underlying
+thread implementation.
 
 You may do C<use threads qw(yield)> then use just a bare C<yield> in your
 code.
@@ -174,7 +183,7 @@ This will return a list of all non joined, non detached threads.
 
 C<async> creates a thread to execute the block immediately following
 it.  This block is treated as an anonymous sub, and so must have a
-semi-colon after the closing brace. Like C<threads-&gt;new>, C<async>
+semi-colon after the closing brace. Like C<< threads->new >>, C<async>
 returns a thread object.
 
 =back
@@ -194,11 +203,11 @@ exit from then main thread.
 
 =head1 BUGS / TODO
 
-The current implmentation of threads has been an attempt to get
+The current implementation of threads has been an attempt to get
 a correct threading system working that could be built on, 
 and optimized, in newer versions of perl.
 
-Current the overhead of creating a thread is rather large,
+Currently the overhead of creating a thread is rather large,
 also the cost of returning values can be large. These are areas
 were there most likely will be work done to optimize what data
 that needs to be cloned.
diff --git a/handy.h b/handy.h
index 2077007..fe29019 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -578,8 +578,12 @@ destination, C<nitems> is the number of items, and C<type> is the type.
 =for apidoc Am|void|StructCopy|type src|type dest|type
 This is an architecture-independent macro to copy one structure to another.
 
-=cut
-*/
+=for apidoc Am|void|Poison|void* dest|int nitems|type
+
+Fill up memory with a pattern (byte 0xAB over and over again) that
+hopefully catches attempts to access uninitialized memory.
+
+=cut */
 
 #ifndef lint
 
@@ -623,6 +627,8 @@ extern long lastxycount[MAXXCOUNT][MAXYCOUNT];
 #define Copy(s,d,n,t)  (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
 #define Zero(d,n,t)    (void)memzero((char*)(d), (n) * sizeof(t))
 
+#define Poison(d,n,t)  (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+
 #else /* lint */
 
 #define New(x,v,n,s)   (v = Null(s *))
@@ -632,6 +638,7 @@ extern long lastxycount[MAXXCOUNT][MAXYCOUNT];
 #define Move(s,d,n,t)
 #define Copy(s,d,n,t)
 #define Zero(d,n,t)
+#define Poison(d,n,t)
 #define Safefree(d)    (d) = (d)
 
 #endif /* lint */
index 175c9c6..cda764f 100644 (file)
@@ -549,7 +549,7 @@ sub timeit {
     if ($cache && exists $cache{$cache_key} ) {
        $wn = $cache{$cache_key};
     } else {
-       $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
+       $wn = &runloop($n, ref( $code ) ? sub { } : '' );
        # Can't let our baseline have any iterations, or they get subtracted
        # out of the result.
        $wn->[5] = 0;
index bd34720..12262d1 100644 (file)
@@ -1,3 +1,7 @@
+5.95_01 Sat May 18 14:40:12 EDT 2002
+    - Fixed ExtUtils::testlib so it has a reasonable chance of working
+      under taint mode.
+
 5.94_02 Fri May 17 17:16:04 EDT 2002
     - Fixing Manifest.t test for relative @INC when core testing.
 
index cf650c4..38871a4 100644 (file)
@@ -2,10 +2,10 @@ package ExtUtils::MakeMaker;
 
 BEGIN {require 5.005_03;}
 
-$VERSION = "5.94_02";
+$VERSION = "5.95_01";
 $Version_OK = "5.49";   # Makefiles older than $Version_OK will die
                         # (Will be checked from MakeMaker version 4.13 onwards)
-($Revision = substr(q$Revision: 1.51 $, 10)) =~ s/\s+$//;
+($Revision = substr(q$Revision: 1.53 $, 10)) =~ s/\s+$//;
 
 require Exporter;
 use Config;
@@ -1817,7 +1817,7 @@ MakeMaker object. The following lines will be parsed o.k.:
 
     $VERSION = '1.00';
     *VERSION = \'1.01';
-    ( $VERSION ) = '$Revision: 1.51 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    ( $VERSION ) = '$Revision: 1.53 $ ' =~ /\$Revision:\s+([^\s]+)/;
     $FOO::VERSION = '1.10';
     *FOO::VERSION = \'1.11';
     our $VERSION = 1.2.3;       # new for perl5.6.0 
index be4d15a..d31396e 100644 (file)
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl -Tw
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
@@ -6,12 +6,13 @@ BEGIN {
         @INC = '../lib';
     }
     else {
-        unshift @INC, 't/lib';
+        # ./lib is there so t/lib can be seen even after we chdir.
+        unshift @INC, 't/lib', './lib';
     }
 }
 chdir 't';
 
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 BEGIN { 
     # non-core tests will have blib in their path.  We remove it
@@ -29,3 +30,5 @@ use_ok( 'ExtUtils::testlib' );
 
 @blib_paths = grep { /blib/ } @INC;
 is( @blib_paths, 2, 'ExtUtils::testlib added two @INC dirs!' );
+ok( !(grep !File::Spec->file_name_is_absolute($_), @blib_paths),
+                    '  and theyre absolute');
index 6ea13ca..3f93135 100644 (file)
@@ -1,9 +1,13 @@
 package ExtUtils::testlib;
-$VERSION = 1.12_01;
+$VERSION = 1.13_01;
 
-# So the tests can chdir around and not break @INC.
+use Cwd;
 use File::Spec;
-use lib map File::Spec->rel2abs($_), qw(blib/arch blib/lib);
+
+# So the tests can chdir around and not break @INC.
+# We use getcwd() because otherwise rel2abs will blow up under taint
+# mode pre-5.8
+use lib map File::Spec->rel2abs($_, getcwd()), qw(blib/arch blib/lib);
 1;
 __END__
 
index b78ec63..987c150 100644 (file)
@@ -37,7 +37,7 @@ use Pod::Html;
 open(POD, "<$$.pod") or die "$$.pod: $!";
 open(IN,  ">$$.in")  or die "$$.in: $!";
 while (<POD>) {
-  s/[\r\n]+/\r/gs;
+  s/[\r\n]+/\r/g;
   print IN $_;
 }
 close(POD);
@@ -50,7 +50,7 @@ pod2html("--title=eol", "--infile=$$.in", "--outfile=$$.o1");
 open(POD, "<$$.pod") or die "$$.pod: $!";
 open(IN,  ">$$.in")  or die "$$.in: $!";
 while (<POD>) {
-  s/[\r\n]+/\n/gs;
+  s/[\r\n]+/\n/g;
   print IN $_;
 }
 close(POD);
@@ -63,7 +63,7 @@ pod2html("--title=eol", "--infile=$$.in", "--outfile=$$.o2");
 open(POD, "<$$.pod") or die "$$.pod: $!";
 open(IN,  ">$$.in")  or die "$$.in: $!";
 while (<POD>) {
-  s/[\r\n]+/\r\n/gs;
+  s/[\r\n]+/\r\n/g;
   print IN $_;
 }
 close(POD);
index a5c337a..aab99fb 100644 (file)
@@ -208,6 +208,13 @@ and these
     use open ':encoding(iso-8859-7)';
     use open IO => ':encoding(iso-8859-7)';
 
+The matching of encoding names is loose: case does not matter, and
+many encodings have several aliases.  See L<Encode::Supported> for
+details and the list of supported locales.
+
+Note that C<:utf8> discipline must always be specified exactly like
+that, it is not subject to the loose matching of encoding names.
+
 When open() is given an explicit list of layers they are appended to
 the list declared using this pragma.
 
index 7f7e175..5cb6eff 100644 (file)
@@ -1,4 +1,5 @@
 
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 # This file was created by warnings.pl
 # Any changes made here will be lost.
 #
@@ -129,6 +130,9 @@ See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 use Carp ;
 
 %Offsets = (
+
+    # Warnings Categories added in Perl 5.008
+
     'all'              => 0,
     'closure'          => 2,
     'deprecated'       => 4,
@@ -169,16 +173,17 @@ use Carp ;
     'reserved'         => 74,
     'semicolon'                => 76,
     'taint'            => 78,
-    'uninitialized'    => 80,
-    'unpack'           => 82,
-    'untie'            => 84,
-    'utf8'             => 86,
-    'void'             => 88,
-    'y2k'              => 90,
+    'threads'          => 80,
+    'uninitialized'    => 82,
+    'unpack'           => 84,
+    'untie'            => 86,
+    'utf8'             => 88,
+    'void'             => 90,
+    'y2k'              => 92,
   );
 
 %Bits = (
-    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..45]
+    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
     'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
     'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
     'closed'           => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -217,17 +222,18 @@ use Carp ;
     'substr'           => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
     'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
     'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
     'unopened'         => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
-    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
   );
 
 %DeadBits = (
-    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..45]
+    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
     'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
     'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
     'closed'           => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -266,17 +272,18 @@ use Carp ;
     'substr'           => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
     'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
     'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
     'unopened'         => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
-    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
   );
 
 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 92 ;
+$LAST_BIT = 94 ;
 $BYTES    = 12 ;
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
@@ -419,4 +426,5 @@ sub warnif
 
     carp($message) ;
 }
+
 1;
index cba5a92..0b46eb7 100644 (file)
@@ -79,7 +79,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static char    *local_patches[] = {
         NULL
-       ,"DEVEL16653"
+       ,"DEVEL16693"
        ,NULL
 };
 
index affe329..0842096 100644 (file)
@@ -1487,6 +1487,16 @@ memory is zeroed with C<memzero>.
 =for hackers
 Found in file handy.h
 
+=item Poison
+
+Fill up memory with a pattern (byte 0xAB over and over again) that
+hopefully catches attempts to access uninitialized memory.
+
+       void    Poison(void* dest, int nitems, type)
+
+=for hackers
+Found in file handy.h
+
 =item Renew
 
 The XSUB-writer's interface to the C C<realloc> function.
index 7c527a9..e89a67a 100644 (file)
@@ -132,6 +132,16 @@ instead of raw C<char *> strings:
 Note also the existence of C<sv_catpvf> and C<sv_vcatpvfn>, combining
 concatenation with formatting.
 
+Sometimes instead of zeroing the allocated heap by using Newz() you
+should consider "poisoning" the data.  This means writing a bit
+pattern into it that should be illegal as pointers (and floating point
+numbers), and also hopefully surprising enough as integers, so that
+any code attempting to use the data without forethought will break
+sooner rather than later.  Poisoning can be done using the Poison()
+macro, which has similar arguments as Zero():
+
+    Poison(dst, n, t)
+
 =head2 Character Class Tests
 
 There are two types of character class tests that Perl implements: one
index 65f4612..84892f0 100644 (file)
@@ -898,8 +898,8 @@ C<Storable> gives persistence to Perl data structures by allowing the
 storage and retrieval of Perl data to and from files in a fast and
 compact binary format.  Because in effect Storable does serialisation
 of Perl data structues, with it you can also clone deep, hierarchical
-datastructures.  Storable was created by Raphael Manfredi but it is
-now maintained by the Perl development team.  Storable has been
+datastructures.  Storable was originally created by Raphael Manfredi,
+but it is now maintained by Abhijit Menon-Sen.  Storable has been
 enhanced to understand the two new hash features, Unicode keys and
 restricted hashes.  See L<Storable>.
 
@@ -1870,7 +1870,9 @@ The autouse pragma didn't work for Multi::Part::Function::Names.
 =item *
 
 caller() could cause core dumps in certain situations.  Carp was sometimes
-affected by this problem.
+affected by this problem.  In particular, caller() now returns a
+subroutine name of C<(unknown)> for subroutines that have been removed
+from the symbol table.
 
 =item *
 
index faf360d..2d34e0b 100644 (file)
@@ -1169,6 +1169,29 @@ in the regular expression engine; or rewriting the regular expression so
 that it is simpler or backtracks less.  (See L<perlfaq2> for information
 on I<Mastering Regular Expressions>.)
 
+=item cond_broadcast() called on unlocked variable
+
+(W threads) Within a thread-enabled program, you tried to call
+cond_broadcast() on a variable which wasn't locked. The cond_broadcast()
+function  is used to wake up another thread that is waiting in a
+cond_wait(). To ensure that the signal isn't sent before the other thread
+has a chance to enter the wait, it is usual for the signaling thread to
+first wait for a lock on variable. This lock attempt will only succeed
+after the other thread has entered cond_wait() and thus relinquished the
+lock.
+
+
+=item cond_signal() called on unlocked variable
+
+(W threads) Within a thread-enabled program, you tried to call
+cond_signal() on a variable which wasn't locked. The cond_signal()
+function  is used to wake up another thread that is waiting in a
+cond_wait(). To ensure that the signal isn't sent before the other thread
+has a chance to enter the wait, it is usual for the signaling thread to
+first wait for a lock on variable. This lock attempt will only succeed
+after the other thread has entered cond_wait() and thus relinquished the
+lock.
+
 =item connect() on closed socket %s
 
 (W closed) You tried to do a connect on a closed socket.  Did you forget
index 52de7fd..d5873a4 100644 (file)
@@ -554,11 +554,13 @@ C<$is_require> are set: C<$is_require> is true if the frame is created by a
 C<require> or C<use> statement, $evaltext contains the text of the
 C<eval EXPR> statement.  In particular, for an C<eval BLOCK> statement,
 $filename is C<(eval)>, but $evaltext is undefined.  (Note also that
-each C<use> statement creates a C<require> frame inside an C<eval EXPR>)
-frame.  C<$hasargs> is true if a new instance of C<@_> was set up for the
-frame.  C<$hints> and C<$bitmask> contain pragmatic hints that the caller
-was compiled with.  The C<$hints> and C<$bitmask> values are subject to
-change between versions of Perl, and are not meant for external use.
+each C<use> statement creates a C<require> frame inside an C<eval EXPR>
+frame.)  $subroutine may also be C<(unknown)> if this particular
+subroutine happens to have been deleted from the symbol table.
+C<$hasargs> is true if a new instance of C<@_> was set up for the frame.
+C<$hints> and C<$bitmask> contain pragmatic hints that the caller was
+compiled with.  The C<$hints> and C<$bitmask> values are subject to change
+between versions of Perl, and are not meant for external use.
 
 Furthermore, when called from within the DB package, caller returns more
 detailed information: it sets the list variable C<@DB::args> to be the
index aea346b..66023bd 100644 (file)
@@ -2291,6 +2291,11 @@ Alternatively edit the init file interactively via:
 Note: you can define up to 20 conversion shortcuts in the gdb
 section.
 
+=item *
+
+If you see in a debugger a memory area mysteriously full of 0xabababab,
+you may be seeing the effect of the Poison() macro, see L<perlclib>.
+
 =back
 
 =head2 CONCLUSION
index 0edb2bc..7b3ce3c 100644 (file)
@@ -285,6 +285,8 @@ The current hierarchy is:
        |
        +- taint
        |
+       +- threads
+       |
        +- uninitialized
        |
        +- unpack
index 3a68707..a1ecea7 100644 (file)
@@ -53,6 +53,10 @@ The following pragmas are defined (and have their own documentation).
 
 Get/set subroutine or variable attributes
 
+=item attrs
+
+Set/get attributes of a subroutine (deprecated)
+
 =item autouse
 
 Postpone load of modules until a function is used
@@ -83,7 +87,7 @@ Force byte semantics rather than character semantics
 
 =item charnames
 
-Define character names for C<\N{named}> string literal escapes.
+Define character names for C<\N{named}> string literal escapes
 
 =item constant
 
@@ -95,7 +99,7 @@ Perl compiler pragma to force verbose warning diagnostics
 
 =item encoding
 
-Pragma to control the conversion of legacy data into Unicode
+Allows you to write your script in non-ascii or non-utf8
 
 =item fields
 
@@ -125,6 +129,10 @@ Use and avoid POSIX locales for built-in operations
 
 Set default disciplines for input and output
 
+=item ops
+
+Restrict unsafe operations when compiling
+
 =item overload
 
 Package for overloading perl operations
@@ -149,6 +157,10 @@ Restrict unsafe constructs
 
 Predeclare sub names
 
+=item threads
+
+Perl extension allowing use of interpreter based threads from perl
+
 =item utf8
 
 Enable/disable UTF-8 (or UTF-EBCDIC) in source code
@@ -195,10 +207,82 @@ Load subroutines only on demand
 
 Split a package for autoloading
 
+=item B
+
+The Perl Compiler
+
+=item B::Asmdata
+
+Autogenerated data about Perl ops, used to generate bytecode
+
+=item B::Assembler
+
+Assemble Perl bytecode
+
+=item B::Bblock
+
+Walk basic blocks
+
+=item B::Bytecode
+
+Perl compiler's bytecode backend
+
+=item B::C
+
+Perl compiler's C backend
+
+=item B::CC
+
+Perl compiler's optimized C translation backend
+
+=item B::Concise
+
+Walk Perl syntax tree, printing concise info about ops
+
+=item B::Debug
+
+Walk Perl syntax tree, printing debug info about ops
+
+=item B::Deparse
+
+Perl compiler backend to produce perl code
+
+=item B::Disassembler
+
+Disassemble Perl bytecode
+
+=item B::Lint
+
+Perl lint
+
+=item B::Showlex
+
+Show lexical variables used in functions or files
+
+=item B::Stackobj
+
+Helper module for CC backend
+
+=item B::Stash
+
+Show what stashes are loaded
+
+=item B::Terse
+
+Walk Perl syntax tree, printing terse info about ops
+
+=item B::Xref
+
+Generates cross reference reports for Perl programs
+
 =item Benchmark
 
 Benchmark running times of Perl code
 
+=item ByteLoader
+
+Load byte compiled perl code
+
 =item CGI
 
 Simple Common Gateway Interface Class
@@ -271,6 +355,10 @@ Get pathname of current working directory
 
 Programmatic interface to the Perl debugging API (draft, subject to
 
+=item DB_File
+
+Perl5 access to Berkeley DB version 1.x
+
 =item Devel::SelfStubber
 
 Generate stubs for a SelfLoading module
@@ -287,6 +375,10 @@ Supply object methods for directory handles
 
 Provides screen dump of Perl data.
 
+=item Encode
+
+Character encodings
+
 =item English
 
 Use nice English (or awk) names for ugly punctuation variables
@@ -307,6 +399,10 @@ Exporter guts
 
 Utilities to replace common UNIX commands in Makefiles etc.
 
+=item ExtUtils::Command::MM
+
+Commands for the MM's to use in Makefiles
+
 =item ExtUtils::Constant
 
 Generate XS code to import C header constants
@@ -327,6 +423,14 @@ Inventory management of installed modules
 
 Determine libraries to use and how to use them
 
+=item ExtUtils::MM
+
+OS adjusted ExtUtils::MakeMaker subclass
+
+=item ExtUtils::MM_Any
+
+Platform agnostic MM methods
+
 =item ExtUtils::MM_BeOS
 
 Methods to override UN*X behaviour in ExtUtils::MakeMaker
@@ -335,6 +439,14 @@ Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
 Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
+=item ExtUtils::MM_DOS
+
+DOS specific subclass of ExtUtils::MM_Unix
+
+=item ExtUtils::MM_MacOS
+
+Methods to override UN*X behaviour in ExtUtils::MakeMaker
+
 =item ExtUtils::MM_NW5
 
 Methods to override UN*X behaviour in ExtUtils::MakeMaker
@@ -343,6 +455,10 @@ Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
 Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
+=item ExtUtils::MM_UWIN
+
+U/WIN specific subclass of ExtUtils::MM_Unix
+
 =item ExtUtils::MM_Unix
 
 Methods used by ExtUtils::MakeMaker
@@ -355,6 +471,14 @@ Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
 Methods to override UN*X behaviour in ExtUtils::MakeMaker
 
+=item ExtUtils::MM_Win95
+
+Method to customize MakeMaker for Win9X
+
+=item ExtUtils::MY
+
+ExtUtils::MakeMaker subclass for customization
+
 =item ExtUtils::MakeMaker
 
 Create an extension Makefile
@@ -383,6 +507,10 @@ Add blib/* directories to @INC
 
 Replace functions with equivalents which succeed or die
 
+=item Fcntl
+
+Load the C Fcntl.h defines
+
 =item File::Basename
 
 Split a pathname into pieces
@@ -495,6 +623,10 @@ Functions for dealing with RFC3066-style language tags
 
 Tags and names for human languages
 
+=item IO
+
+Load various IO modules
+
 =item IPC::Open2
 
 Open a process for both reading and writing
@@ -557,7 +689,7 @@ Trigonometric functions
 
 =item Memoize
 
-Make your functions faster by trading space for time
+Make functions faster by trading space for time
 
 =item Memoize::AnyDBM_File
 
@@ -587,6 +719,10 @@ Glue to provide EXISTS for SDBM_File for Storable use
 
 Store Memoized data in Storable database
 
+=item NDBM_File
+
+Tied access to ndbm files
+
 =item NEXT
 
 Provide a pseudo-class NEXT that allows method redispatch
@@ -651,6 +787,22 @@ By-name interface to Perl's built-in getproto*() functions
 
 By-name interface to Perl's built-in getserv*() functions
 
+=item O
+
+Generic interface to Perl Compiler backends
+
+=item ODBM_File
+
+Tied access to odbm files
+
+=item Opcode
+
+Disable named opcodes when compiling perl code
+
+=item POSIX
+
+Perl interface to IEEE Std 1003.1
+
 =item PerlIO
 
 On demand loader for PerlIO layers and root of PerlIO::* name space
@@ -727,6 +879,14 @@ Print a usage message from embedded pod documentation
 
 Test of various basic POD features in translators.
 
+=item SDBM_File
+
+Tied access to sdbm files
+
+=item Safe
+
+Compile and execute code in restricted compartments
+
 =item Search::Dict
 
 Search for key in dictionary file
@@ -743,6 +903,14 @@ Load functions only on demand
 
 Run shell commands transparently within perl
 
+=item Socket
+
+Load the C socket.h defines and structure manipulators 
+
+=item Storable
+
+Persistence for Perl data structures
+
 =item Switch
 
 A switch statement for Perl
@@ -831,6 +999,14 @@ Line wrapping to form simple paragraphs
 
 Manipulate threads in Perl
 
+=item Thread::Queue
+
+Thread-safe queues
+
+=item Thread::Semaphore
+
+Thread-safe semaphores
+
 =item Tie::Array
 
 Base class for tied arrays
@@ -885,7 +1061,7 @@ Base class for ALL classes (blessed references)
 
 =item Unicode::Collate
 
-Use UCA (Unicode Collation Algorithm)
+Unicode Collation Algorithm
 
 =item Unicode::UCD
 
index d2c48e2..38cd9c7 100644 (file)
@@ -162,7 +162,7 @@ Named Unicode properties, scripts, and block ranges may be used like
 character classes via the new C<\p{}> (matches property) and C<\P{}>
 (doesn't match property) constructs. For instance, C<\p{Lu}> matches any
 character with the Unicode "Lu" (Letter, uppercase) property, while
-C<\p{M}> matches any character with a "M" (mark -- accents and such)
+C<\p{M}> matches any character with an "M" (mark -- accents and such)
 property. Single letter properties may omit the brackets, so that can be
 written C<\pM> also. Many predefined properties are available, such
 as C<\p{Mirrored}> and C<\p{Tibetan}>.
@@ -814,11 +814,11 @@ The following table is from Unicode 3.2.
 
    U+0000..U+007F       00..7F
    U+0080..U+07FF       C2..DF    80..BF
-   U+0800..U+0FFF       E0        A0..BF    80..BF  
-   U+1000..U+CFFF       E1..EC    80..BF    80..BF  
-   U+D000..U+D7FF       ED        80..9F    80..BF  
+   U+0800..U+0FFF       E0        A0..BF    80..BF
+   U+1000..U+CFFF       E1..EC    80..BF    80..BF
+   U+D000..U+D7FF       ED        80..9F    80..BF
    U+D800..U+DFFF       ******* ill-formed *******
-   U+E000..U+FFFF       EE..EF    80..BF    80..BF  
+   U+E000..U+FFFF       EE..EF    80..BF    80..BF
   U+10000..U+3FFFF      F0        90..BF    80..BF    80..BF
   U+40000..U+FFFFF      F1..F3    80..BF    80..BF    80..BF
  U+100000..U+10FFFF     F4        80..8F    80..BF    80..BF
@@ -857,15 +857,15 @@ UTF-16, UTF-16BE, UTF16-LE, Surrogates, and BOMs (Byte Order Marks)
 use them internally.)
 
 UTF-16 is a 2 or 4 byte encoding.  The Unicode code points
-0x0000..0xFFFF are stored in two 16-bit units, and the code points
-0x010000..0x10FFFF in two 16-bit units.  The latter case is
+U+0000..U+FFFF are stored in a single 16-bit unit, and the code points
+U+10000..U+10FFFF in two 16-bit units.  The latter case is
 using I<surrogates>, the first 16-bit unit being the I<high
 surrogate>, and the second being the I<low surrogate>.
 
-Surrogates are code points set aside to encode the 0x01000..0x10FFFF
+Surrogates are code points set aside to encode the U+10000..U+10FFFF
 range of Unicode code points in pairs of 16-bit units.  The I<high
-surrogates> are the range 0xD800..0xDBFF, and the I<low surrogates>
-are the range 0xDC00..0xDFFFF.  The surrogate encoding is
+surrogates> are the range U+D800..U+DBFF, and the I<low surrogates>
+are the range U+DC00..U+DFFF.  The surrogate encoding is
 
        $hi = ($uni - 0x10000) / 0x400 + 0xD800;
        $lo = ($uni - 0x10000) % 0x400 + 0xDC00;
@@ -888,7 +888,7 @@ This introduces another problem: what if you just know that your data
 is UTF-16, but you don't know which endianness?  Byte Order Marks
 (BOMs) are a solution to this.  A special character has been reserved
 in Unicode to function as a byte order marker: the character with the
-code point 0xFEFF is the BOM.
+code point U+FEFF is the BOM.
 
 The trick is that if you read a BOM, you will know the byte order,
 since if it was written on a big endian platform, you will read the
@@ -897,9 +897,9 @@ you will read the bytes 0xFF 0xFE.  (And if the originating platform
 was writing in UTF-8, you will read the bytes 0xEF 0xBB 0xBF.)
 
 The way this trick works is that the character with the code point
-0xFFFE is guaranteed not to be a valid Unicode character, so the
+U+FFFE is guaranteed not to be a valid Unicode character, so the
 sequence of bytes 0xFF 0xFE is unambiguously "BOM, represented in
-little-endian format" and cannot be "0xFFFE, represented in big-endian
+little-endian format" and cannot be "U+FFFE, represented in big-endian
 format".
 
 =item *
@@ -916,7 +916,7 @@ needed.  The BOM signatures will be 0x00 0x00 0xFE 0xFF for BE and
 UCS-2, UCS-4
 
 Encodings defined by the ISO 10646 standard.  UCS-2 is a 16-bit
-encoding.  Unlike UTF-16, UCS-2 is not extensible beyond 0xFFFF,
+encoding.  Unlike UTF-16, UCS-2 is not extensible beyond U+FFFF,
 because it does not use surrogates.  UCS-4 is a 32-bit encoding,
 functionally identical to UTF-32.
 
index d6eae60..68fb0fa 100644 (file)
@@ -302,17 +302,28 @@ To ensure that the output is explicitly rendered in the encoding you
 desire (and to avoid the warning), open the stream with the desired
 encoding. Some examples:
 
-    open FH, ">:ucs2",      "file"
-    open FH, ">:utf8",      "file";
-    open FH, ">:Shift-JIS", "file";
+    open FH, ">:utf8", "file";
+
+    open FH, ">:encoding(ucs2)",      "file";
+    open FH, ">:encoding(UTF-8)",     "file";
+    open FH, ">:encoding(shift_jis)", "file";
 
 and on already open streams use C<binmode()>:
 
-    binmode(STDOUT, ":ucs2");
     binmode(STDOUT, ":utf8");
-    binmode(STDOUT, ":Shift-JIS");
 
-See documentation for the C<Encode> module for many supported encodings.
+    binmode(STDOUT, ":encoding(ucs2)");
+    binmode(STDOUT, ":encoding(UTF-8)");
+    binmode(STDOUT, ":encoding(shift_jis)");
+
+The matching of encoding names is loose: case does not matter, and
+many encodings have several aliases.  Note that C<:utf8> discipline
+must always be specified exactly like that, it is not subject to the
+loose matching of encoding names.
+
+See L<PerlIO> for the C<:utf8> layer;
+L<PerlIO::encoding> and L<Encode::PerlIO> for the C<:encoding()> layer;
+L<Encode::Supported> for many encodings supported by the C<Encode> module.
 
 Reading in a file that you know happens to be encoded in one of the
 Unicode encodings does not magically turn the data into Unicode in
@@ -322,7 +333,7 @@ opening files
     open(my $fh,'<:utf8', 'anything');
     my $line_of_unicode = <$fh>;
 
-    open(my $fh,'<:Big5', 'anything');
+    open(my $fh,'<:encoding(Big5)', 'anything');
     my $line_of_unicode = <$fh>;
 
 The I/O disciplines can also be specified more flexibly with
@@ -719,7 +730,7 @@ well-formed Unicode data by C<pack("U*", 0xff, ...)>.
 
 How Do I Display Unicode?  How Do I Input Unicode?
 
-See http://www.hclrss.demon.co.uk/unicode/ and
+See http://www.alanwood.net/unicode/ and
 http://www.cl.cam.ac.uk/~mgk25/unicode.html
 
 =item 
@@ -737,7 +748,8 @@ The Unicode standard prefers using hexadecimal notation because that
 shows better the division of Unicode into blocks of 256 characters.
 Hexadecimal is also simply shorter than decimal.  You can use decimal
 notation, too, but learning to use hexadecimal just makes life easier
-with the Unicode standard.
+with the Unicode standard.  The "U+HHHH" notation uses hexadecimal,
+for example.
 
 The C<0x> prefix means a hexadecimal number, the digits are 0-9 I<and>
 a-f (or A-F, case doesn't matter).  Each hexadecimal digit represents
@@ -792,7 +804,7 @@ Unicode Useful Resources
 
 Unicode and Multilingual Support in HTML, Fonts, Web Browsers and Other Applications
 
-    http://www.hclrss.demon.co.uk/unicode/
+    http://www.alanwood.net/unicode/
 
 =item *
 
@@ -825,11 +837,6 @@ Perl 5.6.1.)  You can find the C<$Config{installprivlib}> by
 
     perl "-V:installprivlib"
 
-Note that some of the files have been renamed from the Unicode
-standard since the Perl installation tries to live by the "8.3"
-filenaming restrictions.  The renamings are shown in the
-accompanying F<rename> file.
-
 You can explore various information from the Unicode data files using
 the C<Unicode::UCD> module.
 
diff --git a/scope.c b/scope.c
index 4ff903f..673b64c 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -80,17 +80,22 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
     si->si_cxmax = cxitems - 1;
     si->si_cxix = -1;
     si->si_type = PERLSI_UNDEF;
-    /* Needs to be Newz() because PUSHSUBST() in pp_subst()
-     * might otherwise read uninitialized heap. */
-    Newz(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+    New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+    /* Without any kind of initialising PUSHSUBST()
+     * in pp_subst() will read uninitialised heap. */
+    Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
     return si;
 }
 
 I32
 Perl_cxinc(pTHX)
 {
+    IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
+    /* Without any kind of initialising deep enough recursion
+     * will end up reading uninitialised PERL_CONTEXTs. */
+    Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
     return cxstack_ix + 1;
 }
 
diff --git a/sv.c b/sv.c
index ff53fae..ed40f68 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9711,7 +9711,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PERL_SET_THX(my_perl);
 
 #  ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
@@ -9742,7 +9742,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 
 #    ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
index dc823ed..374813c 100755 (executable)
@@ -4,19 +4,26 @@
 # test recursive functions.
 #
 
-print "1..25\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(. ../lib);
+    require "test.pl";
+    plan(tests => 26);
+}
+
+use strict;
 
-sub gcd ($$) {
+sub gcd {
     return gcd($_[0] - $_[1], $_[1]) if ($_[0] > $_[1]);
     return gcd($_[0], $_[1] - $_[0]) if ($_[0] < $_[1]);
     $_[0];
 }
 
-sub factorial ($) {
+sub factorial {
     $_[0] < 2 ? 1 : $_[0] * factorial($_[0] - 1);
 }
 
-sub fibonacci ($) {
+sub fibonacci {
     $_[0] < 2 ? 1 : fibonacci($_[0] - 2) + fibonacci($_[0] - 1);
 }
 
@@ -26,7 +33,7 @@ sub fibonacci ($) {
 # For example ackermann(4,1) will take quite a long time.
 # It will simply eat away your memory. Trust me.
 
-sub ackermann ($$) {
+sub ackermann {
     return $_[1] + 1               if ($_[0] == 0);
     return ackermann($_[0] - 1, 1) if ($_[1] == 0);
     ackermann($_[0] - 1, ackermann($_[0], $_[1] - 1));
@@ -34,7 +41,7 @@ sub ackermann ($$) {
 
 # Highly recursive, highly boring.
 
-sub takeuchi ($$$) {
+sub takeuchi {
     $_[1] < $_[0] ?
        takeuchi(takeuchi($_[0] - 1, $_[1], $_[2]),
                 takeuchi($_[1] - 1, $_[2], $_[0]),
@@ -42,48 +49,30 @@ sub takeuchi ($$$) {
            : $_[2];
 }
 
-print 'not ' unless (($d = gcd(1147, 1271)) == 31);
-print "ok 1\n";
-print "# gcd(1147, 1271) = $d\n";
-
-print 'not ' unless (($d = gcd(1908, 2016)) == 36);
-print "ok 2\n";
-print "# gcd(1908, 2016) = $d\n";
+is(gcd(1147, 1271), 31, "gcd(1147, 1271) == 31");
 
-print 'not ' unless (($f = factorial(10)) == 3628800);
-print "ok 3\n";
-print "# factorial(10) = $f\n";
+is(gcd(1908, 2016), 36, "gcd(1908, 2016) == 36");
 
-print 'not ' unless (($f = factorial(factorial(3))) == 720);
-print "ok 4\n";
-print "# factorial(factorial(3)) = $f\n";
+is(factorial(10), 3628800, "factorial(10) == 3628800");
 
-print 'not ' unless (($f = fibonacci(10)) == 89);
-print "ok 5\n";
-print "# fibonacci(10) = $f\n";
+is(factorial(factorial(3)), 720, "factorial(factorial(3)) == 720");
 
-print 'not ' unless (($f = fibonacci(fibonacci(7))) == 17711);
-print "ok 6\n";
-print "# fibonacci(fibonacci(7)) = $f\n";
+is(fibonacci(10), 89, "fibonacci(10) == 89");
 
-$i = 7;
+is(fibonacci(fibonacci(7)), 17711, "fibonacci(fibonacci(7)) == 17711");
 
-@ack = qw(1 2 3 4 2 3 4 5 3 5 7 9 5 13 29 61);
+my @ack = qw(1 2 3 4 2 3 4 5 3 5 7 9 5 13 29 61);
 
-for $x (0..3) { 
-    for $y (0..3) {
-       $a = ackermann($x, $y);
-       print 'not ' unless ($a == shift(@ack));
-       print "ok ", $i++, "\n";
-       print "# ackermann($x, $y) = $a\n";
+for my $x (0..3) { 
+    for my $y (0..3) {
+       my $a = ackermann($x, $y);
+       is($a, shift(@ack), "ackermann($x, $y) == $a");
     }
 }
 
-($x, $y, $z) = (18, 12, 6);
+my ($x, $y, $z) = (18, 12, 6);
 
-print 'not ' unless (($t = takeuchi($x, $y, $z)) == $z + 1);
-print "ok ", $i++, "\n";
-print "# takeuchi($x, $y, $z) = $t\n";
+is(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1");
 
 {
     sub get_first1 {
@@ -91,12 +80,12 @@ print "# takeuchi($x, $y, $z) = $t\n";
     }
 
     sub get_list1 {
-       return [24] unless $_[0];
+       return [curr_test] unless $_[0];
        my $u = get_first1(0);
        [$u];
     }
     my $x = get_first1(1);
-    print "ok $x\n";
+    ok($x, "premature FREETMPS (change 5699)");
 }
 
 {
@@ -105,12 +94,24 @@ print "# takeuchi($x, $y, $z) = $t\n";
     }
 
     sub get_list2 {
-       return [25] unless $_[0];
+       return [curr_test] unless $_[0];
        my $u = get_first2(0);
        return [$u];
     }
     my $x = get_first2(1);
-    print "ok $x\n";
+    ok($x, "premature FREETMPS (change 5699)");
+}
+
+{
+    local $^W = 0; # We do not need recursion depth warning.
+
+    sub sillysum {
+       return $_[0] + ($_[0] > 0 ? sillysum($_[0] - 1) : 0);
+    }
+
+    is(sillysum(1000), 1000*1001/2, "recursive sum of 1..1000");
 }
 
-$i = 26;
+
+
+
diff --git a/util.c b/util.c
index ad91f01..3e7b6d3 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3121,7 +3121,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     SvCUR_set(sv, sizeof(struct perl_thread));
     thr = (Thread) SvPVX(sv);
 #ifdef DEBUGGING
-    memset(thr, 0xab, sizeof(struct perl_thread));
+    Poison(thr, 1, struct perl_thread);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
index 3da705e..02c3cc2 100644 (file)
@@ -22,6 +22,9 @@
 
 #define specialWARN(x)         ((x) == pWARN_STD || (x) == pWARN_ALL ||        \
                                 (x) == pWARN_NONE)
+
+/* Warnings Categories added in Perl 5.008 */
+
 #define WARN_ALL               0
 #define WARN_CLOSURE           1
 #define WARN_DEPRECATED                2
 #define WARN_RESERVED          37
 #define WARN_SEMICOLON         38
 #define WARN_TAINT             39
-#define WARN_UNINITIALIZED     40
-#define WARN_UNPACK            41
-#define WARN_UNTIE             42
-#define WARN_UTF8              43
-#define WARN_VOID              44
-#define WARN_Y2K               45
+#define WARN_THREADS           40
+#define WARN_UNINITIALIZED     41
+#define WARN_UNPACK            42
+#define WARN_UNTIE             43
+#define WARN_UTF8              44
+#define WARN_VOID              45
+#define WARN_Y2K               46
 
 #define WARNsize               12
 #define WARN_ALLstring         "\125\125\125\125\125\125\125\125\125\125\125\125"
index caa4954..75778a1 100644 (file)
@@ -13,57 +13,60 @@ sub DEFAULT_OFF () { 2 }
 
 my $tree = {
 
-'all' => {
-               'io'            => {    'pipe'          => DEFAULT_OFF,
-                                       'unopened'      => DEFAULT_OFF,
-                                       'closed'        => DEFAULT_OFF,
-                                       'newline'       => DEFAULT_OFF,
-                                       'exec'          => DEFAULT_OFF,
-                                       'layer'         => DEFAULT_OFF,
-                          },
-               'syntax'        => {    'ambiguous'     => DEFAULT_OFF,
-                               'semicolon'     => DEFAULT_OFF,
-                               'precedence'    => DEFAULT_OFF,
-                               'bareword'      => DEFAULT_OFF,
-                               'reserved'      => DEFAULT_OFF,
-                               'digit'         => DEFAULT_OFF,
-                               'parenthesis'   => DEFAULT_OFF,
-                                       'printf'        => DEFAULT_OFF,
-                                       'prototype'     => DEFAULT_OFF,
-                                       'qw'            => DEFAULT_OFF,
-                          },
-               'severe'        => {    'inplace'       => DEFAULT_ON,
-                               'internal'      => DEFAULT_ON,
-                               'debugging'     => DEFAULT_ON,
-                               'malloc'        => DEFAULT_ON,
-                          },
-        'deprecated'   => DEFAULT_OFF,
-               'void'          => DEFAULT_OFF,
-               'recursion'     => DEFAULT_OFF,
-               'redefine'      => DEFAULT_OFF,
-               'numeric'       => DEFAULT_OFF,
-        'uninitialized'        => DEFAULT_OFF,
-               'once'          => DEFAULT_OFF,
-               'misc'          => DEFAULT_OFF,
-               'regexp'        => DEFAULT_OFF,
-               'glob'          => DEFAULT_OFF,
-               'y2k'           => DEFAULT_OFF,
-               'untie'         => DEFAULT_OFF,
-       'substr'        => DEFAULT_OFF,
-       'taint'         => DEFAULT_OFF,
-       'signal'        => DEFAULT_OFF,
-       'closure'       => DEFAULT_OFF,
-       'overflow'      => DEFAULT_OFF,
-       'portable'      => DEFAULT_OFF,
-       'utf8'          => DEFAULT_OFF,
-               'exiting'       => DEFAULT_OFF,
-               'pack'          => DEFAULT_OFF,
-               'unpack'        => DEFAULT_OFF,
-                #'default'     => DEFAULT_ON,
-       }
+'all' => [ 5.008, {
+       'io'            => [ 5.008, {   
+                               'pipe'          => [ 5.008, DEFAULT_OFF],
+                                       'unopened'      => [ 5.008, DEFAULT_OFF],
+                                       'closed'        => [ 5.008, DEFAULT_OFF],
+                                       'newline'       => [ 5.008, DEFAULT_OFF],
+                                       'exec'          => [ 5.008, DEFAULT_OFF],
+                                       'layer'         => [ 5.008, DEFAULT_OFF],
+                          }],
+       'syntax'        => [ 5.008, {   
+                               'ambiguous'     => [ 5.008, DEFAULT_OFF],
+                               'semicolon'     => [ 5.008, DEFAULT_OFF],
+                               'precedence'    => [ 5.008, DEFAULT_OFF],
+                               'bareword'      => [ 5.008, DEFAULT_OFF],
+                               'reserved'      => [ 5.008, DEFAULT_OFF],
+                               'digit'         => [ 5.008, DEFAULT_OFF],
+                               'parenthesis'   => [ 5.008, DEFAULT_OFF],
+                                       'printf'        => [ 5.008, DEFAULT_OFF],
+                                       'prototype'     => [ 5.008, DEFAULT_OFF],
+                                       'qw'            => [ 5.008, DEFAULT_OFF],
+                          }],
+               'severe'        => [ 5.008, {   
+                               'inplace'       => [ 5.008, DEFAULT_ON],
+                               'internal'      => [ 5.008, DEFAULT_ON],
+                               'debugging'     => [ 5.008, DEFAULT_ON],
+                               'malloc'        => [ 5.008, DEFAULT_ON],
+                          }],
+        'deprecated'   => [ 5.008, DEFAULT_OFF],
+               'void'          => [ 5.008, DEFAULT_OFF],
+               'recursion'     => [ 5.008, DEFAULT_OFF],
+               'redefine'      => [ 5.008, DEFAULT_OFF],
+               'numeric'       => [ 5.008, DEFAULT_OFF],
+        'uninitialized'        => [ 5.008, DEFAULT_OFF],
+               'once'          => [ 5.008, DEFAULT_OFF],
+               'misc'          => [ 5.008, DEFAULT_OFF],
+               'regexp'        => [ 5.008, DEFAULT_OFF],
+               'glob'          => [ 5.008, DEFAULT_OFF],
+               'y2k'           => [ 5.008, DEFAULT_OFF],
+               'untie'         => [ 5.008, DEFAULT_OFF],
+       'substr'        => [ 5.008, DEFAULT_OFF],
+       'taint'         => [ 5.008, DEFAULT_OFF],
+       'signal'        => [ 5.008, DEFAULT_OFF],
+       'closure'       => [ 5.008, DEFAULT_OFF],
+       'overflow'      => [ 5.008, DEFAULT_OFF],
+       'portable'      => [ 5.008, DEFAULT_OFF],
+       'utf8'          => [ 5.008, DEFAULT_OFF],
+               'exiting'       => [ 5.008, DEFAULT_OFF],
+               'pack'          => [ 5.008, DEFAULT_OFF],
+               'unpack'        => [ 5.008, DEFAULT_OFF],
+               'threads'       => [ 5.008, DEFAULT_OFF],
+                #'default'     => [ 5.008, DEFAULT_ON ],
+       }],
 } ;
 
-
 ###########################################################################
 sub tab {
     my($l, $t) = @_;
@@ -75,8 +78,49 @@ sub tab {
 
 my %list ;
 my %Value ;
+my %ValueToName ;
+my %NameToValue ;
 my $index ;
 
+my %v_list = () ;
+
+sub valueWalk
+{
+    my $tre = shift ;
+    my @list = () ;
+    my ($k, $v) ;
+
+    foreach $k (sort keys %$tre) {
+       $v = $tre->{$k};
+       die "duplicate key $k\n" if defined $list{$k} ;
+       die "Value associated with key '$k' is not an ARRAY reference"
+           if !ref $v || ref $v ne 'ARRAY' ;
+
+       my ($ver, $rest) = @{ $v } ;
+       push @{ $v_list{$ver} }, $k;
+       
+       if (ref $rest)
+         { valueWalk ($rest) }
+
+    }
+
+}
+
+sub orderValues
+{
+    my $index = 0;
+    foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
+        foreach my $name (@{ $v_list{$ver} } ) {
+           $ValueToName{ $index } = [ uc $name, $ver ] ;
+           $NameToValue{ uc $name } = $index ++ ;
+        }
+    }
+
+    return $index ;
+}
+
+###########################################################################
+
 sub walk
 {
     my $tre = shift ;
@@ -86,10 +130,17 @@ sub walk
     foreach $k (sort keys %$tre) {
        $v = $tre->{$k};
        die "duplicate key $k\n" if defined $list{$k} ;
-       $Value{$index} = uc $k ;
-        push @{ $list{$k} }, $index ++ ;
-       if (ref $v)
-         { push (@{ $list{$k} }, walk ($v)) }
+       #$Value{$index} = uc $k ;
+       die "Can't find key '$k'"
+           if ! defined $NameToValue{uc $k} ;
+        push @{ $list{$k} }, $NameToValue{uc $k} ;
+       die "Value associated with key '$k' is not an ARRAY reference"
+           if !ref $v || ref $v ne 'ARRAY' ;
+       
+       my ($ver, $rest) = @{ $v } ;
+       if (ref $rest)
+         { push (@{ $list{$k} }, walk ($rest)) }
+
        push @list, @{ $list{$k} } ;
     }
 
@@ -121,20 +172,33 @@ sub printTree
 {
     my $tre = shift ;
     my $prefix = shift ;
-    my $indent = shift ;
     my ($k, $v) ;
 
     my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
+    my @keys = sort keys %$tre ;
 
-    $prefix .= " " x $indent ;
-    foreach $k (sort keys %$tre) {
+    while ($k = shift @keys) {
        $v = $tre->{$k};
-       print $prefix . "|\n" ;
-       print $prefix . "+- $k" ;
-       if (ref $v)
+       die "Value associated with key '$k' is not an ARRAY reference"
+           if !ref $v || ref $v ne 'ARRAY' ;
+       
+        my $offset ;
+       if ($tre ne $tree) {
+           print $prefix . "|\n" ;
+           print $prefix . "+- $k" ;
+           $offset = ' ' x ($max + 4) ;
+       }
+       else {
+           print $prefix . "$k" ;
+           $offset = ' ' x ($max + 1) ;
+       }
+
+       my ($ver, $rest) = @{ $v } ;
+       if (ref $rest)
        {
-           print " " . "-" x ($max - length $k ) . "+\n" ;
-           printTree ($v, $prefix . "|" , $max + $indent - 1)
+           my $bar = @keys ? "|" : " ";
+           print " -" . "-" x ($max - length $k ) . "+\n" ;
+           printTree ($rest, $prefix . $bar . $offset )
        }
        else
          { print "\n" }
@@ -181,8 +245,7 @@ sub mkOct
 
 if (@ARGV && $ARGV[0] eq "tree")
 {
-    #print "  all -+\n" ;
-    printTree($tree, "   ", 4) ;
+    printTree($tree, "    ") ;
     exit ;
 }
 
@@ -222,19 +285,27 @@ my $offset = 0 ;
 
 $index = $offset ;
 #@{ $list{"all"} } = walk ($tree) ;
-walk ($tree) ;
+valueWalk ($tree) ;
+my $index = orderValues();
 
 die <<EOM if $index > 255 ;
 Too many warnings categories -- max is 255
     rewrite packWARN* & unpackWARN* macros 
 EOM
 
+walk ($tree) ;
+
 $index *= 2 ;
 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
 
 my $k ;
-foreach $k (sort { $a <=> $b } keys %Value) {
-    print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
+my $last_ver = 0;
+foreach $k (sort { $a <=> $b } keys %ValueToName) {
+    my ($name, $version) = @{ $ValueToName{$k} };
+    print WARN "\n/* Warnings Categories added in Perl $version */\n\n"
+        if $last_ver != $version ;
+    print WARN tab(5, "#define WARN_$name"), "$k\n" ;
+    $last_ver = $version ;
 }
 print WARN "\n" ;
 
@@ -341,13 +412,19 @@ while (<DATA>) {
 
 #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
 
-#my %Keys = map {lc $Value{$_}, $_} keys %Value ;
-
+$last_ver = 0;
 print PM "%Offsets = (\n" ;
-foreach my $k (sort { $a <=> $b } keys %Value) {
-    my $v = lc $Value{$k} ;
+foreach my $k (sort { $a <=> $b } keys %ValueToName) {
+    my ($name, $version) = @{ $ValueToName{$k} };
+    $name = lc $name;
     $k *= 2 ;
-    print PM tab(4, "    '$v'"), "=> $k,\n" ;
+    if ( $last_ver != $version ) {
+        print PM "\n";
+        print PM tab(4, "    # Warnings Categories added in Perl $version");
+        print PM "\n\n";
+    }
+    print PM tab(4, "    '$name'"), "=> $k,\n" ;
+    $last_ver = $version;
 }
 
 print PM "  );\n\n" ;
@@ -390,6 +467,7 @@ close PM ;
 
 __END__
 
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 # This file was created by warnings.pl
 # Any changes made here will be lost.
 #
@@ -661,4 +739,5 @@ sub warnif
 
     carp($message) ;
 }
+
 1;