24 files changed, 407 insertions, 191 deletions
diff --git a/XSUB.h b/XSUB.h
index 82eb4233f1..609f5b9db2 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -385,32 +385,32 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
 #    define stdin		PerlSIO_stdin
 #    define stdout		PerlSIO_stdout
 #    define stderr		PerlSIO_stderr
-#    define fopen		PerlIO_open
-#    define fclose		PerlIO_close
-#    define feof		PerlIO_eof
-#    define ferror		PerlIO_error
-#    define fclearerr		PerlIO_clearerr
-#    define getc		PerlIO_getc
-#    define fputc(c, f)		PerlIO_putc(f,c)
-#    define fputs(s, f)		PerlIO_puts(f,s)
-#    define fflush		PerlIO_flush
-#    define ungetc(c, f)	PerlIO_ungetc((f),(c))
-#    define fileno		PerlIO_fileno
-#    define fdopen		PerlIO_fdopen
-#    define freopen		PerlIO_reopen
-#    define fread(b,s,c,f)	PerlIO_read((f),(b),(s*c))
-#    define fwrite(b,s,c,f)	PerlIO_write((f),(b),(s*c))
+#    define fopen		PerlSIO_fopen
+#    define fclose		PerlSIO_fclose
+#    define feof		PerlSIO_feof
+#    define ferror		PerlSIO_ferror
+#    define fclearerr		PerlSIO_clearerr
+#    define getc		PerlSIO_getc
+#    define fputc		PerlSIO_fputc
+#    define fputs		PerlSIO_fputs
+#    define fflush		PerlSIO_fflush
+#    define ungetc		PerlSIO_ungetc
+#    define fileno		PerlSIO_fileno
+#    define fdopen		PerlSIO_fdopen
+#    define freopen		PerlSIO_freopen
+#    define fread		PerlSIO_fread
+#    define fwrite		PerlSIO_fwrite
 #    define setbuf		PerlSIO_setbuf
 #    define setvbuf		PerlSIO_setvbuf
 #    define setlinebuf		PerlSIO_setlinebuf
 #    define stdoutf		PerlSIO_stdoutf
 #    define vfprintf		PerlSIO_vprintf
-#    define ftell		PerlIO_tell
-#    define fseek		PerlIO_seek
-#    define fgetpos		PerlIO_getpos
-#    define fsetpos		PerlIO_setpos
-#    define frewind		PerlIO_rewind
-#    define tmpfile		PerlIO_tmpfile
+#    define ftell		PerlSIO_ftell
+#    define fseek		PerlSIO_fseek
+#    define fgetpos		PerlSIO_fgetpos
+#    define fsetpos		PerlSIO_fsetpos
+#    define frewind		PerlSIO_rewind
+#    define tmpfile		PerlSIO_tmpfile
 #    define access		PerlLIO_access
 #    define chmod		PerlLIO_chmod
 #    define chsize		PerlLIO_chsize
diff --git a/cop.h b/cop.h
index 0732a040ef..4b7256634d 100644
--- a/cop.h
+++ b/cop.h
@@ -117,13 +117,23 @@ struct block_sub {
     SV **	oldcurpad;
 };
 
-#define PUSHSUB(cx)							\
+/* base for the next two macros. Don't use directly */
+#define PUSHSUB_BASE(cx)						\
 	cx->blk_sub.cv = cv;						\
 	cx->blk_sub.olddepth = CvDEPTH(cv);				\
-	cx->blk_sub.hasargs = hasargs;					\
+	cx->blk_sub.hasargs = hasargs;
+
+#define PUSHSUB(cx)							\
+	PUSHSUB_BASE(cx)						\
 	cx->blk_sub.lval = PL_op->op_private &                          \
 	                      (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
 
+/* variant for use by OP_DBSTATE, where op_private holds hint bits */
+#define PUSHSUB_DB(cx)							\
+	PUSHSUB_BASE(cx)						\
+	cx->blk_sub.lval = 0;
+
+
 #define PUSHFORMAT(cx)							\
 	cx->blk_sub.cv = cv;						\
 	cx->blk_sub.gv = gv;						\
diff --git a/ext/Storable/t/restrict.t b/ext/Storable/t/restrict.t
index 4ab6d86813..9359f216d6 100644
--- a/ext/Storable/t/restrict.t
+++ b/ext/Storable/t/restrict.t
@@ -16,7 +16,7 @@ sub BEGIN {
             exit 0;
         }
     } else {
-	if ($[ < 5.005) {
+	if ($] < 5.005) {
 	    print "1..0 # Skip: No Hash::Util pre 5.005\n";
 	    exit 0;
 	    # And doing this seems on 5.004 seems to create bogus warnings about
diff --git a/ext/Sys/Hostname/Hostname.pm b/ext/Sys/Hostname/Hostname.pm
index 29825b95b0..efc8d38bae 100644
--- a/ext/Sys/Hostname/Hostname.pm
+++ b/ext/Sys/Hostname/Hostname.pm
@@ -5,17 +5,27 @@ use strict;
 use Carp;
 
 require Exporter;
-use XSLoader ();
 require AutoLoader;
 
 our @ISA     = qw/ Exporter AutoLoader /;
 our @EXPORT  = qw/ hostname /;
 
-our $VERSION = '1.1';
+our $VERSION;
 
 our $host;
 
-XSLoader::load 'Sys::Hostname', $VERSION;
+BEGIN {
+    $VERSION = '1.1';
+    {
+	local $SIG{__DIE__};
+	eval {
+	    require XSLoader;
+	    XSLoader::load('Sys::Hostname', $VERSION);
+	};
+	warn $@ if $@;
+    }
+}
+
 
 sub hostname {
 
@@ -23,7 +33,7 @@ sub hostname {
   return $host if defined $host;
 
   # method 1' - try to ask the system
-  $host = ghname();
+  $host = ghname() if defined &ghname;
   return $host if defined $host;
 
   if ($^O eq 'VMS') {
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index c5a210f809..a3f27e74d3 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -672,7 +672,9 @@ sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
     MAGIC *nmg = sv_magicext(nsv,mg->mg_obj,
 			    toLOWER(mg->mg_type),&sharedsv_elem_vtbl,
 			    name, namlen);
+    ENTER_LOCK;
     SvREFCNT_inc(SHAREDSvPTR(shared));
+    LEAVE_LOCK;
     nmg->mg_flags |= MGf_DUP;
     return 1;
 }
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 043f76202f..c9c20636b2 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -91,7 +91,6 @@ perl_key self_key;
 void
 Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
 {
-        PerlInterpreter* destroyperl = NULL;        
 	MUTEX_LOCK(&thread->mutex);
 	if (!thread->next) {
 	    Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
@@ -123,26 +122,25 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
 #endif
 	MUTEX_UNLOCK(&create_destruct_mutex);
 	/* Thread is now disowned */
-	if (thread->interp) {
+
+	if(thread->interp) {
 	    dTHXa(thread->interp);
+	    ithread*        current_thread;
 	    PERL_SET_CONTEXT(thread->interp);
+	    PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+	    PERL_THREAD_SETSPECIFIC(self_key,thread);
 	    SvREFCNT_dec(thread->params);
 	    thread->params = Nullsv;
-	    destroyperl = thread->interp;
+	    perl_destruct(thread->interp);
+            perl_free(thread->interp);
 	    thread->interp = NULL;
+	    PERL_THREAD_SETSPECIFIC(self_key,current_thread);
+
 	}
 	MUTEX_UNLOCK(&thread->mutex);
 	MUTEX_DESTROY(&thread->mutex);
         PerlMemShared_free(thread);
-	if(destroyperl) {
-	    ithread*        current_thread;
-	    PERL_THREAD_GETSPECIFIC(self_key,current_thread);
-	    PERL_THREAD_SETSPECIFIC(self_key,thread);
-	    perl_destruct(destroyperl);
-            perl_free(destroyperl);
-	    PERL_THREAD_SETSPECIFIC(self_key,current_thread);
 
-	}
 	PERL_SET_CONTEXT(aTHX);
 }
 
diff --git a/hints/openbsd.sh b/hints/openbsd.sh
index 23dc8ad485..cc94617641 100644
--- a/hints/openbsd.sh
+++ b/hints/openbsd.sh
@@ -11,17 +11,20 @@
 # OpenBSD has a better malloc than perl...
 test "$usemymalloc" || usemymalloc='n'
 
-# Currently, vfork(2) is not a real win over fork(2) but this will
-# change starting with OpenBSD 2.7.
-usevfork='true'
+# Currently, vfork(2) is not a real win over fork(2).
+usevfork="$undef"
 
-# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions
-# in 4.4BSD.  Configure will find these but they are just emulated
-# and do not have the same semantics as in 4.3BSD.
-d_setregid=$undef
-d_setreuid=$undef
-d_setrgid=$undef
-d_setruid=$undef
+# In OpenBSD < 3.3, the setre?[ug]id() are emulated using the
+# _POSIX_SAVED_IDS functionality which does not have the same
+# semantics as 4.3BSD.  Starting with OpenBSD 3.3, the original
+# semantics have been restored.
+case "$osvers" in
+[0-2].*|3.[0-2])
+	d_setregid=$undef
+	d_setreuid=$undef
+	d_setrgid=$undef
+	d_setruid=$undef
+esac
 
 #
 # Not all platforms support dynamic loading...
@@ -32,7 +35,7 @@ d_setruid=$undef
 #
 ARCH=`arch | sed 's/^OpenBSD.//'`
 case "${ARCH}-${osvers}" in
-alpha-2.[0-8]|mips-2.[0-8]|powerpc-2.[0-7]|m88k-*|vax-*)
+alpha-2.[0-8]|mips-2.[0-8]|powerpc-2.[0-7]|m88k-*|hppa-*|vax-*)
 	test -z "$usedl" && usedl=$undef
 	;;
 *)
@@ -85,6 +88,9 @@ case ${ARCH} in
 m88k)
    optimize='-O0'
    ;;
+hppa)
+   optimize='-O0'
+   ;;
 *)
    test "$optimize" || optimize='-O2'
    ;;
@@ -98,11 +104,6 @@ $define|true|[yY]*)
 	# any openbsd version dependencies with pthreads?
 	ccflags="-pthread $ccflags"
 	ldflags="-pthread $ldflags"
-	# Add -lpthread.  Also change from -lc to -lc_r
-	libswanted="$libswanted pthread"
-	libswanted=`echo " $libswanted "| sed -e 's/ c / c_r /' -e 's/^ //' -e 's/ $//'`
-	# This is strange.
-	usevfork="$undef"
 esac
 EOCBU
 
diff --git a/lib/utf8.t b/lib/utf8.t
index 41a7368509..8072c8722a 100644
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -37,7 +37,7 @@ no utf8; # Ironic, no?
 #
 #
 
-plan tests => 95;
+plan tests => 98;
 
 {
     # bug id 20001009.001
@@ -272,7 +272,7 @@ BANG
 # before the patch, the eval died with an error like:
 #   "my" variable $strict::VERSION can't be in a package
 #
-ok('' eq runperl(prog => <<'CODE'));
+ok('' eq runperl(prog => <<'CODE'), "change #17928");
     my $code = qq{ my \$\xe3\x83\x95\xe3\x83\xbc = 5; };
     {
 	use utf8;
@@ -280,3 +280,46 @@ ok('' eq runperl(prog => <<'CODE'));
 	print $@ if $@;
     }
 CODE
+
+{
+    use utf8;
+    $a = <<'END';
+0 ....... 1 ....... 2 ....... 3 ....... 4 ....... 5 ....... 6 ....... 7 ....... 
+END
+    my (@i, $s);
+
+    @i = ();
+    push @i, $s = index($a, '6');     # 60
+    push @i, $s = index($a, '.', $s); # next . after 60 is 62
+    push @i, $s = index($a, '5');     # 50
+    push @i, $s = index($a, '.', $s); # next . after 52 is 52
+    push @i, $s = index($a, '7');     # 70 
+    push @i, $s = index($a, '.', $s); # next . after 70 is 72
+    push @i, $s = index($a, '4');     # 40
+    push @i, $s = index($a, '.', $s); # next . after 40 is 42
+    is("@i", "60 62 50 52 70 72 40 42", "utf8 heredoc index");
+
+    @i = ();
+    push @i, $s = rindex($a, '6');     # 60
+    push @i, $s = rindex($a, '.', $s); # previous . before 60 is 58
+    push @i, $s = rindex($a, '5');     # 50
+    push @i, $s = rindex($a, '.', $s); # previous . before 52 is 48
+    push @i, $s = rindex($a, '7');     # 70 
+    push @i, $s = rindex($a, '.', $s); # previous . before 70 is 68
+    push @i, $s = rindex($a, '4');     # 40
+    push @i, $s = rindex($a, '.', $s); # previous . before 40 is 38
+    is("@i", "60 58 50 48 70 68 40 38", "utf8 heredoc rindex");
+
+    @i = ();
+    push @i, $s =  index($a, '6');     # 60
+    push @i,  index($a, '.', $s);      # next     . after  60 is 62
+    push @i, rindex($a, '.', $s);      # previous . before 60 is 58
+    push @i, $s = rindex($a, '5');     # 60
+    push @i,  index($a, '.', $s);      # next     . after  50 is 52
+    push @i, rindex($a, '.', $s);      # previous . before 50 is 48
+    push @i, $s =  index($a, '7', $s); # 70
+    push @i,  index($a, '.', $s);      # next     . after  70 is 72
+    push @i, rindex($a, '.', $s);      # previous . before 70 is 68
+    is("@i", "60 62 58 50 52 48 70 72 68", "utf8 heredoc index and rindex");
+}
+
diff --git a/op.c b/op.c
index e07655192b..dd1ce5bf85 100644
--- a/op.c
+++ b/op.c
@@ -7040,8 +7040,10 @@ Perl_peep(pTHX_ register OP *o)
     for (; o; o = o->op_next) {
 	if (o->op_seq)
 	    break;
-	if (!PL_op_seqmax)
-	    PL_op_seqmax++;
+        /* The special value -1 is used by the B::C compiler backend to indicate
+         * that an op is statically defined and should not be freed */
+	if (!PL_op_seqmax || PL_op_seqmax == (U16)-1)
+	    PL_op_seqmax = 1;
 	PL_op = o;
 	switch (o->op_type) {
 	case OP_SETSTATE:
diff --git a/perlio.c b/perlio.c
index de6950b4bc..9cb12d0e60 100644
--- a/perlio.c
+++ b/perlio.c
@@ -666,8 +666,13 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	} else {
 	    SV *pkgsv = newSVpvn("PerlIO", 6);
 	    SV *layer = newSVpvn(name, len);
-	    ENTER;
+	    CV *cv  = get_cv("PerlIO::Layer::NoWarnings", FALSE);
+    	    ENTER;
 	    SAVEINT(PL_in_load_module);
+	    if (cv) {
+	        SAVESPTR(PL_warnhook);
+		PL_warnhook = (SV *) cv;
+	    }
 	    PL_in_load_module++;
 	    /*
 	     * The two SVs are magically freed by load_module
@@ -770,6 +775,17 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
     return sv;
 }
 
+XS(XS_PerlIO__Layer__NoWarnings)
+{
+    /* This is used as a %SIG{__WARN__} handler to supress warnings 
+       during loading of layers.
+     */
+    dXSARGS;
+    if (items)
+    	PerlIO_debug("warning:%s\n",SvPV_nolen(ST(0)));
+    XSRETURN(0);
+}
+
 XS(XS_PerlIO__Layer__find)
 {
     dXSARGS;
@@ -1012,6 +1028,7 @@ Perl_boot_core_PerlIO(pTHX)
 	  __FILE__);
 #endif
     newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__);
+    newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__);
 }
 
 PerlIO_funcs *
@@ -2684,13 +2701,91 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     return f;
 }
 
+static int
+PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
+{
+    /* XXX this could use PerlIO_canset_fileno() and
+     * PerlIO_set_fileno() support from Configure 
+     */
+#  if defined(__GLIBC__)
+    /* There may be a better way for GLIBC:
+    	- libio.h defines a flag to not close() on cleanup 
+     */	
+    f->_fileno = -1;
+    return 1;
+#  elif defined(__sun__)
+#    if defined(_LP64)
+    /* On solaris, if _LP64 is defined, the FILE structure is this:
+     *
+     *  struct FILE {
+     *      long __pad[16];
+     *  };
+     *
+     * It turns out that the fd is stored in the top 32 bits of 
+     * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears
+     * to contain a pointer or offset into another structure. All the
+     * remaining fields are zero.
+     *
+     * We set the top bits to -1 (0xFFFFFFFF).
+     */
+    f->__pad[4] |= 0xffffffff00000000L;
+    assert(fileno(f) == 0xffffffff);
+#    else /* !defined(_LP64) */
+    /* _file is just a unsigned char :-( 
+       Not clear why we dup() rather than using -1 
+       even if that would be treated as 0xFF - so will 
+       a dup fail ...
+     */
+    f->_file = PerlLIO_dup(fileno(f));
+#    endif /* defined(_LP64) */
+    return 1;
+#  elif defined(__hpux)
+    f->__fileH = 0xff;
+    f->__fileL = 0xff;
+    return 1;
+   /* Next one ->_file seems to be a reasonable fallback, i.e. if
+      your platform does not have special entry try this one.       
+      [For OSF only have confirmation for Tru64 (alpha)
+      but assume other OSFs will be similar.]
+    */    
+#  elif defined(_AIX) || defined(__osf__) || defined(__irix__)
+    f->_file = -1;
+    return 1;
+#  elif defined(__FreeBSD__)
+    /* There may be a better way on FreeBSD:
+        - we could insert a dummy func in the _close function entry 
+	f->_close = (int (*)(void *)) dummy_close; 
+     */
+    f->_file = -1;
+    return 1;
+#  elif defined(__CYGWIN__)
+    /* There may be a better way on CYGWIN:
+        - we could insert a dummy func in the _close function entry 
+	f->_close = (int (*)(void *)) dummy_close; 
+     */
+    f->_file = -1;
+    return 1;
+#  elif defined(WIN32)
+#    if defined(__BORLANDC__)
+    f->fd = PerlLIO_dup(fileno(f));
+#    else
+    f->_file = -1;
+#    endif
+    return 1;
+#  else
+#if 0
+    /* Sarathy's code did this - we fall back to a dup/dup2 hack 
+       (which isn't thread safe) instead
+     */  
+#    error "Don't know how to set FILE.fileno on your platform"
+#endif
+    return 0;
+#  endif
+}
+
 IV
 PerlIOStdio_close(pTHX_ PerlIO *f)
 {
-#ifdef SOCKS5_VERSION_NAME
-    int optval;
-    Sock_size_t optlen = sizeof(int);
-#endif
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (!stdio) {
 	errno = EBADF;
@@ -2698,62 +2793,94 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     }
     else {
         int fd = fileno(stdio);
-	int dupfd = -1;
-	IV result;
+	int socksfd = 0;
+	int invalidate = 0;
+	IV result = 0;
+	int saveerr = 0;
+	int dupfd = 0;
+#ifdef SOCKS5_VERSION_NAME
+    	/* Socks lib overrides close() but stdio isn't linked to 
+	   that library (though we are) - so we must call close() 
+	   on sockets on stdio's behalf. 
+	 */   
+    	int optval;
+    	Sock_size_t optlen = sizeof(int);
+    	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
+            socksfd = 1;
+	    invalidate = 1;  
+    	}
+#endif
     	if (PerlIOUnix_refcnt_dec(fd) > 0) {
 	    /* File descriptor still in use */
-	    if (fd < 3) {
-	    	/* For STD* handles don't close the stdio at all */
+	    invalidate = 1;
+	    socksfd = 0;
+	}    
+	if (invalidate) {
+   	    /* For STD* handles don't close the stdio at all 
+	       this is because we have shared the FILE * too 
+   	     */
+	    if (stdio == stdin) {
+	    	/* Some stdios are buggy fflush-ing inputs */
+	    	return 0;
+	    }
+	    else if (stdio == stdout || stdio == stderr) {
 	    	return PerlIO_flush(f);
 	    }
-	    else {
-            	/* Tricky - must fclose(stdio) to free memory but not close(fd) */ 
+            /* Tricky - must fclose(stdio) to free memory but not close(fd) 
+	       Use Sarathy's trick from maint-5.6 to invalidate the 
+	       fileno slot of the FILE * 
+	    */ 
+	    result = PerlIO_flush(f);
+	    saveerr = errno;
+    	    if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
 	    	dupfd = PerlLIO_dup(fd);
 	    }
-	}    
-        result = (
-#ifdef SOCKS5_VERSION_NAME
-	       (getsockopt
-		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
-		 &optlen) <
-		0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
-#else
-	       PerlSIO_fclose(stdio)
-#endif
-	);
-	if (dupfd >= 0) {
-	    /* We need to restore fd from the saved copy */
-	    if (PerlLIO_dup2(dupfd,fd) != fd)
-	      result = -1;
-	    if (PerlLIO_close(dupfd) != 0)
-	      result = -1; 
+	} 
+        result = PerlSIO_fclose(stdio);
+	/* We treat error from stdio as success if we invalidated 
+	   errno may NOT be expected EBADF 
+	 */
+	if (invalidate && result != 0) {
+	    errno = saveerr;
+	    result = 0;
+	} 
+	if (socksfd) {
+	    /* in SOCKS case let close() determine return value */
+	    result = close(fd);
+	}
+	if (dupfd) {
+	    PerlLIO_dup2(dupfd,fd);
+	    close(dupfd);
 	}
 	return result;
     } 
-
 }
 
-
-
 SSize_t
 PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
-    if (count == 1) {
-	STDCHAR *buf = (STDCHAR *) vbuf;
-	/*
-	 * Perl is expecting PerlIO_getc() to fill the buffer Linux's
-	 * stdio does not do that for fread()
-	 */
-	int ch = PerlSIO_fgetc(s);
-	if (ch != EOF) {
-	    *buf = ch;
-	    got = 1;
+    for (;;) {
+	if (count == 1) {
+	    STDCHAR *buf = (STDCHAR *) vbuf;
+	    /*
+	     * Perl is expecting PerlIO_getc() to fill the buffer Linux's
+	     * stdio does not do that for fread()
+	     */
+	    int ch = PerlSIO_fgetc(s);
+	    if (ch != EOF) {
+		*buf = ch;
+		got = 1;
+	    }
 	}
+	else
+	    got = PerlSIO_fread(vbuf, 1, count, s);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
     }
-    else
-	got = PerlSIO_fread(vbuf, 1, count, s);
     return got;
 }
 
@@ -2818,8 +2945,16 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    return PerlSIO_fwrite(vbuf, 1, count,
-			  PerlIOSelf(f, PerlIOStdio)->stdio);
+    SSize_t got;
+    for (;;) {
+	got = PerlSIO_fwrite(vbuf, 1, count,
+			      PerlIOSelf(f, PerlIOStdio)->stdio);
+	if (got || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	errno = 0;	/* just in case */
+    }
+    return got;
 }
 
 IV
diff --git a/plan9/mkfile b/plan9/mkfile
index ea625ce51a..62f70c3f7c 100644
--- a/plan9/mkfile
+++ b/plan9/mkfile
@@ -20,10 +20,11 @@ perlshr = $archlib/CORE/libperlshr.a
 installman1dir = /sys/man/1
 installman3dir = /sys/man/2
 
-podnames = perl perlbook perlboot perlbot perldata perldebtut perldiag perldsc perlform perlfunc perlipc perllol perlmod perlmodlib perlmodinstall perlnewmod perlop perlopentut perlpod perlrequick perlretut perlref perlreftut perlrun perlsec perlstyle perlsub perlsyn perltie perltoc perltooc perltoot perltrap perlutil perlvar
+podnames = perl perlbook perlboot perlbot perldata perldebtut perldiag perldsc perlform perlfunc perlipc perllexwarn perllol perlmod perlmodlib perlmodinstall perlnewmod perlop perlopentut perlpacktut perlpod perlport perlrequick perlretut perlref perlreftut perlrequick perlrun perlsec perlstyle perlsub perlsyn perltie perltoc perltooc perltoot perltrap perlutil perluniintro perlvar
 faqpodnames = perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 perlfaq6 perlfaq7 perlfaq8 perlfaq9
-advpodnames = perlapi perlapio perlcall perlclib perlcompile perldebguts perldbmfilter perldebug perldelta perldiag perlebcdic perlembed perlfilter perlfor perlguts perlhack perlhist perlintern perliol perlnumber perlobj perlre perlthrtut perltodo perlunicode perlxs perlxs perlxstut
-archpodnames = perlaix perlamiga perlapollo perlbeos perlbs2000 perlce perlcygwin perldgux perldos perlepoc perlfreebsd perlhpux perlhurd perlirix perlmachten perlmacos perlmint perlmpeix perlnetware perlos2 perlos390 perlplan9 perlqnx perlsolaris perltru64 perlvmesa perlvms perlvos perlwin32
+advpodnames = perlapi perlapio perlcall perlclib perlcompile perldebguts perldbmfilter perldebug perldelta perldiag perlebcdic perlembed perlfilter perlfork perlguts perlhack perlintern perliol perllocale perlnumber perlobj perlothrtut perlpodspec perlre perlthrtut perltodo perlunicode perlxs perlxs perlxstut
+archpodnames = perlaix perlamiga perlapollo perlbeos perlbs2000 perlce perlcygwin perldgux perldos perlepoc perlfreebsd perlhpux perlhurd perlirix perlmachten perlmacos perlmint perlmpeix perlnetware perlos2 perlos390 perlos400 perlplan9 perlqnx perlsolaris perltru64 perluts perlvmesa perlvms perlvos perlwin32
+histpods = perl5004delta perl5005delta perl561delta perl56delta perl570delta perl571delta perl572delta perl573delta perl58delta perlhist
 
 libpods = ${podnames:%=pod/%.pod}
 
@@ -139,6 +140,7 @@ man:V:		$perlpods pod/pod2man.PL perl
 			for (i in $faqpodnames) pod/pod2man pod/$i.pod > $installman3dir/$i
 			for (i in $advpodnames) pod/pod2man pod/$i.pod > $installman3dir/$i
 			for (i in $archpodnames) pod/pod2man pod/$i.pod > $installman3dir/$i
+			for (i in $histpodnames) pod/pod2man pod/$i.pod > $installman3dir/$i
 			
 nuke clean:V:	
 		rm -f *.$O   $extensions^.pm config.sh $perllib config.h $perlshr perlmain.c perl miniperl $archlib/Config.pm $ext_c
diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod
index 73f12e7712..cc2c185bbf 100644
--- a/pod/perlfaq.pod
+++ b/pod/perlfaq.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq - frequently asked questions about Perl ($Date: 2003/01/03 20:00:25 $)
+perlfaq - frequently asked questions about Perl ($Date: 2003/01/26 17:45:46 $)
 
 =head1 DESCRIPTION
 
@@ -516,7 +516,7 @@ What's wrong with always quoting "$vars"?
 
 =item *
 
-Why don't my <<HERE documents work?
+Why don't my E<lt>E<lt>HERE documents work?
 
 =item *
 
@@ -733,7 +733,7 @@ How come when I open a file read-write it wipes it out?
 
 =item *
 
-Why do I sometimes get an "Argument list too long" when I use <*>?
+Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
 
 =item *
 
@@ -753,7 +753,7 @@ How can I lock a file?
 
 =item *
 
-Why can't I just open(FH, ">file.lock")?
+Why can't I just open(FH, "E<gt>file.lock")?
 
 =item *
 
@@ -1012,7 +1012,7 @@ What's the difference between deep and shallow binding?
 
 =item *
 
-Why doesn't "my($foo) = <FILE>;" work right?
+Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
 
 =item *
 
diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod
index 22f7ad7ce0..45738abc26 100644
--- a/pod/perlfaq2.pod
+++ b/pod/perlfaq2.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.18 $, $Date: 2002/12/06 07:40:11 $)
+perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.20 $, $Date: 2003/01/26 17:50:56 $)
 
 =head1 DESCRIPTION
 
@@ -171,24 +171,33 @@ assistance:
 
 =head2 What are the Perl newsgroups on Usenet?  Where do I post questions?
 
-The now defunct comp.lang.perl newsgroup has been superseded by the
-following groups:
+Several groups devoted to the Perl language are on Usenet:
 
     comp.lang.perl.announce 		Moderated announcement group
-    comp.lang.perl.misc     		Very busy group about Perl in general
-    comp.lang.perl.moderated            Moderated discussion group
+    comp.lang.perl.misc     		High traffic general Perl discussion
+    comp.lang.perl.moderated        Moderated discussion group
     comp.lang.perl.modules  		Use and development of Perl modules
     comp.lang.perl.tk           	Using Tk (and X) from Perl
 
     comp.infosystems.www.authoring.cgi 	Writing CGI scripts for the Web.
 
-There is also a Usenet gateway to Perl mailing lists sponsored by perl.org at
-nntp://nntp.perl.org , a web interface to the same lists at
-http://nntp.perl.org/group/ and these lists are also available under the
-C<perl.*> hierarchy at http://groups.google.com . Other groups are listed at
-http://lists.perl.org/ ( also known as http://lists.cpan.org/ ).
+Some years ago, comp.lang.perl was divided into those groups, and
+comp.lang.perl itself officially removed.  While that group may still
+be found on some news servers, it is unwise to use it, because
+postings there will not appear on news servers which honour the
+official list of group names.  Use comp.lang.perl.misc for topics
+which do not have a more-appropriate specific group.
 
-A nice place to ask questions is the PerlMonks site, http://www.perlmonks.org/
+There is also a Usenet gateway to Perl mailing lists sponsored by
+perl.org at nntp://nntp.perl.org , a web interface to the same lists
+at http://nntp.perl.org/group/ and these lists are also available
+under the C<perl.*> hierarchy at http://groups.google.com . Other
+groups are listed at http://lists.perl.org/ ( also known as
+http://lists.cpan.org/ ).
+
+A nice place to ask questions is the PerlMonks site, 
+http://www.perlmonks.org/ , or the Perl Beginners mailing list
+http://lists.perl.org/showlist.cgi?name=beginners .
 
 Note that none of the above are supposed to write your code for you:
 asking questions about particular problems or general advice is fine,
@@ -230,7 +239,7 @@ of real-world examples, mini-tutorials, and complete programs is:
 	by Tom Christiansen and Nathan Torkington,
 	    with Foreword by Larry Wall
 	ISBN 1-56592-243-3 [1st Edition August 1998]
-	http://perl.oreilly.com/cookbook/
+	http://perl.oreilly.com/catalog/cookbook/
 
 If you're already a seasoned programmer, then the Camel Book might
 suffice for you to learn Perl from.  If you're not, check out the
diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod
index 7843dbff7d..7c7527edae 100644
--- a/pod/perlfaq3.pod
+++ b/pod/perlfaq3.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq3 - Programming Tools ($Revision: 1.31 $, $Date: 2003/01/03 20:10:11 $)
+perlfaq3 - Programming Tools ($Revision: 1.32 $, $Date: 2003/01/26 17:41:53 $)
 
 =head1 DESCRIPTION
 
@@ -42,17 +42,12 @@ operations typically found in symbolic debuggers.
 
 =head2 Is there a Perl shell?
 
-In general, not yet.  There is psh available at
-
-    http://www.focusresearch.com/gregor/psh
-
-Which includes the following description:
-
-    The Perl Shell is a shell that combines the interactive nature
-    of a Unix shell with the power of Perl. The goal is to eventually
-    have a full featured shell that behaves as expected for normal
-    shell activity. But, the Perl Shell will use Perl syntax and
-    functionality for control-flow statements and other things.
+The psh (Perl sh) is currently at version 1.8. The Perl Shell is a
+shell that combines the interactive nature of a Unix shell with the
+power of Perl. The goal is a full featured shell that behaves as
+expected for normal shell activity and uses Perl syntax and
+functionality for control-flow statements and other things.
+You can get psh at http://www.focusresearch.com/gregor/psh/ .
 
 The Shell.pm module (distributed with Perl) makes Perl try commands
 which aren't part of the Perl language as shell commands.  perlsh
diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod
index f7215e2eef..b641d5845e 100644
--- a/pod/perlfaq4.pod
+++ b/pod/perlfaq4.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq4 - Data Manipulation ($Revision: 1.39 $, $Date: 2003/01/03 20:06:21 $)
+perlfaq4 - Data Manipulation ($Revision: 1.40 $, $Date: 2003/01/26 17:43:21 $)
 
 =head1 DESCRIPTION
 
@@ -142,7 +142,7 @@ Using the CPAN module Bit::Vector:
 
 =item How do I convert from decimal to hexadecimal
 
-Using sprint:
+Using sprintf:
 
     $hex = sprintf("%X", 3735928559);
 
@@ -811,9 +811,6 @@ values of a hash if you use a slice:
 
 =head2 How do I pad a string with blanks or pad a number with zeroes?
 
-(This answer contributed by Uri Guttman, with kibitzing from
-Bart Lateur.)
-
 In the following examples, C<$pad_len> is the length to which you wish
 to pad the string, C<$text> or C<$num> contains the string to be padded,
 and C<$pad_char> contains the padding character. You can use a single
@@ -828,13 +825,16 @@ right with blanks and it will truncate the result to a maximum length of
 C<$pad_len>.
 
     # Left padding a string with blanks (no truncation):
-    $padded = sprintf("%${pad_len}s", $text);
+	$padded = sprintf("%${pad_len}s", $text);
+	$padded = sprintf("%*s", $pad_len, $text);  # same thing
 
     # Right padding a string with blanks (no truncation):
-    $padded = sprintf("%-${pad_len}s", $text);
+	$padded = sprintf("%-${pad_len}s", $text);
+	$padded = sprintf("%-*s", $pad_len, $text); # same thing
 
     # Left padding a number with 0 (no truncation):
-    $padded = sprintf("%0${pad_len}d", $num);
+	$padded = sprintf("%0${pad_len}d", $num);
+	$padded = sprintf("%0*d", $pad_len, $num); # same thing
 
     # Right padding a string with blanks using pack (will truncate):
     $padded = pack("A$pad_len",$text);
@@ -958,13 +958,13 @@ Stringification also destroys arrays.
     print "@lines";		# WRONG - extra blanks
     print @lines;		# right
 
-=head2 Why don't my <<HERE documents work?
+=head2 Why don't my E<lt>E<lt>HERE documents work?
 
 Check for these three things:
 
 =over 4
 
-=item There must be no space after the << part.
+=item There must be no space after the E<lt>E<lt> part.
 
 =item There (probably) should be a semicolon at the end.
 
@@ -1870,7 +1870,7 @@ it on top of either DB_File or GDBM_File.
 Use the Tie::IxHash from CPAN.
 
     use Tie::IxHash;
-    tie my %myhash, Tie::IxHash;
+    tie my %myhash, 'Tie::IxHash';
     for (my $i=0; $i<20; $i++) {
         $myhash{$i} = 2*$i;
     }
diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod
index c04f3c6872..9e30b54cfd 100644
--- a/pod/perlfaq5.pod
+++ b/pod/perlfaq5.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq5 - Files and Formats ($Revision: 1.27 $, $Date: 2002/12/06 07:40:11 $)
+perlfaq5 - Files and Formats ($Revision: 1.28 $, $Date: 2003/01/26 17:45:46 $)
 
 =head1 DESCRIPTION
 
@@ -434,7 +434,7 @@ isn't as exclusive as you might wish.
 
 See also the new L<perlopentut> if you have it (new for 5.6).
 
-=head2 Why do I sometimes get an "Argument list too long" when I use <*>?
+=head2 Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
 
 The C<< <> >> operator performs a globbing operation (see above).
 In Perl versions earlier than v5.6.0, the internal glob() operator forks
@@ -537,7 +537,7 @@ L<perlopentut/"File Locking"> if you have it (new for 5.6).
 
 =back
 
-=head2 Why can't I just open(FH, ">file.lock")?
+=head2 Why can't I just open(FH, "E<gt>file.lock")?
 
 A common bit of code B<NOT TO USE> is this:
 
diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod
index 6eb2a6b4bf..a144457de9 100644
--- a/pod/perlfaq7.pod
+++ b/pod/perlfaq7.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq7 - General Perl Language Issues ($Revision: 1.12 $, $Date: 2002/12/06 07:40:11 $)
+perlfaq7 - General Perl Language Issues ($Revision: 1.13 $, $Date: 2003/01/26 17:45:46 $)
 
 =head1 DESCRIPTION
 
@@ -519,7 +519,7 @@ However, dynamic variables (aka global, local, or package variables)
 are effectively shallowly bound.  Consider this just one more reason
 not to use them.  See the answer to L<"What's a closure?">.
 
-=head2 Why doesn't "my($foo) = <FILE>;" work right?
+=head2 Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
 
 C<my()> and C<local()> give list context to the right hand side
 of C<=>.  The <FH> read operation, like so many of Perl's
diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod
index 31af4bd7df..164d23529e 100644
--- a/pod/perlfaq8.pod
+++ b/pod/perlfaq8.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-perlfaq8 - System Interaction ($Revision: 1.16 $, $Date: 2003/01/03 20:03:57 $)
+perlfaq8 - System Interaction ($Revision: 1.17 $, $Date: 2003/01/26 17:44:04 $)
 
 =head1 DESCRIPTION
 
@@ -1036,9 +1036,15 @@ in L<perlfaq8/"How do I start a process in the background?">.
 
 =head2 How do I use an SQL database?
 
-There are a number of excellent interfaces to SQL databases.  See the
-DBD::* modules available from http://www.cpan.org/modules/by-module/DBD/ .
-A lot of information on this can be found at http://dbi.perl.org/
+The DBI module provides an abstract interface to most database
+servers and types, including Oracle, DB2, Sybase, mysql, Postgresql,
+ODBC, and flat files.  The DBI module accesses each database type
+through a database driver, or DBD.  You can see a complete list of
+available drivers on CPAN: http://www.cpan.org/modules/by-module/DBD/ .
+You can read more about DBI on http://dbi.perl.org .
+
+Other modules provide more specific access: Win32::ODBC, Alzabo, iodbc,
+and others found on CPAN Search: http://search.cpan.org .
 
 =head2 How do I make a system() exit on control-C?
 
diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod
index 1d3f84626f..eed2066d26 100644
--- a/pod/perlunicode.pod
+++ b/pod/perlunicode.pod
@@ -178,7 +178,7 @@ You can also use negation in both C<\p{}> and C<\P{}> by introducing a caret
 equal to C<\P{Tamil}>.
 
 Here are the basic Unicode General Category properties, followed by their
-long form.  You can use either; C<\p{Lu}> and C<\p{LowercaseLetter}>,
+long form.  You can use either; C<\p{Lu}> and C<\p{UppercaseLetter}>,
 for instance, are identical.
 
     Short       Long
diff --git a/pod/perluniintro.pod b/pod/perluniintro.pod
index 3a2346004c..7094464a43 100644
--- a/pod/perluniintro.pod
+++ b/pod/perluniintro.pod
@@ -435,7 +435,8 @@ UTF-8 encoded.  A C<use open ':utf8'> would have avoided the bug, or
 explicitly opening also the F<file> for input as UTF-8.
 
 B<NOTE>: the C<:utf8> and C<:encoding> features work only if your
-Perl has been built with the new PerlIO feature.
+Perl has been built with the new PerlIO feature (which is the default
+on most systems).
 
 =head2 Displaying Unicode As Text
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 2eade1ae02..8e07acb68a 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1578,7 +1578,7 @@ PP(pp_dbstate)
 
 	push_return(PL_op->op_next);
 	PUSHBLOCK(cx, CXt_SUB, SP);
-	PUSHSUB(cx);
+	PUSHSUB_DB(cx);
 	CvDEPTH(cv)++;
 	(void)SvREFCNT_inc(cv);
 	SAVEVPTR(PL_curpad);
diff --git a/regexec.c b/regexec.c
index 8c1210fa5f..46a8384fa6 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4077,26 +4077,8 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     case ANYOF:
 	if (do_utf8) {
 	    loceol = PL_regeol;
-	    while (hardcount < max && scan < loceol) {
-		 bool cont = FALSE;
-		 if (ANYOF_FLAGS(p) & ANYOF_UNICODE) {
-		      if (reginclass(p, (U8*)scan, 0, do_utf8))
-			   cont = TRUE;
-		 }
-		 else {
-		      U8 c = (U8)scan[0];
-
-		      if (UTF8_IS_INVARIANT(c)) {
-			   if (ANYOF_BITMAP_TEST(p, c))
-				cont = TRUE;
-		      }
-		      else {
-			   if (reginclass(p, (U8*)scan, 0, do_utf8))
-				cont = TRUE;
-		      }
-		}
-		if (!cont)
-		     break;
+	    while (hardcount < max && scan < loceol &&
+		   reginclass(p, (U8*)scan, 0, do_utf8)) {
 		scan += UTF8SKIP(scan);
 		hardcount++;
 	    }
diff --git a/sv.c b/sv.c
index ae9b6d7ebb..22a339938d 100644
--- a/sv.c
+++ b/sv.c
@@ -5584,6 +5584,8 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 			     U8 *p = s + cache[1];
 			     STRLEN ubackw = 0;
 			     
+			     cache[1] -= backw;
+
 			     while (backw--) {
 				  p--;
 				  while (UTF8_IS_CONTINUATION(*p))
@@ -5592,7 +5594,6 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 			     }
 
 			     cache[0] -= ubackw;
-			     cache[1] -= backw;
 
 			     return;
 			}
@@ -5965,10 +5966,18 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 	rslen = 1;
     }
     else if (RsSNARF(PL_rs)) {
+    	/* If it is a regular disk file use size from stat() as estimate 
+	   of amount we are going to read - may result in malloc-ing 
+	   more memory than we realy need if layers bellow reduce 
+	   size we read (e.g. CRLF or a gzip layer)
+	 */
 	Stat_t st;
-	if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && st.st_size
-		&& (recsize = st.st_size - PerlIO_tell(fp)))
-	    goto read_record;
+	if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode))  {
+	    Off_t offset = PerlIO_tell(fp);
+	    if (offset != (Off_t) -1) {
+	     	(void) SvGROW(sv, (STRLEN)((st.st_size - offset) + append + 1));
+	    }
+	}
 	rsptr = NULL;
 	rslen = 0;
     }
@@ -5978,14 +5987,14 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 
       /* Grab the size of the record we're getting */
       recsize = SvIV(SvRV(PL_rs));
-
-    read_record:
       buffer = SvGROW(sv, (STRLEN)(recsize + append + 1)) + append;
       /* Go yank in */
 #ifdef VMS
       /* VMS wants read instead of fread, because fread doesn't respect */
       /* RMS record boundaries. This is not necessarily a good thing to be */
-      /* doing, but we've got no other real choice */
+      /* doing, but we've got no other real choice - except avoid stdio
+         as implementation - perhaps write a :vms layer ?
+       */
       bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
 #else
       bytesread = PerlIO_read(fp, buffer, recsize);
@@ -6061,8 +6070,13 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     /* Here is some breathtakingly efficient cheating */
 
     cnt = PerlIO_get_cnt(fp);			/* get count into register */
-    if ((I32)(SvLEN(sv) - append) <= cnt + 1) { /* make sure we have the room */
-	if (cnt > 80 && (I32)SvLEN(sv) > append) {
+    /* make sure we have the room */
+    if ((I32)(SvLEN(sv) - append) <= cnt + 1) { 
+    	/* Not room for all of it
+	   if we are looking for a separator and room for some 
+	 */
+	if (rslen && cnt > 80 && (I32)SvLEN(sv) > append) {
+	    /* just process what we have room for */ 
 	    shortbuffered = cnt - SvLEN(sv) + append + 1;
 	    cnt -= shortbuffered;
 	}
@@ -6072,7 +6086,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 	    SvGROW(sv, (STRLEN)(append + (cnt <= 0 ? 2 : (cnt + 1))));
 	}
     }
-    else
+    else 
 	shortbuffered = 0;
     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
     ptr = (STDCHAR*)PerlIO_get_ptr(fp);
diff --git a/t/op/pat.t b/t/op/pat.t
index 16212767b7..7a324dbdf0 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..968\n";
+print "1..972\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3054,5 +3054,11 @@ print "\x{072F}" =~ /\P{Syriac1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
     ok($a !~ /^\C{4}y/,     q{don't match \C{4}y});
 }
 
-# last test 968
+$_ = 'aaaaaaaaaa';
+utf8::upgrade($_); chop $_; $\="\n";
+ok(/[^\s]+/, "m/[^\s]/ utf8");
+ok(/[^\d]+/, "m/[^\d]/ utf8");
+ok(($a = $_, $_ =~ s/[^\s]+/./g), "s/[^\s]/ utf8");
+ok(($a = $_, $a =~ s/[^\d]+/./g), "s/[^\s]/ utf8");
 
+# last test 972