This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate with Sarathy.
authorJarkko Hietaniemi <jhi@iki.fi>
Sat, 11 Sep 1999 20:50:37 +0000 (20:50 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 11 Sep 1999 20:50:37 +0000 (20:50 +0000)
p4raw-id: //depot/cfgperl@4127

20 files changed:
MANIFEST
ext/DB_File/Changes
ext/DB_File/DB_File.pm
ext/DB_File/Makefile.PL
ext/DB_File/dbinfo
ext/DB_File/typemap
ext/DB_File/version.c [new file with mode: 0644]
lib/Time/Local.pm
perl.h
perlapi.c [changed mode: 0644->0755]
perlapi.h [changed mode: 0644->0755]
pod/perldelta.pod
pp_sys.c
regexec.c
sv.c
t/lib/db-btree.t
t/op/filetest.t [changed mode: 0755->0644]
t/op/pat.t
t/op/sprintf.t
t/op/subst_amp.t [changed mode: 0755->0644]

index 53eebab..3b0f7ae 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -207,6 +207,7 @@ ext/DB_File/Makefile.PL             Berkeley DB extension makefile writer
 ext/DB_File/dbinfo             Berkeley DB database version checker
 ext/DB_File/hints/dynixptx.pl  Hint for DB_File for named architecture
 ext/DB_File/typemap            Berkeley DB extension interface types
+ext/DB_File/version.c          Berkeley DB extension interface version check
 ext/Data/Dumper/Changes                Data pretty printer, changelog
 ext/Data/Dumper/Dumper.pm      Data pretty printer, module
 ext/Data/Dumper/Dumper.xs      Data pretty printer, externals
index 6d374bf..8f36456 100644 (file)
    * Added a BOOT check to test for equivalent versions of db.h &
      libdb.a/so.
 
+1.71 7th September 1999
+
+   * Fixed a bug that prevented 1.70 from compiling under win32
+
+   * Updated to support Berkeley DB 3.x
+
+   * Updated dbinfo for Berkeley DB 3.x file formats.
index e20a562..44bdad6 100644 (file)
@@ -1,8 +1,8 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
 # written by Paul Marquess (Paul.Marquess@btinternet.com)
-# last modified 4th August 1999
-# version 1.70
+# last modified 4th September 1999
+# version 1.71
 #
 #     Copyright (c) 1995-1999 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver
 use Carp;
 
 
-$VERSION = "1.70" ;
+$VERSION = "1.71" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -421,10 +421,10 @@ DB_File - Perl5 access to Berkeley DB version 1.x
 
 B<DB_File> is a module which allows Perl programs to make use of the
 facilities provided by Berkeley DB version 1.x (if you have a newer
-version of DB, see L<Using DB_File with Berkeley DB version 2>). It is
-assumed that you have a copy of the Berkeley DB manual pages at hand
-when reading this documentation. The interface defined here mirrors the
-Berkeley DB interface closely.
+version of DB, see L<Using DB_File with Berkeley DB version 2 or 3>).
+It is assumed that you have a copy of the Berkeley DB manual pages at
+hand when reading this documentation. The interface defined here
+mirrors the Berkeley DB interface closely.
 
 Berkeley DB is a C library which provides a consistent interface to a
 number of database formats.  B<DB_File> provides an interface to all
@@ -465,32 +465,33 @@ number.
 
 =back
 
-=head2 Using DB_File with Berkeley DB version 2
+=head2 Using DB_File with Berkeley DB version 2 or 3
 
 Although B<DB_File> is intended to be used with Berkeley DB version 1,
-it can also be used with version 2. In this case the interface is
+it can also be used with version 2.or 3 In this case the interface is
 limited to the functionality provided by Berkeley DB 1.x. Anywhere the
-version 2 interface differs, B<DB_File> arranges for it to work like
-version 1. This feature allows B<DB_File> scripts that were built with
-version 1 to be migrated to version 2 without any changes.
+version 2 or 3 interface differs, B<DB_File> arranges for it to work
+like version 1. This feature allows B<DB_File> scripts that were built
+with version 1 to be migrated to version 2 or 3 without any changes.
 
 If you want to make use of the new features available in Berkeley DB
-2.x, use the Perl module B<BerkeleyDB> instead.
+2.x or 3.x, use the Perl module B<BerkeleyDB> instead.
 
 At the time of writing this document the B<BerkeleyDB> module is still
 alpha quality (the version number is < 1.0), and so unsuitable for use
 in any serious development work. Once its version number is >= 1.0, it
 is considered stable enough for real work.
 
-B<Note:> The database file format has changed in Berkeley DB version 2.
-If you cannot recreate your databases, you must dump any existing
-databases with the C<db_dump185> utility that comes with Berkeley DB.
-Once you have rebuilt DB_File to use Berkeley DB version 2, your
+B<Note:> The database file format has changed in both Berkeley DB
+version 2 and 3. If you cannot recreate your databases, you must dump
+any existing databases with the C<db_dump185> utility that comes with
+Berkeley DB.
+Once you have rebuilt DB_File to use Berkeley DB version 2 or 3, your
 databases can be recreated using C<db_load>. Refer to the Berkeley DB
 documentation for further details.
 
-Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with
-DB_File.
+Please read L<"COPYRIGHT"> before using version 2.x or 3.x of Berkeley
+DB with DB_File.
 
 =head2 Interface to Berkeley DB
 
@@ -1940,11 +1941,12 @@ date, so the most recent version can always be found on CPAN (see
 L<perlmod/CPAN> for details), in the directory
 F<modules/by-module/DB_File>.
 
-This version of B<DB_File> will work with either version 1.x or 2.x of
-Berkeley DB, but is limited to the functionality provided by version 1.
+This version of B<DB_File> will work with either version 1.x, 2.x or
+3.x of Berkeley DB, but is limited to the functionality provided by
+version 1.
 
 The official web site for Berkeley DB is F<http://www.sleepycat.com>.
-Both versions 1 and 2 of Berkeley DB are available there.
+All versions of Berkeley DB are available there.
 
 Alternatively, Berkeley DB version 1 is available at your nearest CPAN
 archive in F<src/misc/db.1.85.tar.gz>.
index 1a13e0b..a247924 100644 (file)
@@ -14,7 +14,15 @@ WriteMakefile(
         MAN3PODS        => {},         # Pods will be built by installman.
        #INC            => '-I/usr/local/include',
        VERSION_FROM    => 'DB_File.pm',
+       OBJECT          => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)',
        XSPROTOARG      => '-noprototypes',
        DEFINE          => "$OS2",
        );
 
+sub MY::postamble {
+      '
+version$(OBJ_EXT):     version.c
+
+' ;
+}
+
index 24a7944..701ac61 100644 (file)
@@ -4,8 +4,8 @@
 #                        a database file
 #
 # Author:      Paul Marquess  <Paul.Marquess@btinternet.com>
-# Version:     1.01 
-# Date         16th April 1998
+# Version:     1.02 
+# Date         20th August 1999
 #
 #     Copyright (c) 1998 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -19,7 +19,7 @@ use strict ;
 my %Data =
        (
        0x053162 =>     {
-                         Type  => "Btree",
+                         Type     => "Btree",
                          Versions => 
                                {
                                  1     => "Unknown (older than 1.71)",
@@ -27,18 +27,27 @@ my %Data =
                                  3     => "1.71 -> 1.85, 1.86",
                                  4     => "Unknown",
                                  5     => "2.0.0 -> 2.3.0",
-                                 6     => "2.3.1 or greater",
+                                 6     => "2.3.1 -> 2.7.7",
+                                 7     => "3.0.0 or greater",
                                }
                        },
        0x061561 =>     {
-                         Type => "Hash",
+                         Type     => "Hash",
                          Versions =>
                                {
                                  1     => "Unknown (older than 1.71)",
                                  2     => "1.71 -> 1.85",
                                  3     => "1.86",
                                  4     => "2.0.0 -> 2.1.0",
-                                 5     => "2.2.6 or greater",
+                                 5     => "2.2.6 -> 2.7.7",
+                                 6     => "3.0.0 or greater",
+                               }
+                       },
+       0x042253 =>     {
+                         Type     => "Queue",
+                         Versions =>
+                               {
+                                 1     => "3.0.0 or greater",
                                }
                        },
        ) ;
index a614cc4..41a24f4 100644 (file)
@@ -1,8 +1,8 @@
 # typemap for Perl 5 interface to Berkeley 
 #
 # written by Paul Marquess <Paul.Marquess@btinternet.com>
-# last modified 6th June 1999
-# version 1.67
+# last modified 7th September 1999
+# version 1.71
 #
 #################################### DB SECTION
 #
@@ -16,22 +16,21 @@ DBTKEY                      T_dbtkeydatum
 INPUT
 T_dbtkeydatum
        ckFilter($arg, filter_store_key, \"filter_store_key\");
+       DBT_clear($var) ;
        if (db->type != DB_RECNO) {
            $var.data = SvPV($arg, PL_na);
            $var.size = (int)PL_na;
-           DBT_flags($var);
        }
        else {
            Value =  GetRecnoKey(aTHX_ db, SvIV($arg)) ; 
            $var.data = & Value; 
            $var.size = (int)sizeof(recno_t);
-           DBT_flags($var);
        }
 T_dbtdatum
        ckFilter($arg, filter_store_value, \"filter_store_value\");
+       DBT_clear($var) ;
        $var.data = SvPV($arg, PL_na);
        $var.size = (int)PL_na;
-       DBT_flags($var);
 
 
 OUTPUT
diff --git a/ext/DB_File/version.c b/ext/DB_File/version.c
new file mode 100644 (file)
index 0000000..23c96a6
--- /dev/null
@@ -0,0 +1,70 @@
+/* 
+
+ version.c -- Perl 5 interface to Berkeley DB 
+
+ written by Paul Marquess <Paul.Marquess@btinternet.com>
+ last modified 7th September 1999
+ version 1.71
+
+ All comments/suggestions/problems are welcome
+
+     Copyright (c) 1995-9 Paul Marquess. All rights reserved.
+     This program is free software; you can redistribute it and/or
+     modify it under the same terms as Perl itself.
+
+ Changes:
+        1.71 -  Support for Berkeley DB version 3.
+               Support for Berkeley DB 2/3's backward compatability mode.
+
+*/
+
+#include "EXTERN.h"  
+#include "perl.h"
+#include "XSUB.h"
+
+#include <db.h>
+
+void
+__getBerkeleyDBInfo()
+{
+    SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ;
+    SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ;
+    SV * compat_sv = perl_get_sv("DB_File::db_185_compat", GV_ADD|GV_ADDMULTI) ;
+
+#ifdef DB_VERSION_MAJOR
+    int Major, Minor, Patch ;
+
+    (void)db_version(&Major, &Minor, &Patch) ;
+
+    /* Check that the versions of db.h and libdb.a are the same */
+    if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR 
+               || Patch != DB_VERSION_PATCH)
+       croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",  
+               DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, 
+               Major, Minor, Patch) ;
+    
+    /* check that libdb is recent enough  -- we need 2.3.4 or greater */
+    if (Major == 2 && (Minor < 3 || (Minor ==  3 && Patch < 4)))
+       croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
+                Major, Minor, Patch) ;
+    {
+        char buffer[40] ;
+        sprintf(buffer, "%d.%d", Major, Minor) ;
+        sv_setpv(version_sv, buffer) ; 
+        sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
+        sv_setpv(ver_sv, buffer) ; 
+    }
+#else /* ! DB_VERSION_MAJOR */
+    sv_setiv(version_sv, 1) ;
+    sv_setiv(ver_sv, 1) ;
+#endif /* ! DB_VERSION_MAJOR */
+
+#ifdef COMPAT185
+    sv_setiv(compat_sv, 1) ;
+#else /* ! COMPAT185 */
+    sv_setiv(compat_sv, 0) ;
+#endif /* ! COMPAT185 */
+
+}
index 75bcc38..60f42e8 100644 (file)
@@ -74,7 +74,8 @@ sub cheat {
     $year = $_[5];
     $month = $_[4];
     croak "Month '$month' out of range 0..11"  if $month > 11 || $month < 0;
-    croak "Day '$_[3]' out of range 1..31"     if $_[3] > 31 || $_[3] < 1;
+#    Allow "julian" conversions. --jhi 1999-09-09
+#    croak "Day '$_[3]' out of range 1..31"    if $_[3] > 31 || $_[3] < 1;
     croak "Hour '$_[2]' out of range 0..23"    if $_[2] > 23 || $_[2] < 0;
     croak "Minute '$_[1]' out of range 0..59"  if $_[1] > 59 || $_[1] < 0;
     croak "Second '$_[0]' out of range 0..59"  if $_[0] > 59 || $_[0] < 0;
diff --git a/perl.h b/perl.h
index 94af360..8d0a7bd 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1714,22 +1714,6 @@ typedef pthread_key_t    perl_key;
 #  endif
 #endif
 
-#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
-#  ifdef USE_THREADS
-#    define PERL_GET_THX               THR
-#  else
-#  ifdef MULTIPLICITY
-#    define PERL_GET_THX               PERL_GET_INTERP
-#  else
-#  ifdef PERL_OBJECT
-#    define PERL_GET_THX               ((CPerlObj*)PERL_GET_INTERP)
-#  else
-#    define PERL_GET_THX               ((void*)0)
-#  endif
-#  endif
-#  endif
-#endif
-
 /* Some unistd.h's give a prototype for pause() even though
    HAS_PAUSE ends up undefined.  This causes the #define
    below to be rejected by the compmiler.  Sigh.
old mode 100644 (file)
new mode 100755 (executable)
old mode 100644 (file)
new mode 100755 (executable)
index 94b4635..bfd071a 100644 (file)
@@ -150,15 +150,17 @@ use "quads" (64-integers) as follows:
 
 =over 4
 
-=item constants in the code 
+=item constants (decimal, hexadecimal, octal, binary) in the code 
 
 =item arguments to oct() and hex()
 
-=item arguments to print(), printf() and sprintf()
+=item arguments to print(), printf() and sprintf() (flag prefixes ll, L, q)
 
-=item pack() and unpack() "q" format
+=item printed as such
 
-=item in basic arithmetics
+=item pack() and unpack() "q" and "Q" formatS
+
+=item in basic arithmetics: + - * / %
 
 =item vec() (but see the below note about bit arithmetics)
     
@@ -167,7 +169,8 @@ use "quads" (64-integers) as follows:
 Note that unless you have the case (a) you will have to configure
 and compile Perl using the -Duse64bits Configure flag.
 
-Unfortunately bit arithmetics (&, |, ^, ~, <<, >>) are not 64-bit clean.
+Unfortunately bit arithmetics (&, |, ^, ~, <<, >>) are not 64-bit clean,
+they are explictly forced to be 32-bit.
 
 Last but not least: note that due to Perl's habit of always using
 floating point numbers the quads are still not true integers.
@@ -527,7 +530,9 @@ runtime error.
 
 The timelocal() and timegm() functions used to silently return bogus
 results when the date exceeded the machine's integer range.  They
-now consistently croak() if the date falls in an unsupported range.
+now consistently croak() if the date falls in an unsupported range--
+but on the other hand they now accept "out-of-limits" day-of-month
+to make "Julian date" conversions easier.
 
 =item Win32
 
@@ -725,13 +730,6 @@ like in the first argument to C<join>.  Perl will treat the true
 or false result of matching the pattern against $_ as the string,
 which is probably not what you had in mind.
 
-=item /%s/ should probably be written as "%s"
-
-(W) You have used a pattern where Perl expected to find a string,
-like in the first argument to C<join>.  Perl will treat the true
-or false result of matching the pattern against $_ as the string,
-which is probably not what you had in mind.
-
 =head1 Obsolete Diagnostics
 
 Todo.
index 5271a86..e0beb4e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
 /* Shadow password support for solaris - pdo@cs.umd.edu
  * Not just Solaris: at least HP-UX, IRIX, Linux.
  * the API is from SysV. --jhi */
+#ifdef __hpux__
+/* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h>
+ * and another MAXINT from "perl.h" <- <sys/param.h>. */ 
+#undef MAXINT
+#endif
 #include <shadow.h>
 #endif
 
index 3fb1826..8361145 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -642,7 +642,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     register I32 tmp;
     I32 minlen;                /* must match at least this many chars */
     I32 dontbother = 0;        /* how many characters not to try at end */
-    CURCUR cc;
     I32 start_shift = 0;               /* Offset of the start to find
                                         constant substr. */            /* CC */
     I32 end_shift = 0;                 /* Same for the end. */         /* CC */
@@ -650,9 +649,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     char *scream_olds;
     SV* oreplsv = GvSV(PL_replgv);
 
-    cc.cur = 0;
-    cc.oldcc = 0;
-    PL_regcc = &cc;
+    PL_regcc = 0;
 
     cache_re(prog);
 #ifdef DEBUGGING
@@ -2109,7 +2106,6 @@ S_regmatch(pTHX_ regnode *prog)
                    regexp *re;
                    MAGIC *mg = Null(MAGIC*);
                    re_cc_state state;
-                   CURCUR cctmp;
                    CHECKPOINT cp, lastcp;
 
                    if(SvROK(ret) || SvRMAGICAL(ret)) {
@@ -2152,9 +2148,7 @@ S_regmatch(pTHX_ regnode *prog)
                    state.cc = PL_regcc;
                    state.re = PL_reg_re;
 
-                   cctmp.cur = 0;
-                   cctmp.oldcc = 0;
-                   PL_regcc = &cctmp;
+                   PL_regcc = 0;
                    
                    cp = regcppush(0);  /* Save *all* the positions. */
                    REGCP_SET;
@@ -2168,6 +2162,20 @@ S_regmatch(pTHX_ regnode *prog)
                    PL_reg_maxiter = 0;
 
                    if (regmatch(re->program + 1)) {
+                       /* Even though we succeeded, we need to restore
+                          global variables, since we may be wrapped inside
+                          SUSPEND, thus the match may be not finished yet. */
+
+                       /* XXXX Do this only if SUSPENDed? */
+                       PL_reg_call_cc = state.prev;
+                       PL_regcc = state.cc;
+                       PL_reg_re = state.re;
+                       cache_re(PL_reg_re);
+
+                       /* XXXX This is too dramatic a measure... */
+                       PL_reg_maxiter = 0;
+
+                       /* These are needed even if not SUSPEND. */
                        ReREFCNT_dec(re);
                        regcpblow(cp);
                        sayYES;
@@ -2227,6 +2235,81 @@ S_regmatch(pTHX_ regnode *prog)
        case LOGICAL:
            logical = scan->flags;
            break;
+/*******************************************************************
+ PL_regcc contains infoblock about the innermost (...)* loop, and
+ a pointer to the next outer infoblock.
+
+ Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
+
+   1) After matching X, regnode for CURLYX is processed;
+
+   2) This regnode creates infoblock on the stack, and calls 
+      regmatch() recursively with the starting point at WHILEM node;
+
+   3) Each hit of WHILEM node tries to match A and Z (in the order
+      depending on the current iteration, min/max of {min,max} and
+      greediness).  The information about where are nodes for "A"
+      and "Z" is read from the infoblock, as is info on how many times "A"
+      was already matched, and greediness.
+
+   4) After A matches, the same WHILEM node is hit again.
+
+   5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
+      of the same pair.  Thus when WHILEM tries to match Z, it temporarily
+      resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
+      as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
+      of the external loop.
+
+ Currently present infoblocks form a tree with a stem formed by PL_curcc
+ and whatever it mentions via ->next, and additional attached trees
+ corresponding to temporarily unset infoblocks as in "5" above.
+
+ In the following picture infoblocks for outer loop of 
+ (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
+ is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
+ infoblocks are drawn below the "reset" infoblock.
+
+ In fact in the picture below we do not show failed matches for Z and T
+ by WHILEM blocks.  [We illustrate minimal matches, since for them it is
+ more obvious *why* one needs to *temporary* unset infoblocks.]
+
+  Matched      REx position    InfoBlocks      Comment
+               (Y(A)*?Z)*?T    x
+               Y(A)*?Z)*?T     x <- O
+  Y            (A)*?Z)*?T      x <- O
+  Y            A)*?Z)*?T       x <- O <- I
+  YA           )*?Z)*?T        x <- O <- I
+  YA           A)*?Z)*?T       x <- O <- I
+  YAA          )*?Z)*?T        x <- O <- I
+  YAA          Z)*?T           x <- O          # Temporary unset I
+                                    I
+
+  YAAZ         Y(A)*?Z)*?T     x <- O
+                                    I
+
+  YAAZY                (A)*?Z)*?T      x <- O
+                                    I
+
+  YAAZY                A)*?Z)*?T       x <- O <- I
+                                    I
+
+  YAAZYA       )*?Z)*?T        x <- O <- I     
+                                    I
+
+  YAAZYA       Z)*?T           x <- O          # Temporary unset I
+                                    I,I
+
+  YAAZYAZ      )*?T            x <- O
+                                    I,I
+
+  YAAZYAZ      T               x               # Temporary unset O
+                               O
+                               I,I
+
+  YAAZYAZT                     x
+                               O
+                               I,I
+ *******************************************************************/
        case CURLYX: {
                CURCUR cc;
                CHECKPOINT cp = PL_savestack_ix;
@@ -2279,7 +2362,8 @@ S_regmatch(pTHX_ regnode *prog)
 
                if (locinput == cc->lastloc && n >= cc->min) {
                    PL_regcc = cc->oldcc;
-                   ln = PL_regcc->cur;
+                   if (PL_regcc)
+                       ln = PL_regcc->cur;
                    DEBUG_r(
                        PerlIO_printf(Perl_debug_log,
                           "%*s  empty match detected, try continuation...\n",
@@ -2292,7 +2376,8 @@ S_regmatch(pTHX_ regnode *prog)
                                      "%*s  failed...\n",
                                      REPORT_CODE_OFF+PL_regindent*2, "")
                        );
-                   PL_regcc->cur = ln;
+                   if (PL_regcc)
+                       PL_regcc->cur = ln;
                    PL_regcc = cc;
                    sayNO;
                }
@@ -2363,7 +2448,8 @@ S_regmatch(pTHX_ regnode *prog)
 
                if (cc->minmod) {
                    PL_regcc = cc->oldcc;
-                   ln = PL_regcc->cur;
+                   if (PL_regcc)
+                       ln = PL_regcc->cur;
                    cp = regcppush(cc->parenfloor);
                    REGCP_SET;
                    if (regmatch(cc->next)) {
@@ -2372,7 +2458,8 @@ S_regmatch(pTHX_ regnode *prog)
                    }
                    REGCP_UNWIND;
                    regcppop();
-                   PL_regcc->cur = ln;
+                   if (PL_regcc)
+                       PL_regcc->cur = ln;
                    PL_regcc = cc;
 
                    if (n >= cc->max) { /* Maximum greed exceeded? */
@@ -2443,14 +2530,16 @@ S_regmatch(pTHX_ regnode *prog)
 
                /* Failed deeper matches of scan, so see if this one works. */
                PL_regcc = cc->oldcc;
-               ln = PL_regcc->cur;
+               if (PL_regcc)
+                   ln = PL_regcc->cur;
                if (regmatch(cc->next))
                    sayYES;
                DEBUG_r(
                    PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
                                  REPORT_CODE_OFF+PL_regindent*2, "")
                    );
-               PL_regcc->cur = ln;
+               if (PL_regcc)
+                   PL_regcc->cur = ln;
                PL_regcc = cc;
                cc->cur = n - 1;
                cc->lastloc = lastloc;
diff --git a/sv.c b/sv.c
index 956f3b9..5be8a31 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5033,8 +5033,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                    dig = uv & 1;
                    *--eptr = '0' + dig;
                } while (uv >>= 1);
-               if (alt && *eptr != '0')
-                   *--eptr = '0';
+               if (alt) {
+                   esignbuf[esignlen++] = '0';
+                   esignbuf[esignlen++] = 'b';
+               }
                break;
            default:            /* it had better be ten or less */
                do {
index cea8163..b13e50e 100755 (executable)
@@ -82,6 +82,8 @@ sub docat_del
 }   
 
 
+$db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
+
 my $Dfile = "dbbtree.tmp";
 unlink $Dfile;
 
@@ -933,7 +935,7 @@ EOM
     unlink $filename ;
   }  
 
-  ok(150, docat_del($file) eq ($DB_File::db_version == 1 ? <<'EOM' : <<'EOM') ) ;
+  ok(150, docat_del($file) eq ($db185mode ? <<'EOM' : <<'EOM') ) ;
 Smith  -> John
 Wall   -> Brick
 Wall   -> Brick
@@ -987,7 +989,7 @@ EOM
     untie %h ;
   }
 
-  ok(151, docat_del($file) eq ($DB_File::db_version == 1 ? <<'EOM' : <<'EOM') ) ;
+  ok(151, docat_del($file) eq ($db185mode == 1 ? <<'EOM' : <<'EOM') ) ;
 Smith  -> John
 Wall   -> Brick
 Wall   -> Brick
old mode 100755 (executable)
new mode 100644 (file)
index 6312c75..768d1b9 100755 (executable)
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..188\n";
+print "1..191\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -865,3 +865,20 @@ print "not " unless("@a" eq ",f,,o,,o, ,b,,a,,r,");
 print "ok $test\n";
 $test++;
 
+$brackets = qr{
+                {  (?> [^{}]+ | (?p{ $brackets }) )* }
+             }x;
+
+"{{}" =~ $brackets;
+print "ok $test\n";            # Did we survive?
+$test++;
+
+"something { long { and } hairy" =~ $brackets;
+print "ok $test\n";            # Did we survive?
+$test++;
+
+"something { long { and } hairy" =~ m/((?p{ $brackets }))/;
+print "not " unless $1 eq "{ and }";
+print "ok $test\n";
+$test++;
+
index ef5b94c..70e55cb 100755 (executable)
@@ -14,8 +14,8 @@ $SIG{__WARN__} = sub {
 };
 
 $w = 0;
-$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f %b","hi",123,0,456,0,ord('A'),3.0999,11);
-if ($x eq ' hi 123 %foo   456 0A3.1 1011' && $w == 0) {
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f %b %x %X %#b %#x %#X","hi",123,0,456,0,ord('A'),3.0999,11,171,171,11,171,171);
+if ($x eq ' hi 123 %foo   456 0A3.1 1011 ab AB 0b1011 0xab 0XAB' && $w == 0) {
     print "ok 1\n";
 } else {
     print "not ok 1 '$x'\n";
old mode 100755 (executable)
new mode 100644 (file)