This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate cfgperl contents into mainline, update Changes
authorGurusamy Sarathy <gsar@cpan.org>
Mon, 13 Sep 1999 19:32:31 +0000 (19:32 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Mon, 13 Sep 1999 19:32:31 +0000 (19:32 +0000)
p4raw-id: //depot/perl@4142

44 files changed:
Changes
Configure
MANIFEST
doio.c
dump.c
ext/B/B.xs
ext/B/typemap
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]
ext/Devel/DProf/DProf.xs
ext/DynaLoader/dl_aix.xs
ext/DynaLoader/dl_beos.xs
ext/DynaLoader/dl_cygwin.xs
ext/DynaLoader/dl_dld.xs
ext/DynaLoader/dl_dlopen.xs
ext/DynaLoader/dl_hpux.xs
ext/DynaLoader/dl_mpeix.xs
ext/DynaLoader/dl_next.xs
ext/DynaLoader/dl_rhapsody.xs
ext/DynaLoader/dl_vmesa.xs
ext/DynaLoader/dl_vms.xs
ext/ODBM_File/ODBM_File.xs
ext/POSIX/POSIX.xs
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/typemap
lib/Time/Local.pm
malloc.c
perl.h
pod/perldelta.pod
pod/perldiag.pod
pp.c
pp_ctl.c
pp_hot.c
pp_sys.c
regexec.c
sv.c
t/lib/db-btree.t
t/op/pat.t
t/op/sprintf.t

diff --git a/Changes b/Changes
index 6fd3e3c..92c5765 100644 (file)
--- a/Changes
+++ b/Changes
@@ -79,6 +79,195 @@ Version 5.005_62        Development release working toward 5.006
 ----------------
 
 ____________________________________________________________________________
+[  4141] By: jhi                                   on 1999/09/13  16:16:56
+        Log: Scan for <pthread.h> always.
+     Branch: cfgperl
+          ! Configure config_h.SH perl.h
+     Branch: metaconfig
+          ! U/threads/i_pthread.U
+____________________________________________________________________________
+[  4140] By: jhi                                   on 1999/09/13  16:00:08
+        Log: Integrate with Sarathy.
+     Branch: cfgperl
+         !> (integrate 27 files)
+____________________________________________________________________________
+[  4139] By: jhi                                   on 1999/09/13  15:35:18
+        Log: Add -A option to Configure to diddle with variables
+             after the hints file has been applied.
+     Branch: cfgperl
+          ! Configure config_h.SH
+     Branch: metaconfig
+          ! U/modified/Oldconfig.U U/modified/Options.U
+____________________________________________________________________________
+[  4138] By: jhi                                   on 1999/09/13  13:42:56
+        Log: Change #4136 edited DynaLoader.xs which is kind of fruitless.
+     Branch: cfgperl
+          ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_beos.xs
+          ! ext/DynaLoader/dl_cygwin.xs ext/DynaLoader/dl_dld.xs
+          ! ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_mpeix.xs
+          ! ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs
+          ! ext/DynaLoader/dl_vmesa.xs ext/DynaLoader/dl_vms.xs
+____________________________________________________________________________
+[  4137] By: jhi                                   on 1999/09/13  13:25:31
+        Log: Applying change #4136 manually introduced patch residue.
+     Branch: cfgperl
+          ! perl.h
+____________________________________________________________________________
+[  4136] By: jhi                                   on 1999/09/13  13:23:04
+        Log: Replace change #4100 with
+             From: Robin Barker <rmb1@cise.npl.co.uk>
+             To: gsar@activestate.com
+             Cc: perl5-porters@perl.org
+             Subject: Re: [ID 19990907.004] [PATCH perl5.005_61] compiler warnings with -Duse64bits
+             Date: Mon, 13 Sep 1999 14:15:11 +0100 (BST)
+             Message-Id: <199909131315.OAA24012@tempest.npl.co.uk>
+     Branch: cfgperl
+          ! doio.c dump.c ext/B/B.xs ext/B/typemap
+          ! ext/ByteLoader/bytecode.h ext/Devel/DProf/DProf.xs
+          ! ext/DynaLoader/dl_dlopen.xs ext/ODBM_File/ODBM_File.xs
+          ! ext/POSIX/POSIX.xs lib/ExtUtils/typemap malloc.c perl.h pp.c
+          ! pp_ctl.c pp_hot.c pp_sys.c sv.c
+____________________________________________________________________________
+[  4135] By: jhi                                   on 1999/09/13  10:22:31
+        Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+             To: perl5-porters@perl.org (Mailing list Perl5)
+             Subject: [PATCH 5.005_61] MakeMaker supports uninstalled Perls
+             Date: Sat, 11 Sep 1999 05:31:03 -0400 (EDT)
+             Message-Id: <199909110931.FAA11036@monk.mps.ohio-state.edu>
+             
+             From: andreas.koenig@anima.de (Andreas J. Koenig)
+             To: Ilya Zakharevich <ilya@math.ohio-state.edu>
+             Cc: perl5-porters@perl.org (Mailing list Perl5)
+             Subject: Re: [PATCH 5.005_61] MakeMaker supports uninstalled Perls
+             Date: 11 Sep 1999 15:36:26 +0200
+             Message-ID: <sfc906dr2n9.fsf@hohenstaufen.in-berlin.de>
+     Branch: cfgperl
+          ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[  4134] By: jhi                                   on 1999/09/13  10:20:14
+        Log: From: Tom Phoenix <rootbeer@redcat.com>
+             To: Perl Porters Mailing List <perl5-porters@perl.org>
+             Subject: [DOCPATCH] Server errors and perldiag
+             Date: Fri, 10 Sep 1999 16:45:02 -0700 (PDT)
+             Message-ID: <Pine.GSO.4.10.9909101639490.16999-100000@user2.teleport.com>
+     Branch: cfgperl
+          ! pod/perldiag.pod
+____________________________________________________________________________
+[  4133] By: gsar                                  on 1999/09/13  03:25:43
+        Log: avoid assertion failure on C<@a'>
+     Branch: perl
+          ! toke.c
+____________________________________________________________________________
+[  4132] By: gsar                                  on 1999/09/13  03:03:57
+        Log: add -DPERL_Y2KWARN build option that will generate additional
+             warnings on "19$yy" etc (reworked a patch suggested by
+             Ulrich Pfeifer <upf@de.uu.net>)
+     Branch: perl
+          ! pod/perldelta.pod pod/perldiag.pod pod/perllexwarn.pod
+          ! pp_hot.c sv.c t/pragma/warn/pp_hot t/pragma/warn/sv
+____________________________________________________________________________
+[  4131] By: gsar                                  on 1999/09/12  22:06:25
+        Log: fix DATA leaks; reword documentation about the DATA filehandle
+     Branch: perl
+          ! ext/Opcode/Safe.pm lib/Pod/Functions.pm pod/perldata.pod
+____________________________________________________________________________
+[  4130] By: gsar                                  on 1999/09/12  20:08:56
+        Log: make sprintf("%g",...) threadsafe; only taint its result iff the
+             formatted result looks nonstandard
+     Branch: perl
+          ! embed.pl embedvar.h intrpvar.h objXSUB.h perl.c perlapi.c
+          ! pod/perlfunc.pod pod/perlguts.pod proto.h sv.c
+          ! t/pragma/locale.t thrdvar.h
+____________________________________________________________________________
+[  4129] By: gsar                                  on 1999/09/12  17:04:11
+        Log: From: Doug MacEachern <dougm@cp.net>
+             Date: Sun, 25 Jul 1999 15:49:00 -0700 (PDT)
+             Message-ID: <Pine.LNX.4.10.9907251538380.373-100000@mojo.eng.cp.net>
+             Subject: [PATCH 5.005_57] B::clearsym
+     Branch: perl
+          ! ext/B/B.pm ext/B/B/Bblock.pm ext/B/B/Debug.pm ext/B/B/Terse.pm
+____________________________________________________________________________
+[  4128] By: gsar                                  on 1999/09/12  16:59:12
+        Log: better debugger help output (from Ilya Zakharevich)
+     Branch: perl
+          ! lib/perl5db.pl
+____________________________________________________________________________
+[  4127] By: jhi                                   on 1999/09/11  20:50:37
+        Log: Integrate with Sarathy.
+     Branch: cfgperl
+         +> pod/perlcompile.pod t/lib/gol-basic.t t/lib/gol-compat.t
+         +> t/lib/gol-linkage.t
+         !> (integrate 43 files)
+____________________________________________________________________________
+[  4126] By: nick                                  on 1999/09/10  20:44:22
+        Log: Get resolve -at mainline
+     Branch: utfperl
+         +> (branch 297 files)
+          - README.cygwin32 XSlock.h bytecode.h byterun.c byterun.h
+          - cygwin32/cw32imp.h cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc
+          - cygwin32/perlld ext/B/byteperl.c ext/DynaLoader/dl_cygwin32.xs
+          - hints/cygwin32.sh interp.sym myconfig objpp.h perl_exp.SH
+          - t/pragma/warn-1global t/pragma/warning.t thread.sym
+          - win32/GenCAPI.pl win32/TEST win32/autosplit.pl
+          - win32/bin/network.pl win32/bin/webget.pl win32/bin/www.pl
+          - win32/genxsdef.pl win32/makedef.pl win32/makemain.pl
+          - win32/makeperldef.pl win32/perlhost.h
+         !> (integrate 847 files)
+____________________________________________________________________________
+[  4125] By: gsar                                  on 1999/09/10  19:22:14
+        Log: s/dXS_TARGET/dXSTARG/ in change#4044 (to match dARGS vs dXSARGS
+             etc.)
+     Branch: perl
+          ! XSUB.h pp.h
+____________________________________________________________________________
+[  4124] By: gsar                                  on 1999/09/10  19:14:35
+        Log: rewrote substantive parts of patch
+             From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+             Date: Fri, 27 Aug 1999 19:02:18 -0400
+             Message-ID: <19990827190218.A19561@monk.mps.ohio-state.edu>
+             Subject: [PATCH 5.005_58] REx documentation
+     Branch: perl
+          ! pod/perlre.pod
+____________________________________________________________________________
+[  4123] By: gsar                                  on 1999/09/10  18:21:53
+        Log: note about AVf_*
+     Branch: perl
+          ! av.h
+____________________________________________________________________________
+[  4122] By: gsar                                  on 1999/09/10  17:55:42
+        Log: allow 'text' in L<text|A::B/"C"> (from Martin Lichtin
+             <lichtin@bivio.com>)
+     Branch: perl
+          ! lib/Pod/Html.pm
+____________________________________________________________________________
+[  4121] By: gsar                                  on 1999/09/10  17:49:35
+        Log: dos-djgpp update (from Laszlo Molnar <laszlo.molnar@eth.ericsson.se>)
+     Branch: perl
+          ! AUTHORS Changes README.dos djgpp/config.over
+          ! djgpp/configure.bat djgpp/djgpp.c djgpp/djgppsed.sh dosish.h
+          ! lib/ExtUtils/MM_Unix.pm pod/pod2usage.PL pod/podchecker.PL
+          ! pod/podselect.PL sv.h t/io/openpid.t util.c
+____________________________________________________________________________
+[  4120] By: gsar                                  on 1999/09/10  12:25:01
+        Log: add perlcompile.pod (edited content from Nathan Torkington
+             <gnat@frii.com> and others)
+     Branch: perl
+          + pod/perlcompile.pod
+          ! MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/roffitall
+____________________________________________________________________________
+[  4119] By: gsar                                  on 1999/09/10  11:05:13
+        Log: avoid leaking static local_patches unless patchlevel.h is
+             explicitly included
+     Branch: perl
+          ! patchlevel.h perl.c
+____________________________________________________________________________
+[  4118] By: gsar                                  on 1999/09/10  10:44:54
+        Log: upgrade to Getopt::Long v2.20 (from Johan Vromans
+             <jvromans@squirrel.nl>)
+     Branch: perl
+          + t/lib/gol-basic.t t/lib/gol-compat.t t/lib/gol-linkage.t
+          ! Changes MANIFEST lib/Getopt/Long.pm
+____________________________________________________________________________
 [  4117] By: jhi                                   on 1999/09/09  18:24:30
         Log: Remove ill-designed %B introduced by change #4111.
      Branch: cfgperl
index 4b55fa6..78443d0 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Mon Aug 30 22:33:03 EET DST 1999 [metaconfig 3.0 PL70]
+# Generated on Mon Sep 13 19:24:34 EET DST 1999 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.com)
 
 cat >/tmp/c1$$ <<EOF
@@ -1101,7 +1101,7 @@ done
 : produce awk script to parse command line options
 cat >options.awk <<'EOF'
 BEGIN {
-       optstr = "dD:eEf:hKOrsSU:V";    # getopt-style specification
+       optstr = "A:dD:eEf:hKOrsSU:V";  # getopt-style specification
 
        len = length(optstr);
        for (i = 1; i <= len; i++) {
@@ -1161,7 +1161,7 @@ silent=''
 extractsh=''
 override=''
 knowitall=''
-rm -f optdef.sh
+rm -f optdef.sh posthint.sh
 cat >optdef.sh <<EOS
 $startsh
 EOS
@@ -1215,6 +1215,57 @@ while test $# -gt 0; do
                esac
                shift
                ;;
+       -A)
+           shift
+           xxx=''
+           yyy="$1"
+           case "$yyy" in
+           *:*) xxx=`echo $yyy|sed 's!:.*!!'`
+                yyy=`echo $yyy|sed 's!^[^:]*:!!'`
+                ;;
+           esac
+           case "$xxx" in
+           '') xxx=define ;;
+           esac
+           zzz=''
+           uuu='undef'
+           case "$yyy" in
+           *=*) zzz=`echo $yyy|sed 's!^[^=]*=!!'`
+                yyy=`echo $yyy|sed 's!=.*!!'`
+                case "$yyy:$zzz" in
+                undef:) uuu='' ;;
+                esac
+                ;;
+           esac
+           case "$xxx" in
+           append)
+               echo "$yyy=\"\${$yyy}$zzz\""    >> posthint.sh
+               ;;
+           clear)
+               echo "$yyy=''"                  >> posthint.sh
+               ;;
+           define)
+               case "$zzz" in
+               '') zzz=define ;;
+               esac
+               echo "$yyy='$zzz'"              >> posthint.sh
+               ;; 
+           eval)
+               echo "eval \"$yyy=$zzz\""       >> posthint.sh
+               ;; 
+           prepend)
+               echo "$yyy=\"$zzz\${$yyy}\""    >> posthint.sh
+               ;; 
+           undef)
+               case "$zzz" in
+               '') zzz="$uuu" ;;
+               esac
+               echo "$yyy=$zzz"                >> posthint.sh
+               ;; 
+            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2
+               ;;
+           esac
+           ;;
        -V) echo "$me generated by metaconfig 3.0 PL70." >&2
                exit 0;;
        --) break;;
@@ -1227,7 +1278,7 @@ case "$error" in
 true)
        cat >&2 <<EOM
 Usage: $me [-dehrsEKOSV] [-f config.sh] [-D symbol] [-D symbol=value]
-                 [-U symbol] [-U symbol=]
+                 [-U symbol] [-U symbol=] [-A command:symbol...]
   -d : use defaults for all answers.
   -e : go on without questioning past the production of config.sh.
   -f : specify an alternate default configuration file.
@@ -1244,6 +1295,16 @@ Usage: $me [-dehrsEKOSV] [-f config.sh] [-D symbol] [-D symbol=value]
   -U : undefine symbol:
          -U symbol    symbol gets the value 'undef'
          -U symbol=   symbol gets completely empty
+  -A : manipulate symbol after the platform specific hints have been applied:
+        -A append:symbol=value         append value to symbol
+        -A define:symbol=value         define symbol to have value
+        -A symbol=value                define symbol to have value
+         -A clear:symbol               define symbol to be ''
+        -A define:symbol               define symbol to be 'define'
+        -A eval:symbol=value           define symbol to be eval of value
+        -A prepend:symbol=value        prepend value to symbol
+        -A undef:symbol                define symbol to be 'undef'
+        -A undef:symbol=               define symbol to be ''
   -V : print version number and exit (with a zero status).
 EOM
        exit 1
@@ -1269,6 +1330,9 @@ esac
 : run the defines and the undefines, if any, but leave the file out there...
 touch optdef.sh
 . ./optdef.sh
+: create the posthint manipulation script and leave the file out there...
+touch posthint.sh
+. ./posthint.sh
 
 : set package name
 package=perl5
@@ -2496,6 +2560,9 @@ none)  osvers='' ;;
 *) osvers="$ans" ;;
 esac
 
+
+. ./posthint.sh
+
 : who configured the system
 cf_time=`LC_ALL=C; LANGUAGE=C; export LC_ALL; export LANGUAGE; $date 2>&1`
 cf_by=`(logname) 2>/dev/null`
@@ -9160,12 +9227,9 @@ set nice d_nice
 eval $inlibc
 
 : see if POSIX threads are available
-if test "X$usethreads" = "X$define"; then
-       set pthread.h i_pthread
-       eval $inhdr
-else
-       i_pthread="$undef"
-fi
+set pthread.h i_pthread
+eval $inhdr
+
 
 
 
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
diff --git a/doio.c b/doio.c
index 50870b2..0b1cdd1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1696,7 +1696,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     else
     {
        IV i = SvIV(astr);
-       a = (char *)PTR_CAST i;         /* ouch */
+       a = INT2PTR(char *,i);          /* ouch */
     }
     SETERRNO(0,0);
     switch (optype)
diff --git a/dump.c b/dump.c
index 182834e..7f1dba4 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -768,7 +768,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #ifdef IV_IS_QUAD
     Perl_sv_setpvf(aTHX_ d,
                   "(0x%" PERL_PRIx64") at 0x%" PERL_PRIx64 "\n%*s  REFCNT = %" PERL_PRId64 "\n%*s  FLAGS = (",
-                  (UV)PTR_CAST SvANY(sv), (UV)PTR_CAST sv,
+                  PTR2UV(SvANY(sv)), PTR2UV(sv),
                   PL_dumpindent*level, "", (IV)SvREFCNT(sv),
                   PL_dumpindent*level, "");
 #else
@@ -933,7 +933,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
     if (SvROK(sv)) {
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  RV = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST SvRV(sv));
+       Perl_dump_indent(aTHX_ level, file, "  RV = 0x%" PERL_PRIx64 "\n", PTR2IV(SvRV(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  RV = 0x%lx\n", (long)SvRV(sv));
 #endif
@@ -946,7 +946,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if (type <= SVt_PVLV) {
        if (SvPVX(sv)) {
 #ifdef IV_IS_QUAD
-           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%" PERL_PRIx64 " ", (IV)PTR_CAST SvPVX(sv));
+           Perl_dump_indent(aTHX_ level, file,"  PV = 0x%" PERL_PRIx64 " ", PTR2IV(SvPVX(sv)));
 #else
            Perl_dump_indent(aTHX_ level, file,"  PV = 0x%lx ", (long)SvPVX(sv));
 #endif
@@ -976,7 +976,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #ifdef IV_IS_QUAD
        Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %" PERL_PRId64 "\n", (IV)LvTARGOFF(sv));
        Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %" PERL_PRId64 "\n", (IV)LvTARGLEN(sv));
-       Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST LvTARG(sv));
+       Perl_dump_indent(aTHX_ level, file, "  TARG = 0x%" PERL_PRIx64 "\n", PTR2IV(LvTARG(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
        Perl_dump_indent(aTHX_ level, file, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
@@ -987,14 +987,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        break;
     case SVt_PVAV:
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%" PERL_PRIx64 , (IV)PTR_CAST AvARRAY(sv));
+       Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%" PERL_PRIx64 , PTR2IV(AvARRAY(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%lx", (long)AvARRAY(sv));
 #endif
        if (AvARRAY(sv) != AvALLOC(sv)) {
            PerlIO_printf(file, " (offset=%d)\n", (AvARRAY(sv) - AvALLOC(sv)));
 #ifdef IV_IS_QUAD
-           Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST AvALLOC(sv));
+           Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%" PERL_PRIx64 "\n", PTR2IV(AvALLOC(sv)));
 #else
            Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
 #endif
@@ -1004,7 +1004,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #ifdef IV_IS_QUAD
        Perl_dump_indent(aTHX_ level, file, "  FILL = %" PERL_PRId64 "\n", (IV)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %" PERL_PRId64 "\n", (IV)AvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST AvARYLEN(sv));
+       Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%" PERL_PRIx64 "\n", PTR2IV(AvARYLEN(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  FILL = %ld\n", (long)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %ld\n", (long)AvMAX(sv));
@@ -1033,7 +1033,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        break;
     case SVt_PVHV:
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%" PERL_PRIx64,(IV)PTR_CAST HvARRAY(sv));
+       Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%" PERL_PRIx64,PTR2IV(HvARRAY(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  ARRAY = 0x%lx",(long)HvARRAY(sv));
 #endif
@@ -1086,7 +1086,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  FILL = %" PERL_PRId64 "\n", (IV)HvFILL(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %" PERL_PRId64 "\n", (IV)HvMAX(sv));
        Perl_dump_indent(aTHX_ level, file, "  RITER = %" PERL_PRId64 "\n", (IV)HvRITER(sv));
-       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%" PERL_PRIx64 "\n",(IV)PTR_CAST  HvEITER(sv));
+       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%" PERL_PRIx64 "\n",PTR2IV(HvEITER(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  KEYS = %ld\n", (long)HvKEYS(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILL = %ld\n", (long)HvFILL(sv));
@@ -1096,7 +1096,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #endif
        if (HvPMROOT(sv))
 #ifdef IV_IS_QUAD
-           Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%" PERL_PRIx64 "\n",(IV)PTR_CAST HvPMROOT(sv));
+           Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%" PERL_PRIx64 "\n",PTR2IV(HvPMROOT(sv)));
 #else
            Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
 #endif
@@ -1143,7 +1143,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
         if (CvROOT(sv) && dumpops)
            do_op_dump(level+1, file, CvROOT(sv));
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST CvXSUB(sv));
+       Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%" PERL_PRIx64 "\n", PTR2IV(CvXSUB(sv)));
        Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %" PERL_PRId64 "\n", (IV)CvXSUBANY(sv).any_i32);
 #else
        Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
@@ -1177,7 +1177,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  LINES = %ld\n", (long)FmLINES(sv));
 #endif
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST CvPADLIST(sv));
+       Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%" PERL_PRIx64 "\n", PTR2IV(CvPADLIST(sv)));
 #else
        Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
 #endif
@@ -1217,7 +1217,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            CV *outside = CvOUTSIDE(sv);
 #ifdef IV_IS_QUAD
            Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%" PERL_PRIx64 " (%s)\n", 
-                       (IV)PTR_CAST outside
+                       PTR2IV(outside)
                        (!outside ? "null"
                         : CvANON(outside) ? "ANON"
                         : (outside == PL_main_cv) ? "MAIN"
@@ -1245,14 +1245,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 #endif
        do_hv_dump (level, file, "  GvSTASH", GvSTASH(sv));
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  GP = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvGP(sv));
-       Perl_dump_indent(aTHX_ level, file, "    SV = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvSV(sv));
+       Perl_dump_indent(aTHX_ level, file, "  GP = 0x%" PERL_PRIx64 "\n", PTR2IV(GvGP(sv)));
+       Perl_dump_indent(aTHX_ level, file, "    SV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvSV(sv)));
        Perl_dump_indent(aTHX_ level, file, "    REFCNT = %" PERL_PRId64 "\n", (IV)GvREFCNT(sv));
-       Perl_dump_indent(aTHX_ level, file, "    IO = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvIOp(sv));
-       Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%" PERL_PRIx64 "  \n", (IV)PTR_CAST GvFORM(sv));
-       Perl_dump_indent(aTHX_ level, file, "    AV = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvAV(sv));
-       Perl_dump_indent(aTHX_ level, file, "    HV = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvHV(sv));
-       Perl_dump_indent(aTHX_ level, file, "    CV = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST GvCV(sv));
+       Perl_dump_indent(aTHX_ level, file, "    IO = 0x%" PERL_PRIx64 "\n", PTR2IV(GvIOp(sv)));
+       Perl_dump_indent(aTHX_ level, file, "    FORM = 0x%" PERL_PRIx64 "  \n", PTR2IV(GvFORM(sv)));
+       Perl_dump_indent(aTHX_ level, file, "    AV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvAV(sv)));
+       Perl_dump_indent(aTHX_ level, file, "    HV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvHV(sv)));
+       Perl_dump_indent(aTHX_ level, file, "    CV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvCV(sv)));
        Perl_dump_indent(aTHX_ level, file, "    CVGEN = 0x%" PERL_PRIx64 "\n", (IV)GvCVGEN(sv));
        Perl_dump_indent(aTHX_ level, file, "    LASTEXPR = %" PERL_PRId64 "\n", (IV)GvLASTEXPR(sv));
        Perl_dump_indent(aTHX_ level, file, "    LINE = %" PERL_PRId64 "\n", (IV)GvLINE(sv));
@@ -1275,9 +1275,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        break;
     case SVt_PVIO:
 #ifdef IV_IS_QUAD
-       Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST IoIFP(sv));
-       Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST IoOFP(sv));
-       Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%" PERL_PRIx64 "\n", (IV)PTR_CAST IoDIRP(sv));
+       Perl_dump_indent(aTHX_ level, file, "  IFP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoIFP(sv)));
+       Perl_dump_indent(aTHX_ level, file, "  OFP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoOFP(sv)));
+       Perl_dump_indent(aTHX_ level, file, "  DIRP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoDIRP(sv)));
        Perl_dump_indent(aTHX_ level, file, "  LINES = %" PERL_PRId64 "\n", (IV)IoLINES(sv));
        Perl_dump_indent(aTHX_ level, file, "  PAGE = %" PERL_PRId64 "\n", (IV)IoPAGE(sv));
        Perl_dump_indent(aTHX_ level, file, "  PAGE_LEN = %" PERL_PRId64 "\n", (IV)IoPAGE_LEN(sv));
index ad3d008..2d6145d 100644 (file)
@@ -202,7 +202,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
     }
     if (!type) {
        type = svclassnames[SvTYPE(sv)];
-       iv = (IV)PTR_CAST sv;
+       iv = PTR2IV(sv);
     }
     sv_setiv(newSVrv(arg, type), iv);
     return arg;
@@ -211,7 +211,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
 static SV *
 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 {
-    sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)PTR_CAST mg);
+    sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
     return arg;
 }
 
@@ -317,7 +317,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
     if (!SvROK(opsv))
        croak("opsv is not a reference");
     opsv = sv_mortalcopy(opsv);
-    o = (OP*)PTR_CAST SvIV((SV*)SvRV(opsv));
+    o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
     if (walkoptree_debug) {
        PUSHMARK(sp);
        XPUSHs(opsv);
@@ -332,7 +332,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
        OP *kid;
        for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
            /* Use the same opsv. Rely on methods not to mess it up. */
-           sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)PTR_CAST kid);
+           sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
            walkoptree(aTHX_ opsv, method);
        }
     }
@@ -437,7 +437,7 @@ walkoptree_debug(...)
     OUTPUT:
        RETVAL
 
-#define address(sv) (IV)PTR_CAST sv
+#define address(sv) PTR2IV(sv)
 
 IV
 address(sv)
@@ -647,10 +647,10 @@ PMOP_pmreplroot(o)
        if (o->op_type == OP_PUSHRE) {
            sv_setiv(newSVrv(ST(0), root ?
                             svclassnames[SvTYPE((SV*)root)] : "B::SV"),
-                    (IV)PTR_CAST root);
+                    PTR2IV(root));
        }
        else {
-           sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)PTR_CAST root);
+           sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
        }
 
 B::OP
@@ -1153,7 +1153,7 @@ void
 CvXSUB(cv)
        B::CV   cv
     CODE:
-       ST(0) = sv_2mortal(newSViv((IV)PTR_CAST CvXSUB(cv)));
+       ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
 
 
 void
index 5f6af0f..febadf8 100644 (file)
@@ -35,7 +35,7 @@ INPUT
 T_OP_OBJ
        if (SvROK($arg)) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = ($type)PTR_CAST tmp;
+           $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not a reference\")
@@ -43,7 +43,7 @@ T_OP_OBJ
 T_SV_OBJ
        if (SvROK($arg)) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = ($type)PTR_CAST tmp;
+           $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not a reference\")
@@ -51,18 +51,18 @@ T_SV_OBJ
 T_MG_OBJ
        if (SvROK($arg)) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = ($type)PTR_CAST tmp;
+           $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not a reference\")
 
 OUTPUT
 T_OP_OBJ
-       sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), (IV)PTR_CAST $var);
+       sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var));
 
 T_SV_OBJ
        make_sv_object(aTHX_ ($arg), (SV*)($var));
 
 
 T_MG_OBJ
-       sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)PTR_CAST $var);
+       sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
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 62a0c9e..69f0b89 100644 (file)
@@ -292,7 +292,7 @@ prof_mark( opcode ptype )
            static U32 lastid;
            CV *cv;
 
-           cv = (CV*)PTR_CAST SvIVX(Sub);
+           cv = INT2PTR(CV*,SvIVX(Sub));
            svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE);
            if (!SvOK(*svp)) {
                GV *gv = CvGV(cv);
@@ -568,7 +568,7 @@ XS(XS_DB_sub)
         PUSHMARK( ORIGMARK );
 
 #ifdef G_NODEBUG
-        perl_call_sv( (SV*)PTR_CAST SvIV(Sub), GIMME | G_NODEBUG);
+        perl_call_sv( INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG);
 #else
         curstash = debstash;    /* To disable debugging of perl_call_sv */
 #ifdef PERLDBf_NONAME
index 877b285..c00ded2 100644 (file)
@@ -590,7 +590,7 @@ dl_load_file(filename, flags=0)
        if (RETVAL == NULL)
            SaveError(aTHX_ "%s",dlerror()) ;
        else
-           sv_setiv( ST(0), (IV)RETVAL);
+           sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -606,7 +606,7 @@ dl_find_symbol(libhandle, symbolname)
        if (RETVAL == NULL)
            SaveError(aTHX_ "%s",dlerror()) ;
        else
-           sv_setiv( ST(0), (IV)RETVAL);
+           sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index 1bd16a6..4245910 100644 (file)
@@ -54,7 +54,7 @@ dl_load_file(filename, flags=0)
        PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
     } else {
        RETVAL = (void *) bogo;
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
     }
     free(path);
 }
@@ -83,7 +83,7 @@ dl_find_symbol(libhandle, symbolname)
        SaveError(aTHX_ "%s", strerror(retcode)) ;
        PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
     } else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index 0054afa..60a605f 100644 (file)
@@ -95,7 +95,7 @@ dl_load_file(filename,flags=0)
     if (RETVAL == NULL){
        SaveError(aTHX_ "%d",GetLastError()) ;
     } else {
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
     }
    }
        
@@ -114,7 +114,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%d",GetLastError()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index 1ddc443..d427efa 100644 (file)
@@ -118,7 +118,7 @@ dl_load_file(filename, flags=0)
 haverror:
     ST(0) = sv_newmortal() ;
     if (dlderr == 0)
-       sv_setiv(ST(0), (IV)RETVAL);
+       sv_setiv(ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -135,7 +135,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
     else
-       sv_setiv(ST(0), (IV)RETVAL);
+       sv_setiv(ST(0), PTR2IV(RETVAL));
 
 
 void
index a4dcfb4..641db33 100644 (file)
@@ -166,7 +166,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)PTR_CAST RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -187,7 +187,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)PTR_CAST RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index ce45459..71896b3 100644 (file)
@@ -92,7 +92,7 @@ end:
     if (obj == NULL)
         SaveError(aTHX_ "%s",Strerror(errno));
     else
-        sv_setiv( ST(0), (IV)obj);
+        sv_setiv( ST(0), PTR2IV(obj));
 
 
 void *
@@ -124,7 +124,7 @@ dl_find_symbol(libhandle, symbolname)
     if (status == -1) {
        SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ;
     } else {
-       sv_setiv( ST(0), (IV)symaddr);
+       sv_setiv( ST(0), PTR2IV(symaddr));
     }
 
 
index 4c5d176..65c0297 100644 (file)
@@ -74,7 +74,7 @@ flags));
     if (obj == NULL)
         SaveError(aTHX_"%s",Strerror(errno));
     else
-        sv_setiv( ST(0), (IV)obj);
+        sv_setiv( ST(0), PTR2IV(obj));
 
 void *
 dl_find_symbol(libhandle, symbolname)
@@ -100,7 +100,7 @@ dl_find_symbol(libhandle, symbolname)
     if (status != 0) {
         SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
     } else {
-        sv_setiv( ST(0), (IV)symaddr);
+        sv_setiv( ST(0), PTR2IV(symaddr));
     }
 
 void
index ec01d60..6c8009b 100644 (file)
@@ -252,7 +252,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -273,7 +273,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index 223d7f6..d75b838 100644 (file)
@@ -166,7 +166,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void *
@@ -185,7 +185,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
 
 
 void
index ff1b60b..400793f 100644 (file)
@@ -123,7 +123,7 @@ dl_load_file(filename, flags=0)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
  
  
 void *
@@ -141,7 +141,7 @@ dl_find_symbol(libhandle, symbolname)
     if (RETVAL == NULL)
        SaveError(aTHX_ "%s",dlerror()) ;
     else
-       sv_setiv( ST(0), (IV)RETVAL);
+       sv_setiv( ST(0), PTR2IV(RETVAL));
  
  
 void
index 1024c41..409d586 100644 (file)
@@ -301,7 +301,7 @@ dl_load_file(filespec, flags)
       ST(0) = &PL_sv_undef;
     }
     else {
-      ST(0) = sv_2mortal(newSViv((IV) dlptr));
+      ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
     }
 
 
@@ -328,7 +328,7 @@ dl_find_symbol(librefptr,symname)
       /* error message already saved by findsym_handler */
       ST(0) = &PL_sv_undef;
     }
-    else ST(0) = sv_2mortal(newSViv((IV) entry));
+    else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
 
 
 void
index bb2eb47..7601c34 100644 (file)
@@ -111,7 +111,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
            Zero(RETVAL, 1, ODBM_File_type) ;
            RETVAL->dbp = dbp ;
            ST(0) = sv_mortalcopy(&PL_sv_undef);
-           sv_setptrobj(ST(0), PTR_CAST RETVAL, dbtype);
+           sv_setptrobj(ST(0), RETVAL, dbtype);
        }
 
 void
index 0f09aac..16217f0 100644 (file)
@@ -3246,7 +3246,7 @@ sigaction(sig, action, oldaction = 0)
                }
                else {
                    New(0, sigset, 1, sigset_t);
-                   sv_setptrobj(*svp, PTR_CAST sigset, "POSIX::SigSet");
+                   sv_setptrobj(*svp, sigset, "POSIX::SigSet");
                }
                *sigset = oact.sa_mask;
 
@@ -3274,7 +3274,7 @@ INIT:
        }
        else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
            IV tmp = SvIV((SV*)SvRV(ST(2)));
-           oldsigset = (POSIX__SigSet)PTR_CAST tmp;
+           oldsigset = INT2PTR(POSIX__SigSet,tmp);
        }
        else {
            New(0, oldsigset, 1, sigset_t);
index 0909cc1..5e12773 100644 (file)
@@ -1674,10 +1674,34 @@ from the perl source tree.
        }
     } else {
        # we should also consider $ENV{PERL5LIB} here
+        my $old = $self->{PERL_LIB} || $self->{PERL_ARCHLIB} || $self->{PERL_INC};
        $self->{PERL_LIB}     ||= $Config::Config{privlibexp};
        $self->{PERL_ARCHLIB} ||= $Config::Config{archlibexp};
        $self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
        my $perl_h;
+
+       if (not -f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))
+           and not $old){
+           # Maybe somebody tries to build an extension with an
+           # uninstalled Perl outside of Perl build tree
+           my $found;
+           for my $dir (@INC) {
+             $found = $dir, last if -e $self->catdir($dir, "Config.pm");
+           }
+           if ($found) {
+             my $inc = dirname $found;
+             if (-e $self->catdir($inc, "perl.h")) {
+               $self->{PERL_LIB}          = $found;
+               $self->{PERL_ARCHLIB}      = $found;
+               $self->{PERL_INC}          = $inc;
+               $self->{UNINSTALLED_PERL}  = 1;
+               print STDOUT <<EOP;
+... Detected uninstalled Perl.  Trying to continue.
+EOP
+             }
+           }
+       }
+       
        unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))){
            die qq{
 Error: Unable to locate installed Perl libraries or Perl source code.
@@ -2556,6 +2580,10 @@ sub manifypods {
        $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
     }
     unless ($pod2man_exe = $self->perl_script($pod2man_exe)) {
+      # Maybe a build by uninstalled Perl?
+      $pod2man_exe = $self->catfile($self->{PERL_INC}, "pod", "pod2man");
+    }
+    unless ($pod2man_exe = $self->perl_script($pod2man_exe)) {
        # No pod2man but some MAN3PODS to be installed
        print <<END;
 
index 6318d0e..0f00e39 100644 (file)
@@ -482,7 +482,7 @@ sub ExtUtils::MakeMaker::new {
            else {
                $pthinks =~ s!/Config\.pm$!!; $pthinks =~ s!.*/!!;
            }
-           print STDOUT <<END;
+           print STDOUT <<END unless $self->{UNINSTALLED_PERL};
 Your perl and your Config.pm seem to have different ideas about the architecture
 they are running on.
 Perl thinks: [$pthinks]
index a332024..d84435e 100644 (file)
@@ -1,4 +1,4 @@
-# $Header: /home/rmb1/misc/perl/build/perl5.005_60/lib/ExtUtils/../../../RCS/perl5.005_61/lib/ExtUtils/typemap,v 1.2 1999/09/07 10:05:21 rmb1 Exp $ 
+# $Header: /home/rmb1/misc/CVS/perl5.005_61/lib/ExtUtils/typemap,v 1.3 1999/09/13 09:46:43 rmb1 Exp $ 
 # basic C types
 int                    T_IV
 unsigned               T_UV
@@ -107,11 +107,11 @@ T_DOUBLE
 T_PV
        $var = ($type)SvPV($arg,PL_na)
 T_PTR
-       $var = ($type)PTR_CAST SvIV($arg)
+       $var = INT2PTR($type,SvIV($arg))
 T_PTRREF
        if (SvROK($arg)) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = ($type)PTR_CAST tmp;
+           $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not a reference\")
@@ -132,7 +132,7 @@ T_REF_IV_PTR
 T_PTROBJ
        if (sv_derived_from($arg, \"${ntype}\")) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = ($type)PTR_CAST tmp;
+           $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not of type ${ntype}\")
@@ -147,14 +147,14 @@ T_PTRDESC
 T_REFREF
        if (SvROK($arg)) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = *($type)PTR_CAST tmp;
+           $var = *INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not a reference\")
 T_REFOBJ
        if (sv_isa($arg, \"${ntype}\")) {
            IV tmp = SvIV((SV*)SvRV($arg));
-           $var = *($type)PTR_CAST tmp;
+           $var = *INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not of type ${ntype}\")
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;
index 908d7a7..778f70e 100644 (file)
--- a/malloc.c
+++ b/malloc.c
 
 #define u_char unsigned char
 #define u_int unsigned int
-
-#ifdef HAS_QUAD
-#  define u_bigint UV                  /* Needs to eat *void. */
-#else  /* needed? */
-#  define u_bigint unsigned long       /* Needs to eat *void. */
-#endif
-
+/* 
+ * I removed the definition of u_bigint which appeared to be u_bigint = UV
+ * u_bigint was only used in TWOK_MASKED and TWOK_SHIFT 
+ * where I have used PTR2UV.  RMB
+ */
 #define u_short unsigned short
 
 /* 286 and atarist like big chunks, which gives too much overhead. */
@@ -516,9 +514,9 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
 #  define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT)
 #  define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD)
 #  define TWOK_MASK ((1<<LOG_OF_MIN_ARENA) - 1)
-#  define TWOK_MASKED(x) ((u_bigint)PTR_CAST(x) & ~TWOK_MASK)
-#  define TWOK_SHIFT(x) ((u_bigint)PTR_CAST(x) & TWOK_MASK)
-#  define OV_INDEXp(block) ((u_char*)PTR_CAST(TWOK_MASKED(block)))
+#  define TWOK_MASKED(x) (PTR2UV(x) & ~TWOK_MASK)
+#  define TWOK_SHIFT(x) (PTR2UV(x) & TWOK_MASK)
+#  define OV_INDEXp(block) (INT2PTR(u_char*,TWOK_MASKED(block)))
 #  define OV_INDEX(block) (*OV_INDEXp(block))
 #  define OV_MAGIC(block,bucket) (*(OV_INDEXp(block) +                 \
                                    (TWOK_SHIFT(block)>>                \
@@ -781,7 +779,7 @@ emergency_sbrk(MEM_SIZE size)
        /* Got it, now detach SvPV: */
        pv = SvPV(sv, n_a);
        /* Check alignment: */
-       if (((UV)PTR_CAST (pv - sizeof(union overhead))) & (NEEDED_ALIGNMENT - 1)) {
+       if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) {
            PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
            return (char *)-1;          /* die die die */
        }
@@ -924,7 +922,7 @@ Perl_malloc(register size_t nbytes)
 
        /* remove from linked list */
 #if defined(RCHECK)
-       if (((UV)PTR_CAST p) & (MEM_ALIGNBYTES - 1))
+       if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1))
            PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
                (unsigned long)*((int*)p),(unsigned long)p);
 #endif
@@ -1121,8 +1119,8 @@ getpages(int needed, int *nblksp, int bucket)
 #  ifndef I286         /* The sbrk(0) call on the I286 always returns the next segment */
        /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may
           improve performance of memory access. */
-       if ((UV)PTR_CAST cp & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */
-           slack = WANTED_ALIGNMENT - ((UV)PTR_CAST cp & (WANTED_ALIGNMENT - 1));
+       if (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */
+           slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1));
            add += slack;
        }
 #  endif
@@ -1183,16 +1181,16 @@ getpages(int needed, int *nblksp, int bucket)
         */
 
 #  if NEEDED_ALIGNMENT > MEM_ALIGNBYTES
-       if ((UV)PTR_CAST ovp & (NEEDED_ALIGNMENT - 1))
+       if (PTR2UV(ovp) & (NEEDED_ALIGNMENT - 1))
            fatalcroak("Misalignment of sbrk()\n");
        else
 #  endif
 #ifndef I286   /* Again, this should always be ok on an 80286 */
-       if ((UV)PTR_CAST ovp & (MEM_ALIGNBYTES - 1)) {
+       if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) {
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
                                  "fixing sbrk(): %d bytes off machine alignement\n",
-                                 (int)((UV)PTR_CAST ovp & (MEM_ALIGNBYTES - 1))));
-           ovp = (union overhead *)PTR_CAST (((UV)PTR_CAST ovp + MEM_ALIGNBYTES) &
+                                 (int)(PTR2UV(ovp) & (MEM_ALIGNBYTES - 1))));
+           ovp = INT2PTR(union overhead *,(PTR2UV(ovp) + MEM_ALIGNBYTES) &
                                     (MEM_ALIGNBYTES - 1));
            (*nblksp)--;
 # if defined(DEBUGGING_MSTATS)
diff --git a/perl.h b/perl.h
index 94af360..e5290f9 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -389,7 +389,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
    pthread.h must be included before all other header files.
 */
-#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST)
+#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
 #  include <pthread.h>
 #endif
 
@@ -1044,19 +1044,33 @@ Free_t   Perl_mfree (Malloc_t where);
 #  define IVSIZE LONGSIZE
 #endif
 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
-#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
+#define UV_DIG (BIT_DIGITS(IVSIZE * 8))
 
-#if (IVSIZE > PTRSIZE) || (UVSIZE > PTRSIZE)
+/*   
+ *  The macros INT2PTR and NUM2PTR are (despite their names)
+ *  bi-directional: they will convert int/float to or from pointers.
+ *  However the conversion to int/float are named explicitly:
+ *  PTR2IV, PTR2UV, PTR2NV.
+ *
+ *  For int conversions we do not need two casts if pointers are
+ *  the same size as IV and UV.   Otherwise we need an explicit
+ *  cast (PTRV) to avoid compiler warnings.
+ */
+#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+#  define PTRV                 UV
+#  define INT2PTR(any,d)       (any)(d)
+#else
 #  if PTRSIZE == LONGSIZE 
-#    define PTRV       unsigned long
+#    define PTRV               unsigned long
 #  else
-#    define PTRV       unsigned
+#    define PTRV               unsigned
 #  endif
-#  define PTR_CAST     (PTRV)
-#else
-#  define PTRV         UV
-#  define PTR_CAST 
+#  define INT2PTR(any,d)       (any)(PTRV)(d)
 #endif
+#define NUM2PTR(any,d) (any)(PTRV)(d)
+#define PTR2IV(p)      INT2PTR(IV,p)
+#define PTR2UV(p)      INT2PTR(UV,p)
+#define PTR2NV(p)      NUM2PTR(NV,p)
   
 #ifdef USE_LONG_DOUBLE
 #  if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
@@ -1602,7 +1616,9 @@ typedef mutex_t           perl_mutex;
 typedef condition_t    perl_cond;
 typedef void *         perl_key;
 #        else /* Posix threads */
-#          include <pthread.h>
+#          ifdef I_PTHREAD
+#            include <pthread.h>
+#          endif
 typedef pthread_t      perl_os_thread;
 typedef pthread_mutex_t        perl_mutex;
 typedef pthread_cond_t perl_cond;
index a16f572..8374020 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
 
@@ -709,6 +714,11 @@ too soon.
 (W) You are concatenating the number 19 with another number, which
 could be a potential Year 2000 problem.
 
+=item Possible Y2K bug: %s
+
+(W) You are concatenating the number 19 with another number, which
+could be a potential Year 2000 problem.
+
 =item Unterminated attribute parameter in subroutine attribute list
 
 (F) The lexer saw an opening (left) parenthesis character while parsing a
index 91de1f4..3ad9731 100644 (file)
@@ -1240,6 +1240,10 @@ just use C<if (%hash) { # not empty }> for example.
 C<FOO> is too long for Perl to handle.  You have to be seriously
 twisted to write code that triggers this error.
 
+=item Did not produce a valid header
+
+See Server error.
+
 =item Did you mean &%s instead?
 
 (W) You probably referred to an imported subroutine &FOO as $FOO or some such.
@@ -1266,6 +1270,10 @@ to define the subroutine or package before the current location.  You
 can use an empty "sub foo;" or "package FOO;" to enter a "forward"
 declaration.
 
+=item Document contains no data
+
+See Server error.
+
 =item Don't know how to handle magic of type '%s'
 
 (P) The internal handling of magical variables has been cursed.
@@ -1742,6 +1750,10 @@ See L<perlsub/"Lvalue subroutines">.
 (F) An attempt was made to specify an entry in an overloading table that
 doesn't resolve to a valid subroutine.  See L<overload>.
 
+=item Method %s not permitted
+
+See Server error.
+
 =item Might be a runaway multi-line %s string starting on line %d
 
 (S) An advisory indicating that the previous error may have been caused
@@ -2420,6 +2432,10 @@ and list operators.  (The old open was a little of both.)  You must
 put parentheses around the filehandle, or use the new "or" operator
 instead of "||".
 
+=item Premature end of script headers
+
+See Server error.
+
 =item print on closed filehandle %s
 
 (W) The filehandle you're printing on got itself closed sometime before now.
@@ -2613,7 +2629,12 @@ See L<perlre>.
 
 =item Server error
 
-Also known as "500 Server error".
+This is the error message generally seen in a browser window when trying
+to run a CGI program (including SSI) over the web. The actual error
+text varies widely from server to server. The most frequently-seen
+variants are "500 Server error", "Method (something) not permitted",
+"Document contains no data", "Premature end of script headers", and
+"Did not produce a valid header".
 
 B<This is a CGI error, not a Perl error>.
 
diff --git a/pp.c b/pp.c
index 6b71e8c..07bb33d 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1778,9 +1778,9 @@ S_seed(pTHX)
 #  endif
 #endif
     u += SEED_C3 * (U32)getpid();
-    u += SEED_C4 * (U32)(UV)PTR_CAST PL_stack_sp;
+    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
 #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
-    u += SEED_C5 * (U32)(UV)PTR_CAST &when;
+    u += SEED_C5 * (U32)PTR2UV(&when);
 #endif
     return u;
 }
index 7a65ec0..c9afbb6 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -223,12 +223,12 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
        *rsp = (void*)p;
     }
 
-    *p++ = (UV)PTR_CAST (RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
     RX_MATCH_COPIED_off(rx);
 
     *p++ = rx->nparens;
 
-    *p++ = (UV)PTR_CAST rx->subbeg;
+    *p++ = PTR2UV(rx->subbeg);
     *p++ = (UV)rx->sublen;
     for (i = 0; i <= rx->nparens; ++i) {
        *p++ = (UV)rx->startp[i];
@@ -249,7 +249,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 
     rx->nparens = *p++;
 
-    rx->subbeg = (char*)PTR_CAST (*p++);
+    rx->subbeg = INT2PTR(char*,*p++);
     rx->sublen = (I32)(*p++);
     for (i = 0; i <= rx->nparens; ++i) {
        rx->startp[i] = (I32)(*p++);
@@ -263,7 +263,7 @@ Perl_rxres_free(pTHX_ void **rsp)
     UV *p = (UV*)*rsp;
 
     if (p) {
-       Safefree((char*)PTR_CAST (*p));
+       Safefree(INT2PTR(char*,*p));
        Safefree(p);
        *rsp = Null(void*);
     }
@@ -2199,7 +2199,7 @@ PP(pp_goto)
                    CV *gotocv;
                    
                    if (PERLDB_SUB_NN) {
-                       SvIVX(sv) = (IV)PTR_CAST cv; /* Already upgraded, saved */
+                       SvIVX(sv) = PTR2IV(cv); /* Already upgraded, saved */
                    } else {
                        save_item(sv);
                        gv_efullname3(sv, CvGV(cv), Nullch);
index dbea9bd..e75ec30 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2125,7 +2125,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
        SvUPGRADE(dbsv, SVt_PVIV);
        SvIOK_on(dbsv);
        SAVEIV(SvIVX(dbsv));
-       SvIVX(dbsv) = (IV)PTR_CAST cv;  /* Do it the quickest way  */
+       SvIVX(dbsv) = PTR2IV(cv);       /* Do it the quickest way  */
     }
 
     if (CvXSUB(cv))
index 5271a86..2a0ec38 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
 
@@ -1898,7 +1903,7 @@ PP(pp_ioctl)
     }
     else {
        retval = SvIV(argsv);
-       s = (char*)PTR_CAST retval;             /* ouch */
+       s = INT2PTR(char*,retval);              /* ouch */
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
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 b21c9ed..4ba864c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -612,8 +612,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        pv      = (char*)SvRV(sv);
        cur     = 0;
        len     = 0;
-       iv      = (IV)PTR_CAST pv;
-       nv      = (NV)(PTRV)pv;
+       iv      = PTR2IV(pv);
+       nv      = PTR2NV(pv);
        del_XRV(SvANY(sv));
        magic   = 0;
        stash   = 0;
@@ -1077,7 +1077,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
          SV* tmpstr;
          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
              return SvIV(tmpstr);
-         return (IV)PTR_CAST SvRV(sv);
+         return PTR2IV(SvRV(sv));
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            dTHR;
@@ -1113,7 +1113,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 #ifdef IV_IS_QUAD
            DEBUG_c(PerlIO_printf(Perl_debug_log, 
                                  "0x%" PERL_PRIx64 " 2iv(%" PERL_PRIu64 " => %" PERL_PRId64 ") (as unsigned)\n",
-                                 (UV)PTR_CAST sv,
+                                 PTR2UV(sv),
                                  (UV)SvUVX(sv), (IV)SvUVX(sv)));
 #else
            DEBUG_c(PerlIO_printf(Perl_debug_log, 
@@ -1222,7 +1222,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
          SV* tmpstr;
          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
              return SvUV(tmpstr);
-         return (UV)PTR_CAST SvRV(sv);
+         return PTR2UV(SvRV(sv));
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            dTHR;
@@ -1393,7 +1393,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
          SV* tmpstr;
          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
              return SvNV(tmpstr);
-         return (NV)(PTRV)SvRV(sv);
+         return PTR2NV(SvRV(sv));
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            dTHR;
@@ -1777,7 +1777,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
                else
                    sv_setpv(tsv, s);
 #ifdef IV_IS_QUAD
-               Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", (UV)PTR_CAST sv);
+               Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", PTR2UV(sv));
 #else
                Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv);
 #endif
@@ -3691,7 +3691,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
            IV i;
            if (SvAMAGIC(sv) && AMG_CALLun(sv,inc))
                return;
-           i = (IV)PTR_CAST SvRV(sv);
+           i = PTR2IV(SvRV(sv));
            sv_unref(sv);
            sv_setiv(sv, i);
        }
@@ -3791,7 +3791,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
            IV i;
            if (SvAMAGIC(sv) && AMG_CALLun(sv,dec))
                return;
-           i = (IV)PTR_CAST SvRV(sv);
+           i = PTR2IV(SvRV(sv));
            sv_unref(sv);
            sv_setiv(sv, i);
        }
@@ -4395,7 +4395,7 @@ Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
        SvSETMAGIC(rv);
     }
     else
-       sv_setiv(newSVrv(rv,classname), (IV)PTR_CAST pv);
+       sv_setiv(newSVrv(rv,classname), PTR2IV(pv));
     return rv;
 }
 
@@ -4898,9 +4898,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        case 'p':
            if (args)
-               uv = (UV)PTR_CAST va_arg(*args, void*);
+               uv = PTR2UV(va_arg(*args, void*));
            else
-               uv = (svix < svmax) ? (UV)PTR_CAST svargs[svix++] : 0;
+               uv = (svix < svmax) ? PTR2UV(svargs[svix++]) : 0;
            base = 16;
            goto integer;
 
@@ -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 */
 #if defined(PERL_Y2KWARN)
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
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";