This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#6945,6947,6949..6954,6956,6958,6959,6961,
authorGurusamy Sarathy <gsar@cpan.org>
Sun, 17 Dec 2000 20:30:11 +0000 (20:30 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Sun, 17 Dec 2000 20:30:11 +0000 (20:30 +0000)
6964..6972,6977..6981..6984,6987,6988,6991,6994,6997,
6999..7001,7003..7005,7007,7009,7011,7012 from mainline

    Don't attach -ld to the archname if pointless.

    Document UNTIE in a very minimalistic way.

    POSIX doesn't report long double values under -Duselongdouble
    when the long doubles are "real" (bigger than doubles).

    More author updates.

    Try to deduce NV_MAX.  Really should be Configure fodder.

    :: not allowed in pathnames, change to .
    Subject: [PATCH perl@6938] cygwin port

    Forget about NV_MAX (#6951).  Various floating point tweaks,
    ideas from Eric Fifer, Yitzchak, Alan, and Spider.

    Move the Solaris 7 scan to use64bitall, make the
    failure to find 64-bot sparc libc to mention the
    possibility of being in an intel, from Lupe and Alan.

    Regen perltoc.

    AUTHORS tweaks, from Peter Prymmer.

    More address tweaking.

    Small tweaks all over.

    File::Temp patches from Andreas König,

    Subject: [PATCH perl@6962] 2 more vms.c fix-ups and status

    Subject: CPAN.pm beta 1.57_57 for the core

    Part of the solution.
    Subject: Re: [ID 20000807.004] [PATCH] conditional breakpoints leak memory

    Subject: [PATCH@6961] Fix misleading example in perlretut.pod

    Subject: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant

    Add the overload warnings to perldiag.

    Drop unused argument.
    Subject: Re: [ID 20000831.034] overload::constant and number of arguments.

    Subject: Nit in Configure (bleadperl@6961)

    Update to PodParser 1.18, from Brad Appleton.

    Subject: [ID 20000901.017] [PATCH] Basic test failure in an untidy world

    Subject: [PATCH: 6948] add SCNfldbl to configure.com

    Document UNTIE. Also tweak implementation to suppress the 'inner references'
    warning when UNTIE exists and instead pass the cound of extra references to
    the UNTIE method.

    Rename the PRIElfbl, PRIX64, etc, to be PRIEUfldbl, PRIXU64,
    so that case-ignoring systems like DCL can tell them from
    PRIefldbl and PRIx64.  Apply Merijn's ccversion patches.

    Subject: Re: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant

    Feature ordering tweak.

    Regen perltoc.

    Subject: [PATCH] Fix vec() / utf8   (was Re: bitvec ops still broken with utf8 -- or not?)

    Subject: Re: [PATCH perl@6962] 2 more vms.c fix-ups and status

    Subject: http:// in L<>

    Detypo.

    change#6791 accidentally clobbered change#6710, put it back

    Only the first line, thank you very much.

    Subject: [PATCH: 6996] minimal removal of 8 bit chrs from perlebcdic.pod
    plus rework the http: spots as suggested by Tom Christiansen,
    plus regen perltoc.

    Undo part of change 6489 which looks like a bulk edit which
    changed _all_ gv_efullname3() calls to gv_efullname4() calls.
    The supressing of main:: on return from select() is undesirable.

    Apparently avoiding the swapping is too costly.

    Various Configure nits by Philip Newton,
    plus the ebcdic one by me.

    Make certain cc is set before trying to run it.

    If overloaded %{} etc. return the object do not loop.
    Thus  sub deref { $_[0] } functions if object is wanted type.

    Update perlhist.

    More %{} and other deref special casing - do not pass to 'nomethod'.

p4raw-link: @6962 on //depot/perl: c54b6e81416ce8f20db98839af85a182ed595bab
p4raw-link: @6961 on //depot/perl: 1cec8c4eda97bdbeee95b406719cad8abf472ea2on //depot/metaconfig: 1309db05954176b857e16ced62ffb81c5942f8b8
p4raw-link: @6956 on //depot/perl: 9fa7f3886c5cdbbabc74285dd8d45d8b699d606f
p4raw-link: @6954 on //depot/perl: c4eb81271d38690def0c149c253ee8dc4015bfca
p4raw-link: @6949 on //depot/perl: 53796371599bf0ffdbd56139e8027e8e40cf0f6c
p4raw-link: @6947 on //depot/perl: d7da42b7c830203bad572620c63d3f513a2b505c
p4raw-link: @6945 on //depot/perl: 8611b0a8a1d8604dccb2edc2f56f7e89f0a266a2on //depot/metaconfig: 39580f3ccc763debb2de69ea23d1a5bcff4f1f54
p4raw-link: @6938 on //depot/perl: a0bff7c3e143d0297510e1836fa73be69737deba
p4raw-link: @6791 on //depot/perl: da147683998a4de28027887441303c16367eda87
p4raw-link: @6710 on //depot/perl: e8d3aa3b2e7edcd352aa3e0d8a884844f9aa9d5e

p4raw-id: //depot/maint-5.6/perl@8152
p4raw-integrated: from //depot/perl@8151 'copy in' t/base/rs.t
(@3650..) pod/perlretut.pod (@6703..) t/lib/ftmp-security.t
(@6944..) hints/irix_6.sh (@6982..)
p4raw-integrated: from //depot/perl@7012 'copy in' gv.c (@6967..)
lib/overload.pm (@6971..)
p4raw-integrated: from //depot/perl@7011 'copy in' pod/perlhist.pod
(@5899..)
p4raw-integrated: from //depot/perl@7009 'copy in' pp.h (@5917..)
p4raw-integrated: from //depot/perl@7007 'copy in' hints/hpux.sh
(@6997..) hints/solaris_2.sh (@7000..)
p4raw-integrated: from //depot/perl@7005 'edit in' Configure (@6982..)
'ignore' config_h.SH (@6982..)
p4raw-integrated: from //depot/perl@7004 'copy in' pod/perlfaq4.pod
(@6522..)
p4raw-integrated: from //depot/perl@7003 'edit in' pp_sys.c (@6981..)
p4raw-integrated: from //depot/perl@7001 'copy in' pod/perlebcdic.pod
(@6917..) README.os2 pod/perlxs.pod (@6994..) 'edit in'
pod/perltoc.pod (@6989..) pod/perl56delta.pod (@6994..) 'merge
in' pod/perlguts.pod (@6917..)
p4raw-integrated: from //depot/perl@6999 'copy in' win32/win32.c
(@6791..)
p4raw-integrated: from //depot/perl@6991 'copy in' vms/vms.c (@6965..)
p4raw-integrated: from //depot/perl@6988 'copy in' perlapi.c
pod/perlapi.pod (@6553..) embed.pl proto.h (@6642..) t/op/vec.t
(@6790..) 'edit in' pod/perlfunc.pod (@6947..) pod/perldiag.pod
(@6971..) 'merge in' utf8.c (@6476..) doop.c (@6790..)
p4raw-integrated: from //depot/perl@6984 'copy in' myconfig.SH
(@6982..)
p4raw-integrated: from //depot/perl@6983 'edit in' t/pragma/overload.t
(@6970..)
p4raw-integrated: from //depot/perl@6982 'copy in' hints/dec_osf.sh
(@6474..) Porting/Glossary Porting/config.sh Porting/config_H
(@6685..) epoc/config.sh vos/config.def vos/config_h.SH_orig
win32/config.bc win32/config.gc win32/config.vc (@6816..)
vos/config.h (@6822..) hints/aix.sh (@6912..) configure.com
(@6980..)
p4raw-integrated: from //depot/perl@6981 'copy in' pod/perltie.pod
(@6947..)
p4raw-integrated: from //depot/perl@6978 'copy in' t/pod/find.t
(@6712..) lib/Pod/Checker.pm (@6935..)
p4raw-integrated: from //depot/perl@6972 'merge in' toke.c (@6532..)
p4raw-integrated: from //depot/perl@6967 'merge in' mg.c (@6879..)
p4raw-integrated: from //depot/perl@6966 'copy in'
lib/CPAN/FirstTime.pm (@6783..) lib/CPAN.pm (@6935..)
p4raw-integrated: from //depot/perl@6964 'copy in' lib/File/Temp.pm
(@6928..)
p4raw-integrated: from //depot/perl@6961 'copy in' AUTHORS (@6959..)
p4raw-integrated: from //depot/perl@6958 'merge in' MAINTAIN (@6877..)
p4raw-integrated: from //depot/perl@6953 'merge in' sv.c (@6936..)
p4raw-integrated: from //depot/perl@6951 'merge in' perl.h (@6937..)
p4raw-integrated: from //depot/perl@6949 'copy in' ext/POSIX/POSIX.xs
(@6713..)

58 files changed:
AUTHORS
Configure
MAINTAIN
Porting/Glossary
Porting/config.sh
Porting/config_H
README.os2
configure.com
doop.c
embed.pl
epoc/config.sh
ext/POSIX/POSIX.xs
gv.c
hints/aix.sh
hints/dec_osf.sh
hints/hpux.sh
hints/irix_6.sh
hints/solaris_2.sh
lib/CPAN.pm
lib/CPAN/FirstTime.pm
lib/File/Temp.pm
lib/Pod/Checker.pm
lib/overload.pm
mg.c
myconfig.SH
perl.h
perlapi.c
pod/perlapi.pod
pod/perldelta.pod
pod/perldiag.pod
pod/perlebcdic.pod
pod/perlfaq4.pod
pod/perlfunc.pod
pod/perlguts.pod
pod/perlhist.pod
pod/perlretut.pod
pod/perltie.pod
pod/perltoc.pod
pod/perlxs.pod
pp.h
pp_sys.c
proto.h
sv.c
t/base/rs.t
t/lib/ftmp-security.t
t/op/vec.t
t/pod/find.t
t/pragma/overload.t
toke.c
utf8.c
vms/vms.c
vos/config.def
vos/config.h
vos/config_h.SH_orig
win32/config.bc
win32/config.gc
win32/config.vc
win32/win32.c

diff --git a/AUTHORS b/AUTHORS
index c3aece9..ba0a2de 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -11,9 +11,10 @@ cbail                Charles Bailey          bailey@newman.upenn.edu
 dgris          Daniel Grisinger        dgris@dimensional.com
 dmulholl       Daniel Yacob            dmulholl@cs.indiana.edu
 dogcow         Tom Spindler            dogcow@merit.edu
-domo           Dominic Dunlop          domo@slipper.ip.lu
-doug           Doug MacEachern         dougm@pobox.com
+domo           Dominic Dunlop          domo@computer.org
+doug           Doug MacEachern         dougm@covalent.net
 doughera       Andy Dougherty          doughera@lafcol.lafayette.edu
+efifer         Eric Fifer              EFifer@sanwaint.com
 francois       Francois Desarmenien    desar@club-internet.fr
 gbarr          Graham Barr             gbarr@ti.com
 gerben         Gerben Wierda           Gerben_Wierda@RnA.nl
@@ -30,7 +31,7 @@ jfs           John Stoffel            jfs@fluent.com
 jhi            Jarkko Hietaniemi       jhi@iki.fi
 jon            Jon Orwant              orwant@oreilly.com
 jvromans       Johan Vromans           jvromans@squirrel.nl
-k              Andreas König           andreas.koenig@franz.ww.tu-berlin.de
+k              Andreas König           a.koenig@mind.de
 kjahds         Kenneth Albanowski      kjahds@kjahds.com
 krishna                Krishna Sethuraman      krishna@sgi.com
 kstar          Kurt D. Starsinic       kstar@chapin.edu
@@ -45,6 +46,7 @@ mikestok      Mike Stok               mike@stok.co.uk
 millert                Todd Miller             millert@openbsd.org
 mkvale         Mark Kvale              kvale@phy.ucsf.edu
 mjd            Mark-Jason Dominus      mjd@plover.com
+mjtg           Mike Guy                mjtg@cam.ac.uk
 laszlo.molnar  Laszlo Molnar           Laszlo.Molnar@eth.ericsson.se
 mpeix          Mark Bixby              markb@cccd.edu
 muir           David Muir Sharnoff     muir@idiom.com
@@ -57,7 +59,7 @@ pomeranz      Hal Pomeranz            pomeranz@netcom.com
 pudge          Chris Nandor            pudge@pobox.com
 pueschel       Norbert Pueschel        pueschel@imsdd.meb.uni-bonn.de
 pvhp           Peter Prymmer           pvhp@forte.com
-raphael                Raphael Manfredi        Raphael_Manfredi@pobox.com
+raphael                Raphael Manfredi        Raphael.Manfredi@pobox.com
 rdieter                Rex Dieter              rdieter@math.unl.edu
 richard                Richard Foley           Richard.Foley@m.dasa.de
 rra            Russ Allbery            rra@stanford.edu
@@ -72,6 +74,7 @@ seibert               Greg Seibert            seibert@Lynx.COM
 simon          Simon Cozens            simon@brecon.co.uk
 spider         Spider Boardman         spider@Orb.Nashua.NH.US
 smccam         Stephen McCamant        smccam@uclink4.berkeley.edu
+sthoenna       Yitzchak Scott-Thoennes sthoenna@efn.org
 sugalskd       Dan Sugalski            dan@sidhe.org
 sundstrom      David Sundstrom         sunds@asictest.sc.ti.com
 tchrist                Tom Christiansen        tchrist@perl.com
@@ -99,7 +102,7 @@ dgux         roderick
 doc            tchrist
 dos            laszlo.molnar
 dynix/ptx      mbligh
-ebcdic         vms,vmesa,posix-bc
+ebcdic         os390,vmesa,posix-bc
 filespec       kjahds
 freebsd                roberto
 hpux           okamoto,jhi
@@ -110,11 +113,11 @@ linux             kjahds,kstar
 locale         jhi,domo
 machten                domo
 mm             makemaker
-mvs            pvhp
 netbsd         jhi
 next           gerben,hansmu
 openbsd                millert
 os2            ilya
+os390          pvhp
 plan9          lutherl
 posix-bc       thomas.dorner
 powerux                tom.horsley
index 4bf7a4e..9161efd 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 Thu Aug 31 07:18:29 EET DST 2000 [metaconfig 3.0 PL70]
+# Generated on Sat Sep  2 18:40:07 EET DST 2000 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >/tmp/c1$$ <<EOF
@@ -160,6 +160,8 @@ esac
 test -d UU || mkdir UU
 cd UU && rm -f ./*
 
+ccname=''
+ccversion=''
 ccsymbols=''
 cppccsymbols=''
 cppsymbols=''
@@ -598,7 +600,6 @@ fflushNULL=''
 fflushall=''
 fpossize=''
 fpostype=''
-ccname=''
 gccosandvers=''
 gccversion=''
 gidformat=''
@@ -729,16 +730,16 @@ libsfiles=''
 libsfound=''
 libspath=''
 lns=''
-d_PRIEldbl=''
-d_PRIFldbl=''
-d_PRIGldbl=''
+d_PRIEUldbl=''
+d_PRIFUldbl=''
+d_PRIGUldbl=''
 d_PRIeldbl=''
 d_PRIfldbl=''
 d_PRIgldbl=''
 d_SCNfldbl=''
-sPRIEldbl=''
-sPRIFldbl=''
-sPRIGldbl=''
+sPRIEUldbl=''
+sPRIFUldbl=''
+sPRIGUldbl=''
 sPRIeldbl=''
 sPRIfldbl=''
 sPRIgldbl=''
@@ -827,13 +828,13 @@ u8type=''
 uvsize=''
 uvtype=''
 ivdformat=''
-nvEformat=''
-nvFformat=''
-nvGformat=''
+nvEUformat=''
+nvFUformat=''
+nvGUformat=''
 nveformat=''
 nvfformat=''
 nvgformat=''
-uvXformat=''
+uvXUformat=''
 uvoformat=''
 uvuformat=''
 uvxformat=''
@@ -845,13 +846,13 @@ privlib=''
 privlibexp=''
 prototype=''
 ptrsize=''
-d_PRIX64=''
+d_PRIXU64=''
 d_PRId64=''
 d_PRIi64=''
 d_PRIo64=''
 d_PRIu64=''
 d_PRIx64=''
-sPRIX64=''
+sPRIXU64=''
 sPRId64=''
 sPRIi64=''
 sPRIo64=''
@@ -969,6 +970,8 @@ if test -f /etc/unixtovms.exe; then
 fi
 
 i_whoami=''
+ccname=''
+ccversion=''
 : set useposix=false in your hint file to disable the POSIX extension.
 useposix=true
 : set useopcode=false in your hint file to disable the Opcode extension.
@@ -1782,7 +1785,7 @@ $define|true|[yY]*) ;;
     This is an UNSTABLE DEVELOPMENT release.
     The version of this $package distribution is $xversion, that is, odd,
     (as opposed to even) and that signifies a development release.
-    If you want a maintenance release, you want an even-numbered version.)
+    If you want a maintenance release, you want an even-numbered version.
 
     Do ***NOT*** install this into production use.
     Data corruption and crashes are possible.
@@ -3105,12 +3108,15 @@ EOI
        ;;
 esac
 : Detect OS2.  The p_ variable is set above in the Head.U unit.
+: Note that this also -- wrongly -- detects e.g. dos-djgpp, which also uses
+: semicolon as a patch separator
 case "$p_" in
 :) ;;
 *)
        $cat <<'EOI'
 I have the feeling something is not exactly right, however...don't tell me...
 lemme think...does HAL ring a bell?...no, of course, you're only running OS/2!
+(Or you may be running DOS with DJGPP.)
 EOI
        echo exit 0 >os2
        ;;
@@ -4047,8 +4053,8 @@ for thisincl in $inclwanted; do
        if $test -d $thisincl; then
                if $test x$thisincl != x$usrinc; then
                        case "$dflt" in
-                       *$thisincl*);;
-                       *) dflt="$dflt -I$thisincl";;
+                        *" -I$thisincl "*);;
+                        *) dflt="$dflt -I$thisincl ";;
                        esac
                fi
        fi
@@ -4084,6 +4090,7 @@ esac
 case "$dflt" in
 ''|' ') dflt=none;;
 esac
+
 $cat <<EOH
 
 Your C compiler may want other flags.  For this question you should include
@@ -5276,6 +5283,82 @@ EOM
        ;;
 esac
 
+: check for length of double
+echo " "
+case "$doublesize" in
+'')
+       echo "Checking to see how big your double precision numbers are..." >&4
+       $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+    printf("%d\n", (int)sizeof(double));
+    exit(0);
+}
+EOCP
+       set try
+       if eval $compile_ok; then
+               doublesize=`./try`
+               echo "Your double is $doublesize bytes long."
+       else
+               dflt='8'
+               echo "(I can't seem to compile the test program.  Guessing...)"
+               rp="What is the size of a double precision number (in bytes)?"
+               . ./myread
+               doublesize="$ans"
+       fi
+       ;;
+esac
+$rm -f try.c try
+
+: check for long doubles
+echo " "
+echo "Checking to see if you have long double..." >&4
+echo 'int main() { long double x = 7.0; }' > try.c
+set try
+if eval $compile; then
+       val="$define"
+       echo "You have long double."
+else
+       val="$undef"
+       echo "You do not have long double."
+fi
+$rm try.*
+set d_longdbl
+eval $setvar
+
+: check for length of long double
+case "${d_longdbl}${longdblsize}" in
+$define)
+       echo " "
+       echo "Checking to see how big your long doubles are..." >&4
+       $cat >try.c <<'EOCP'
+#include <stdio.h>
+int main()
+{
+       printf("%d\n", sizeof(long double));
+}
+EOCP
+       set try
+       set try
+       if eval $compile; then
+               longdblsize=`./try$exe_ext`
+               echo "Your long doubles are $longdblsize bytes long."
+       else
+               dflt='8'
+               echo " "
+               echo "(I can't seem to compile the test program.  Guessing...)" >&4
+               rp="What is the size of a long double (in bytes)?"
+               . ./myread
+               longdblsize="$ans"
+       fi
+       if $test "X$doublesize" = "X$longdblsize"; then
+               echo "(That isn't any different from an ordinary double.)"
+       fi      
+       ;;
+esac
+$rm -f try.* try
+
 : determine the architecture name
 echo " "
 if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
@@ -5334,13 +5417,14 @@ case "$use64bitint$use64bitall" in
 *"$define"*)
        case "$archname64" in
        '')
+               echo "This architecture is naturally 64-bit, not changing architecture name." >&4
                ;;
        *)
                case "$use64bitint" in
                "$define") echo "64 bit integers selected." >&4 ;;
                esac
                case "$use64bitall" in
-               "$define") echo "64 bit memory model selected." >&4 ;;
+               "$define") echo "Maximal 64 bitness selected." >&4 ;;
                esac
                case "$archname" in
                *-$archname64*) echo "...and architecture name already has $archname64." >&4
@@ -5355,13 +5439,20 @@ esac
 case "$uselongdouble" in
 $define)
        echo "Long doubles selected." >&4
-       case "$archname" in
-        *-ld*) echo "...and architecture name already has -ld." >&4
-                ;;
-        *)      archname="$archname-ld"
-                echo "...setting architecture name to $archname." >&4
-                ;;
-        esac
+       case "$longdblsize" in
+       $doublesize)
+               "...but long doubles are equal to doubles, not changing architecture name." >&4
+               ;;
+       *)
+               case "$archname" in
+               *-ld*) echo "...and architecture name already has -ld." >&4
+                       ;;
+               *)      archname="$archname-ld"
+                       echo "...setting architecture name to $archname." >&4
+                       ;;
+               esac
+               ;;
+       esac
        ;;
 esac
 
@@ -7536,82 +7627,6 @@ fi
 set qgcvt d_qgcvt
 eval $inlibc
 
-: check for length of double
-echo " "
-case "$doublesize" in
-'')
-       echo "Checking to see how big your double precision numbers are..." >&4
-       $cat >try.c <<'EOCP'
-#include <stdio.h>
-int main()
-{
-    printf("%d\n", (int)sizeof(double));
-    exit(0);
-}
-EOCP
-       set try
-       if eval $compile_ok; then
-               doublesize=`./try`
-               echo "Your double is $doublesize bytes long."
-       else
-               dflt='8'
-               echo "(I can't seem to compile the test program.  Guessing...)"
-               rp="What is the size of a double precision number (in bytes)?"
-               . ./myread
-               doublesize="$ans"
-       fi
-       ;;
-esac
-$rm -f try.c try
-
-: check for long doubles
-echo " "
-echo "Checking to see if you have long double..." >&4
-echo 'int main() { long double x = 7.0; }' > try.c
-set try
-if eval $compile; then
-       val="$define"
-       echo "You have long double."
-else
-       val="$undef"
-       echo "You do not have long double."
-fi
-$rm try.*
-set d_longdbl
-eval $setvar
-
-: check for length of long double
-case "${d_longdbl}${longdblsize}" in
-$define)
-       echo " "
-       echo "Checking to see how big your long doubles are..." >&4
-       $cat >try.c <<'EOCP'
-#include <stdio.h>
-int main()
-{
-       printf("%d\n", sizeof(long double));
-}
-EOCP
-       set try
-       set try
-       if eval $compile; then
-               longdblsize=`./try$exe_ext`
-               echo "Your long doubles are $longdblsize bytes long."
-       else
-               dflt='8'
-               echo " "
-               echo "(I can't seem to compile the test program.  Guessing...)" >&4
-               rp="What is the size of a long double (in bytes)?"
-               . ./myread
-               longdblsize="$ans"
-       fi
-       if $test "X$doublesize" = "X$longdblsize"; then
-               echo "(That isn't any different from an ordinary double.)"
-       fi      
-       ;;
-esac
-$rm -f try.* try
-
 echo " "
 
 if $test X"$d_longdbl" = X"$define"; then
@@ -7633,7 +7648,7 @@ EOCP
                case "$yyy" in
                123.456)
                        sPRIfldbl='"f"'; sPRIgldbl='"g"'; sPRIeldbl='"e"';
-                       sPRIFldbl='"F"'; sPRIGldbl='"G"'; sPRIEldbl='"E"';
+                       sPRIFUldbl='"F"'; sPRIGUldbl='"G"'; sPRIEUldbl='"E"';
                        echo "We will use %f."
                        ;;
                esac
@@ -7655,7 +7670,7 @@ EOCP
                case "$yyy" in
                123.456)
                        sPRIfldbl='"llf"'; sPRIgldbl='"llg"'; sPRIeldbl='"lle"';
-                       sPRIFldbl='"llF"'; sPRIGldbl='"llG"'; sPRIEldbl='"llE"';
+                       sPRIFUldbl='"llF"'; sPRIGUldbl='"llG"'; sPRIEUldbl='"llE"';
                        echo "We will use %llf."
                        ;;
                esac
@@ -7677,7 +7692,7 @@ EOCP
                case "$yyy" in
                123.456)
                        sPRIfldbl='"Lf"'; sPRIgldbl='"Lg"'; sPRIeldbl='"Le"';
-                       sPRIFldbl='"LF"'; sPRIGldbl='"LG"'; sPRIEldbl='"LE"';
+                       sPRIFUldbl='"LF"'; sPRIGUldbl='"LG"'; sPRIEUldbl='"LE"';
                        echo "We will use %Lf."
                        ;;
                esac
@@ -7699,7 +7714,7 @@ EOCP
                case "$yyy" in
                123.456)
                        sPRIfldbl='"lf"'; sPRIgldbl='"lg"'; sPRIeldbl='"le"';
-                       sPRIFldbl='"lF"'; sPRIGldbl='"lG"'; sPRIEldbl='"lE"';
+                       sPRIFUldbl='"lF"'; sPRIGUldbl='"lG"'; sPRIEUldbl='"lE"';
                        echo "We will use %lf."
                        ;;
                esac
@@ -7718,11 +7733,11 @@ fi # d_longdbl
 
 case "$sPRIfldbl" in
 '')    d_PRIfldbl="$undef"; d_PRIgldbl="$undef"; d_PRIeldbl="$undef"; 
-       d_PRIFldbl="$undef"; d_PRIGldbl="$undef"; d_PRIEldbl="$undef"; 
+       d_PRIFUldbl="$undef"; d_PRIGUldbl="$undef"; d_PRIEUldbl="$undef"; 
        d_SCNfldbl="$undef";
        ;;
 *)     d_PRIfldbl="$define"; d_PRIgldbl="$define"; d_PRIeldbl="$define"; 
-       d_PRIFldbl="$define"; d_PRIGldbl="$define"; d_PRIEldbl="$define"; 
+       d_PRIFUldbl="$define"; d_PRIGUldbl="$define"; d_PRIEUldbl="$define"; 
        d_SCNfldbl="$define";
        ;;
 esac
@@ -7835,17 +7850,22 @@ int main()
        Gconvert((DOUBLETYPE)-100000.0, 8, 0, buf); 
        checkit("-100000", buf);
 
+       Gconvert((DOUBLETYPE)123.456, 8, 0, buf); 
+       checkit("123.456", buf);
+
        exit(0);
 }
 EOP
 case "$d_Gconvert" in
 gconvert*) xxx_list='gconvert gcvt sprintf' ;;
 gcvt*) xxx_list='gcvt gconvert sprintf' ;;
-*) xxx_list='sprintf gconvert gcvt' ;;
+sprintf*) xxx_list='sprintf gconvert gcvt' ;;
+*) xxx_list='gconvert gcvt sprintf' ;;
 esac
 
 case "$d_longdbl$uselongdouble$d_PRIgldbl" in
 "$define$define$define")
+    # for long doubles prefer first qgcvt, then sprintf
     xxx_list="`echo $xxx_list|sed s/sprintf//`" 
     xxx_list="sprintf $xxx_list"
     case "$d_qgcvt" in
@@ -10419,7 +10439,6 @@ EOP
 esac
 
 
-
 : check for off64_t
 echo " "
 echo "Checking to see if you have off64_t..." >&4
@@ -12705,14 +12724,14 @@ val=$undef
 set tebcdic
 if eval $compile_ok; then
        if ./tebcdic; then
-               echo "You have EBCDIC." >&4
+               echo "You seem to speak EBCDIC." >&4
                val="$define"
        else
-               echo "Nope, no EBCDIC, probably ASCII or some ISO Latin." >&4
+               echo "Nope, no EBCDIC, probably ASCII or some ISO Latin. Or UTF8." >&4
        fi
 else
        echo "I'm unable to compile the test program." >&4
-       echo "I'll assume ASCII or some ISO Latin." >&4
+       echo "I'll assume ASCII or some ISO Latin. Or UTF8." >&4
 fi
 $rm -f tebcdic.c tebcdic
 set ebcdic
@@ -13120,7 +13139,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"';
-                       sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"';
+                       sPRIo64='"o"'; sPRIx64='"x"'; sPRIXU64='"X"';
                        echo "We will use %d."
                        ;;
                esac
@@ -13142,7 +13161,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"';
-                       sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"';
+                       sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIXU64='"lX"';
                        echo "We will use %ld."
                        ;;
                esac
@@ -13165,7 +13184,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64;
-                       sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64;
+                       sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIXU64=PRIXU64;
                        echo "We will use the C9X style."
                        ;;
                esac
@@ -13177,7 +13196,7 @@ if $test X"$sPRId64" = X -a X"$quadtype" = X"long long"; then
 #include <sys/types.h>
 #include <stdio.h>
 int main() {
-  long long q = 12345678901LL; /* AIX cc requires the LL prefix. */
+  long long q = 12345678901LL; /* AIX cc requires the LL suffix. */
   printf("%lld\n", q);
 }
 EOCP
@@ -13187,7 +13206,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"';
-                       sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"';
+                       sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIXU64='"llX"';
                        echo "We will use the %lld style."
                        ;;
                esac
@@ -13209,7 +13228,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"';
-                       sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"';
+                       sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIXU64='"LX"';
                        echo "We will use %Ld."
                        ;;
                esac
@@ -13231,7 +13250,7 @@ EOCP
                case "$yyy" in
                12345678901)
                        sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"';
-                       sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"';
+                       sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIXU64='"qX"';
                        echo "We will use %qd."
                        ;;
                esac
 
 case "$sPRId64" in
 '')    d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef"; 
-       d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef"; 
+       d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIXU64="$undef"; 
        ;;
 *)     d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define"; 
-       d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define"; 
+       d_PRIo64="$define"; d_PRIx64="$define"; d_PRIXU64="$define"; 
        ;;
 esac
 
@@ -13264,21 +13283,21 @@ if $test X"$ivsize" = X8; then
        uvuformat="$sPRIu64"
        uvoformat="$sPRIo64"
        uvxformat="$sPRIx64"
-       uvXformat="$sPRIX64"
+       uvXUformat="$sPRIXU64"
 else
        if $test X"$ivsize" = X"$longsize"; then
                ivdformat='"ld"'
                uvuformat='"lu"'
                uvoformat='"lo"'
                uvxformat='"lx"'
-               uvXformat='"lX"'
+               uvXUformat='"lX"'
        else
                if $test X"$ivsize" = X"$intsize"; then
                        ivdformat='"d"'
                        uvuformat='"u"'
                        uvoformat='"o"'
                        uvxformat='"x"'
-                       uvXformat='"X"'
+                       uvXUformat='"X"'
                else
                        : far out
                        if $test X"$ivsize" = X"$shortsize"; then
@@ -13286,7 +13305,7 @@ else
                                uvuformat='"hu"'
                                uvoformat='"ho"'
                                uvxformat='"hx"'
-                               uvXformat='"hX"'
+                               uvXUformat='"hX"'
                        fi
                fi
        fi
@@ -13296,16 +13315,16 @@ if $test X"$uselongdouble" = X"$define" -a X"$d_longdbl" = X"$define" -a X"$d_PR
        nveformat="$sPRIeldbl"
        nvfformat="$sPRIfldbl"
        nvgformat="$sPRIgldbl"
-       nvEformat="$sPRIEldbl"
-       nvFformat="$sPRIFldbl"
-       nvGformat="$sPRIGldbl"
+       nvEUformat="$sPRIEUldbl"
+       nvFUformat="$sPRIFUldbl"
+       nvGUformat="$sPRIGUldbl"
 else
        nveformat='"e"'
        nvfformat='"f"'
        nvgformat='"g"'
-       nvEformat='"E"'
-       nvFformat='"F"'
-       nvGformat='"G"'
+       nvEUformat='"E"'
+       nvFUformat='"F"'
+       nvGUformat='"G"'
 fi
 
 case "$ivdformat" in
@@ -13586,12 +13605,15 @@ case "$pager" in
        dflt=''
        case "$pg" in
        /*) dflt=$pg;;
+       [a-zA-Z]:/*) dflt=$pg;;
        esac
        case "$more" in
        /*) dflt=$more;;
+       [a-zA-Z]:/*) dflt=$more;;
        esac
        case "$less" in
        /*) dflt=$less;;
+       [a-zA-Z]:/*) dflt=$less;;
        esac
        case "$dflt" in
        '') dflt=/usr/ucb/more;;
@@ -15414,6 +15436,7 @@ ccflags='$ccflags'
 ccflags_uselargefiles='$ccflags_uselargefiles'
 ccname='$ccname'
 ccsymbols='$ccsymbols'
+ccversion='$ccversion'
 cf_by='$cf_by'
 cf_email='$cf_email'
 cf_time='$cf_time'
@@ -15440,10 +15463,10 @@ crosscompile='$crosscompile'
 cryptlib='$cryptlib'
 csh='$csh'
 d_Gconvert='$d_Gconvert'
-d_PRIEldbl='$d_PRIEldbl'
-d_PRIFldbl='$d_PRIFldbl'
-d_PRIGldbl='$d_PRIGldbl'
-d_PRIX64='$d_PRIX64'
+d_PRIEUldbl='$d_PRIEUldbl'
+d_PRIFUldbl='$d_PRIFUldbl'
+d_PRIGUldbl='$d_PRIGUldbl'
+d_PRIXU64='$d_PRIXU64'
 d_PRId64='$d_PRId64'
 d_PRIeldbl='$d_PRIeldbl'
 d_PRIfldbl='$d_PRIfldbl'
@@ -15968,9 +15991,9 @@ nm_opt='$nm_opt'
 nm_so_opt='$nm_so_opt'
 nonxs_ext='$nonxs_ext'
 nroff='$nroff'
-nvEformat='$nvEformat'
-nvFformat='$nvFformat'
-nvGformat='$nvGformat'
+nvEUformat='$nvEUformat'
+nvFUformat='$nvFUformat'
+nvGUformat='$nvGUformat'
 nveformat='$nveformat'
 nvfformat='$nvfformat'
 nvgformat='$nvgformat'
@@ -16017,10 +16040,10 @@ revision='$revision'
 rm='$rm'
 rmail='$rmail'
 runnm='$runnm'
-sPRIEldbl='$sPRIEldbl'
-sPRIFldbl='$sPRIFldbl'
-sPRIGldbl='$sPRIGldbl'
-sPRIX64='$sPRIX64'
+sPRIEUldbl='$sPRIEUldbl'
+sPRIFUldbl='$sPRIFUldbl'
+sPRIGUldbl='$sPRIGUldbl'
+sPRIXU64='$sPRIXU64'
 sPRId64='$sPRId64'
 sPRIeldbl='$sPRIeldbl'
 sPRIfldbl='$sPRIfldbl'
@@ -16137,7 +16160,7 @@ usevendorprefix='$usevendorprefix'
 usevfork='$usevfork'
 usrinc='$usrinc'
 uuname='$uuname'
-uvXformat='$uvXformat'
+uvXUformat='$uvXUformat'
 uvoformat='$uvoformat'
 uvsize='$uvsize'
 uvtype='$uvtype'
@@ -16247,7 +16270,7 @@ EOM
        . UU/myread
        case "$ans" in
        y*)
-               $make depend && echo "Now you must run a $make."
+               $make depend && echo "Now you must run '$make'."
                ;;
        *)
                echo "You must run '$make depend' then '$make'."
index 4f0c5b9..e5dbccf 100644 (file)
--- a/MAINTAIN
+++ b/MAINTAIN
@@ -58,7 +58,7 @@ README.lexwarn                        lexwarn
 README.machten                 machten
 README.mpeix                   mpeix
 README.os2                     os2
-README.os390                   mvs
+README.os390                   os390
 README.plan9                   plan9
 README.posix-bc                        posix-bc
 README.qnx                     qnx
@@ -342,7 +342,7 @@ hints/next*                 step
 hints/openbsd.sh               openbsd
 hints/opus.sh  
 hints/os2.sh                   os2
-hints/os390.sh                 mvs
+hints/os390.sh                 os390
 hints/posix-bc.sh              posix-bc
 hints/powerux.sh               powerux
 hints/qnx.sh                   qnx
index c148f11..be59c16 100644 (file)
@@ -197,12 +197,24 @@ ccflags_uselargefiles (uselfs.U):
        This variable contains the compiler flags needed by large file builds
        and added to ccflags by hints files.
 
+ccname (Checkcc.U):
+       This can set either by hints files or by Configure.  If using
+       gcc, this is gcc, and if not, usually equal to cc, unimpressive, no?
+       Some platforms, however, make good use of this by storing the
+       flavor of the C compiler being used here.  For example if using
+       the Sun WorkShop suite, ccname will be 'workshop'.
+
 ccsymbols (Cppsym.U):
        The variable contains the symbols defined by the C compiler alone.
        The symbols defined by cpp or by cc when it calls cpp are not in
        this list, see cppsymbols and cppccsymbols.
        The list is a space-separated list of symbol=value tokens.
 
+ccversion (Checkcc.U):
+       This can set either by hints files or by Configure.  If using
+       a (non-gcc) vendor cc, this variable may contain a version for
+       the compiler.
+
 cf_by (cf_who.U):
        Login name of the person who ran the Configure script and answered the
        questions. This is used to tag both config.sh and config_h.SH.
@@ -1091,28 +1103,34 @@ d_PRId64 (quadfio.U):
        indiciates that stdio has a symbol to print 64-bit decimal numbers.
 
 d_PRIeldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
 
-d_PRIEldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+d_PRIEUldbl (longdblfio.U):
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
+       The 'U' in the name is to separate this from d_PRIeldbl so that even
+       case-blind systems can see the difference.
 
 d_PRIfldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
 
-d_PRIFldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+d_PRIFUldbl (longdblfio.U):
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
+       The 'U' in the name is to separate this from d_PRIfldbl so that even
+       case-blind systems can see the difference.
 
 d_PRIgldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
 
-d_PRIGldbl (longdblfio.U):
-       This variable conditionally defines the PERL_PRIfldlbl symbol, which
+d_PRIGUldbl (longdblfio.U):
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
        indiciates that stdio has a symbol to print long doubles.
+       The 'U' in the name is to separate this from d_PRIgldbl so that even
+       case-blind systems can see the difference.
 
 d_PRIi64 (quadfio.U):
        This variable conditionally defines the PERL_PRIi64 symbol, which
@@ -1131,9 +1149,11 @@ d_PRIx64 (quadfio.U):
        This variable conditionally defines the PERL_PRIx64 symbol, which
        indiciates that stdio has a symbol to print 64-bit hexadecimal numbers.
 
-d_PRIX64 (quadfio.U):
-       This variable conditionally defines the PERL_PRIX64 symbol, which
+d_PRIXU64 (quadfio.U):
+       This variable conditionally defines the PERL_PRIXU64 symbol, which
        indiciates that stdio has a symbol to print 64-bit hExADECimAl numbers.
+       The 'U' in the name is to separate this from d_PRIx64 so that even
+       case-blind systems can see the difference.
 
 d_pthread_yield (d_pthread_y.U):
        This variable conditionally defines the HAS_PTHREAD_YIELD
@@ -1225,6 +1245,10 @@ d_scm_rights (d_socket.U):
        which indicates that the SCM_RIGHTS is available.  #ifdef is
        not enough because it may be an enum, glibc has been known to do this.
 
+d_SCNfldbl (longdblfio.U):
+       This variable conditionally defines the PERL_PRIfldbl symbol, which
+       indiciates that stdio has a symbol to scan long doubles.
+
 d_seekdir (d_readdir.U):
        This variable conditionally defines HAS_SEEKDIR if seekdir() is
        available.
@@ -1419,6 +1443,10 @@ d_sockpair (d_socket.U):
        This variable conditionally defines the HAS_SOCKETPAIR symbol, which
        indicates that the BSD socketpair() is supported.
 
+d_socks5_init (d_socks5_init.U):
+       This variable conditionally defines the HAS_SOCKS5_INIT symbol, which
+       indicates to the C program that the socks5_init() routine is available.
+
 d_sqrtl (d_sqrtl.U):
        This variable conditionally defines the HAS_SQRTL symbol, which
        indicates to the C program that the sqrtl() routine is available.
@@ -2753,7 +2781,7 @@ nveformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl NV using %e-ish floating point format.
 
-nvEformat (perlxvf.U):
+nvEUformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl NV using %E-ish floating point format.
 
@@ -2761,7 +2789,7 @@ nvfformat (perlxvf.U):
        This variable confains the format string used for printing
        a Perl NV using %f-ish floating point format.
 
-nvFformat (perlxvf.U):
+nvFUformat (perlxvf.U):
        This variable confains the format string used for printing
        a Perl NV using %F-ish floating point format.
 
@@ -2769,7 +2797,7 @@ nvgformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl NV using %g-ish floating point format.
 
-nvGformat (perlxvf.U):
+nvGUformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl NV using %G-ish floating point format.
 
@@ -3250,25 +3278,31 @@ sPRIeldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'e') for output.
 
-sPRIEldbl (longdblfio.U):
+sPRIEUldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'E') for output.
+       The 'U' in the name is to separate this from sPRIeldbl so that even
+       case-blind systems can see the difference.
 
 sPRIfldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'f') for output.
 
-sPRIFldbl (longdblfio.U):
+sPRIFUldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'F') for output.
+       The 'U' in the name is to separate this from sPRIfldbl so that even
+       case-blind systems can see the difference.
 
 sPRIgldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'g') for output.
 
-sPRIGldbl (longdblfio.U):
+sPRIGUldbl (longdblfio.U):
        This variable, if defined, contains the string used by stdio to
        format long doubles (format 'G') for output.
+       The 'U' in the name is to separate this from sPRIgldbl so that even
+       case-blind systems can see the difference.
 
 sPRIi64 (quadfio.U):
        This variable, if defined, contains the string used by stdio to
@@ -3286,15 +3320,21 @@ sPRIx64 (quadfio.U):
        This variable, if defined, contains the string used by stdio to
        format 64-bit hexadecimal numbers (format 'x') for output.
 
-sPRIX64 (quadfio.U):
+sPRIXU64 (quadfio.U):
        This variable, if defined, contains the string used by stdio to
        format 64-bit hExADECimAl numbers (format 'X') for output.
+       The 'U' in the name is to separate this from sPRIx64 so that even
+       case-blind systems can see the difference.
 
 src (src.U):
        This variable holds the path to the package source. It is up to
        the Makefile to use this variable and set VPATH accordingly to
        find the sources remotely.
 
+sSCNfldbl (longdblfio.U):
+       This variable, if defined, contains the string used by stdio to
+       format long doubles (format 'f') for input.
+
 ssizetype (ssizetype.U):
        This variable defines ssizetype to be something like ssize_t, 
        long or int.  It is used by functions that return a count 
@@ -3611,7 +3651,7 @@ uvxformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl UV as an unsigned hexadecimal integer in lowercase abcdef.
 
-uvXformat (perlxvf.U):
+uvXUformat (perlxvf.U):
        This variable contains the format string used for printing
        a Perl UV as an unsigned hexadecimal integer in uppercase ABCDEF.
 
index 004fc8c..d82f0b3 100644 (file)
@@ -8,7 +8,7 @@
 
 # Package name      : perl5
 # Source directory  : /m/fs/work/work/permanent/perl/pp4/perl
-# Configuration time: Fri Aug 18 04:57:25 EET DST 2000
+# Configuration time: Fri Sep  1 21:11:01 EET DST 2000
 # Configured by     : jhi
 # Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
 
@@ -57,10 +57,12 @@ cccdlflags=' '
 ccdlflags='  -Wl,-rpath,/opt/perl/lib/5.7.0/alpha-dec_osf-thread/CORE'
 ccflags='-pthread -std -DLANGUAGE_C'
 ccflags_uselargefiles=''
+ccname='cc'
 ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1 unix=1'
+ccversion='V5.6-082'
 cf_by='jhi'
 cf_email='yourname@yourhost.yourplace.com'
-cf_time='Fri Aug 18 04:57:25 EET DST 2000'
+cf_time='Fri Sep  1 21:11:01 EET DST 2000'
 charsize='1'
 chgrp=''
 chmod=''
@@ -84,10 +86,10 @@ crosscompile='undef'
 cryptlib=''
 csh='csh'
 d_Gconvert='gcvt((x),(n),(b))'
-d_PRIEldbl='define'
-d_PRIFldbl='define'
-d_PRIGldbl='define'
-d_PRIX64='define'
+d_PRIEUldbl='define'
+d_PRIFUldbl='define'
+d_PRIGUldbl='define'
+d_PRIXU64='define'
 d_PRId64='define'
 d_PRIeldbl='define'
 d_PRIfldbl='define'
@@ -96,6 +98,7 @@ d_PRIi64='define'
 d_PRIo64='define'
 d_PRIu64='define'
 d_PRIx64='define'
+d_SCNfldbl='define'
 d_access='define'
 d_accessx='undef'
 d_alarm='define'
@@ -325,6 +328,7 @@ d_sigsetjmp='define'
 d_socket='define'
 d_socklen_t='undef'
 d_sockpair='define'
+d_socks5_init='undef'
 d_sqrtl='define'
 d_statblks='define'
 d_statfs_f_flags='define'
@@ -390,7 +394,7 @@ dlext='so'
 dlsrc='dl_dlopen.xs'
 doublesize='8'
 drand01='drand48()'
-dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re'
+dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Storable Sys/Hostname Sys/Syslog Thread attrs re'
 eagain='EAGAIN'
 ebcdic='undef'
 echo='echo'
@@ -399,7 +403,7 @@ emacs=''
 eunicefix=':'
 exe_ext=''
 expr='expr'
-extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re Errno'
+extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Storable Sys/Hostname Sys/Syslog Thread attrs re Errno'
 fflushNULL='define'
 fflushall='undef'
 find=''
@@ -539,7 +543,7 @@ intsize='4'
 ivdformat='"ld"'
 ivsize='8'
 ivtype='long'
-known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re'
+known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Storable Sys/Hostname Sys/Syslog Thread attrs re'
 ksh=''
 large=''
 ld='ld'
@@ -610,9 +614,9 @@ nm_opt='-p'
 nm_so_opt=''
 nonxs_ext='Errno'
 nroff='nroff'
-nvEformat='"E"'
-nvFformat='"F"'
-nvGformat='"G"'
+nvEUformat='"E"'
+nvFUformat='"F"'
+nvGUformat='"G"'
 nveformat='"e"'
 nvfformat='"f"'
 nvgformat='"g"'
@@ -659,10 +663,10 @@ revision='5'
 rm='rm'
 rmail=''
 runnm='true'
-sPRIEldbl='"E"'
-sPRIFldbl='"F"'
-sPRIGldbl='"G"'
-sPRIX64='"lX"'
+sPRIEUldbl='"E"'
+sPRIFUldbl='"F"'
+sPRIGUldbl='"G"'
+sPRIXU64='"lX"'
 sPRId64='"ld"'
 sPRIeldbl='"e"'
 sPRIfldbl='"f"'
@@ -671,6 +675,7 @@ sPRIi64='"li"'
 sPRIo64='"lo"'
 sPRIu64='"lu"'
 sPRIx64='"lx"'
+sSCNfldbl='"f"'
 sched_yield='sched_yield()'
 scriptdir='/opt/perl/bin'
 scriptdirexp='/opt/perl/bin'
@@ -778,7 +783,7 @@ usevendorprefix='undef'
 usevfork='false'
 usrinc='/usr/include'
 uuname=''
-uvXformat='"lX"'
+uvXUformat='"lX"'
 uvoformat='"lo"'
 uvsize='8'
 uvtype='unsigned long'
index 7053239..eb27ac0 100644 (file)
@@ -17,7 +17,7 @@
 /*
  * Package name      : perl5
  * Source directory  : /m/fs/work/work/permanent/perl/pp4/perl
- * Configuration time: Fri Aug 18 04:57:25 EET DST 2000
+ * Configuration time: Fri Sep  1 21:11:01 EET DST 2000
  * Configured by     : jhi
  * Target system     : osf1 alpha.hut.fi v4.0 878 alpha 
  */
 /*#define      HAS_MSG_PROXY   / **/
 #define        HAS_SCM_RIGHTS  /**/
 
+/* HAS_SOCKS5_INIT:
+ *     This symbol, if defined, indicates that the socks5_init routine is
+ *     available to initialize SOCKS 5.
+ */
+/*#define HAS_SOCKS5_INIT              / **/
+
 /* HAS_SQRTL:
  *     This symbol, if defined, indicates that the sqrtl routine is
  *     available to do long double square roots.
  */
 /*#define   I_INTTYPES                / **/
 
+/* I_LIBUTIL:
+ *     This symbol, if defined, indicates that <libutil.h> exists and
+ *     should be included.
+ */
+/*#define      I_LIBUTIL               / **/
+
 /* I_MACH_CTHREADS:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <mach/cthreads.h>.
  *     This symbol, if defined, contains the string used by stdio to
  *     format long doubles (format 'g') for output.
  */
+/* PERL_PRIeldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'e') for output.
+ */
+/* PERL_SCNfldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'f') for input.
+ */
 #define PERL_PRIfldbl  "f"     /**/
 #define PERL_PRIgldbl  "g"     /**/
+#define PERL_PRIeldbl  "e"     /**/
+#define PERL_SCNfldbl  "f"     /**/
 
 /* Off_t:
  *     This symbol holds the type used to declare offsets in the kernel.
 #define PERL_XS_APIVERSION "5.7.0"
 #define PERL_PM_APIVERSION "5.005"
 
-/* I_LIBUTIL:
- *     This symbol, if defined, indicates that <libutil.h> exists and
- *     should be included.
- */
-/*#define      I_LIBUTIL               / **/
-
 #endif
index 2383ee8..b46fa7a 100644 (file)
@@ -724,7 +724,7 @@ can be constructed using C<pod2latex>.
 =head1 BUILD
 
 Here we discuss how to build Perl under OS/2. There is an alternative
-(but maybe older) view on L<http://www.shadow.net/~troc/os2perl.html>.
+(but maybe older) view on http://www.shadow.net/~troc/os2perl.html
 
 =head2 Prerequisites
 
index 1be2ad7..ae6141e 100644 (file)
@@ -2704,9 +2704,9 @@ $!
 $ IF use64bitint .OR. use64bitint .EQS. "define"
 $ THEN
 $   d_PRId64 = "define"
-$   d_PRIEldbl_cap = "define"
-$   d_PRIFldbl_cap = "define"
-$   d_PRIGldbl_cap = "define"
+$   d_PRIEUldbl = "define"
+$   d_PRIFUldbl = "define"
+$   d_PRIGUldbl = "define"
 $   d_PRIeldbl = "define"
 $   d_PRIfldbl = "define"
 $   d_PRIgldbl = "define"
@@ -2714,10 +2714,10 @@ $   d_PRIu64 = "define"
 $   d_PRIo64 = "define"
 $   d_PRIx64 = "define"
 $   sPRId64 = """Ld"""
-$   sPRIEldbl_cap = """LE"""
-$   sPRIFldbl_cap = """LF"""
-$   sPRIGldbl_cap = """LG"""
-$   sPRIX64_cap = """LX"""
+$   sPRIEUldbl = """LE"""
+$   sPRIFUldbl = """LF"""
+$   sPRIGUldbl = """LG"""
+$   sPRIXU64 = """LX"""
 $   sPRIeldbl = """Le"""
 $   sPRIfldbl = """Lf"""
 $   sPRIgldbl = """Lg"""
@@ -2734,10 +2734,10 @@ $   d_isnanl = "define"
 $   d_modfl = "define"
 $ ELSE
 $   d_PRId64 = "undef"
-$   d_PRIEldbl_cap = "define"
-$   d_PRIFldbl_cap = "define"
-$   d_PRIGldbl_cap = "define"
-$   d_PRIX64_cap = "undef"
+$   d_PRIEUldbl = "define"
+$   d_PRIFUldbl = "define"
+$   d_PRIGUldbl = "define"
+$   d_PRIXU64 = "undef"
 $   d_PRIeldbl = "define"
 $   d_PRIfldbl = "undef"
 $   d_PRIgldbl = "undef"
@@ -2745,10 +2745,10 @@ $   d_PRIu64 = "undef"
 $   d_PRIo64 = "undef"
 $   d_PRIx64 = "undef"
 $   sPRId64 = ""
-$   sPRIEldbl_cap = """E"""
-$   sPRIFldbl_cap = """F"""
-$   sPRIGldbl_cap = """G"""
-$   sPRIX64_cap = """lX"""
+$   sPRIEUldbl = """E"""
+$   sPRIFUldbl = """F"""
+$   sPRIGUldbl = """G"""
+$   sPRIXU64 = """lX"""
 $   sPRIeldbl = """e"""
 $   sPRIfldbl = """f"""
 $   sPRIgldbl = """g"""
@@ -2764,6 +2764,8 @@ $   d_frexpl = "undef"
 $   d_isnanl = "undef"
 $   d_modfl = "undef"
 $ ENDIF
+$ d_SCNfldbl = d_PRIfldbl
+$ sSCNfldbl = sPRIfldbl ! expect consistency
 $!
 $! Now some that we build up
 $!
@@ -4631,16 +4633,17 @@ $ WC "cppstdin='" + cppstdin + "'"
 $ WC "crosscompile='undef'"
 $ WC "d_Gconvert='my_gconvert(x,n,t,b)'"
 $ WC "d_PRId64='" + d_PRId64 + "'"
-$ WC "d_PRIEldbl='" + d_PRIEldbl_cap + "'"
-$ WC "d_PRIFldbl='" + d_PRIFldbl_cap + "'"
-$ WC "d_PRIGldbl='" + d_PRIGldbl_cap + "'"
-$ WC "d_PRIX64='" + d_PRIX64_cap + "'"
+$ WC "d_PRIEldbl='" + d_PRIEUldbl + "'"
+$ WC "d_PRIFldbl='" + d_PRIFUldbl + "'"
+$ WC "d_PRIGldbl='" + d_PRIGUldbl + "'"
+$ WC "d_PRIX64='" + d_PRIXU64 + "'"
 $ WC "d_PRIeldbl='" + d_PRIeldbl + "'"
 $ WC "d_PRIfldbl='" + d_PRIfldbl + "'"
 $ WC "d_PRIgldbl='" + d_PRIgldbl + "'"
 $ WC "d_PRIo64='" + d_PRIo64 + "'"
 $ WC "d_PRIu64='" + d_PRIu64 + "'"
 $ WC "d_PRIx64='" + d_PRIx64 + "'"
+$ WC "d_SCNfldbl='" + d_SCNfldbl + "'"
 $ WC "d_access='" + d_access + "'"
 $ WC "d_accessx='undef'"
 $ WC "d_alarm='define'"
@@ -5109,10 +5112,10 @@ $ WC "ranlib='" + "'"
 $ WC "rd_nodata=' '"
 $ WC "revision='" + revision + "'"
 $ WC "sPRId64='" + sPRId64 + "'"
-$ WC "sPRIEldbl='" + sPRIEldbl_cap + "'"
-$ WC "sPRIFldbl='" + sPRIFldbl_cap + "'"
-$ WC "sPRIGldbl='" + sPRIGldbl_cap + "'"
-$ WC "sPRIX64='" + sPRIX64_cap + "'"
+$ WC "sPRIEldbl='" + sPRIEUldbl + "'"
+$ WC "sPRIFldbl='" + sPRIFUldbl + "'"
+$ WC "sPRIGldbl='" + sPRIGUldbl + "'"
+$ WC "sPRIX64='" + sPRIXU64 + "'"
 $ WC "sPRIeldbl='" + sPRIeldbl + "'"
 $ WC "sPRIfldbl='" + sPRIfldbl + "'"
 $ WC "sPRIgldbl='" + sPRIgldbl + "'"
@@ -5120,6 +5123,7 @@ $! WC "sPRIi64='" + sPRIi64 + "'"
 $ WC "sPRIo64='" + sPRIo64 + "'"
 $ WC "sPRIu64='" + sPRIu64 + "'"
 $ WC "sPRIx64='" + sPRIx64 + "'"
+$ WC "sSCNfldbl='" + sSCNfldbl + "'"
 $ WC "sched_yield='" + sched_yield + "'"
 $ WC "seedfunc='" + seedfunc + "'"
 $ WC "selectminbits='32'"
diff --git a/doop.c b/doop.c
index 341e6f1..ed219fe 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -535,7 +535,8 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
        SvTAINTED_on(sv);
 }
 
-/* XXX SvUTF8 support missing! */
+/* currently converts input to bytes if needed and croaks if a character
+   > 255 is encountered                                                        */
 UV
 Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 {
@@ -547,6 +548,16 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
        return retnum;
     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ 
        Perl_croak(aTHX_ "Illegal number of bits in vec");
+
+    if (SvUTF8(sv)) {
+       if (Perl_utf8_to_bytes(aTHX_ (U8*) s, &srclen)) {
+           SvUTF8_off(sv);
+           SvCUR_set(sv, srclen);
+       }
+       else
+           Perl_croak(aTHX_ "Character > 255 in vec()");
+    }
+
     offset *= size;    /* turn into bit offset */
     len = (offset + size + 7) / 8;     /* required number of bytes */
     if (len > srclen) {
@@ -668,7 +679,8 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
     return retnum;
 }
 
-/* XXX SvUTF8 support missing! */
+/* currently converts input to bytes if needed and croaks if a character
+   > 255 is encountered                                                        */
 void
 Perl_do_vecset(pTHX_ SV *sv)
 {
@@ -684,6 +696,15 @@ Perl_do_vecset(pTHX_ SV *sv)
     if (!targ)
        return;
     s = (unsigned char*)SvPV_force(targ, targlen);
+    if (SvUTF8(targ)) {
+       if (Perl_utf8_to_bytes(aTHX_ (U8*) s, &targlen)) {
+       /*  SvUTF8_off(targ);   SvPOK_only below ensures this  */
+           SvCUR_set(targ, targlen);
+       }
+       else
+           Perl_croak(aTHX_ "Character > 255 in vec()");
+    }
+
     (void)SvPOK_only(targ);
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
index 9353435..b99a59f 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2071,7 +2071,7 @@ Ap        |U8*    |utf16_to_utf8  |U8* p|U8 *d|I32 bytelen|I32 *newlen
 Ap     |U8*    |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen
 Ap     |I32    |utf8_distance  |U8 *a|U8 *b
 Ap     |U8*    |utf8_hop       |U8 *s|I32 off
-ApM    |U8*    |utf8_to_bytes  |U8 *s|STRLEN len
+ApM    |U8*    |utf8_to_bytes  |U8 *s|STRLEN *len
 ApM    |U8*    |bytes_to_utf8  |U8 *s|STRLEN *len
 Ap     |UV     |utf8_to_uv     |U8 *s|I32* retlen
 Ap     |U8*    |uv_to_utf8     |U8 *d|UV uv
index 897a18f..4d2a911 100644 (file)
@@ -80,10 +80,10 @@ crosscompile='define'
 cryptlib=''
 csh='csh'
 d_Gconvert='epoc_gcvt((x),(n),(b))'
-d_PRIEldbl='undef'
-d_PRIFldbl='undef'
-d_PRIGldbl='undef'
-d_PRIX64='undef'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
 d_PRId64='undef'
 d_PRIeldbl='undef'
 d_PRIfldbl='define'
@@ -602,10 +602,10 @@ rd_nodata='-1'
 rm='rm'
 rmail=''
 runnm='false'
-sPRIEldbl=''
-sPRIFldbl=''
-sPRIGldbl=''
-sPRIX64=''
+sPRIEUldbl=''
+sPRIFUldbl=''
+sPRIGUldbl=''
+sPRIXU64=''
 sPRId64=''
 sPRIeldbl=''
 sPRIfldbl='"f"'
index 06869f6..a536671 100644 (file)
@@ -539,7 +539,7 @@ mini_mktime(struct tm *ptm)
 }
 
 #ifdef HAS_LONG_DOUBLE
-#  if LONG_DOUBLESIZE > DOUBLESIZE
+#  if LONG_DOUBLESIZE > NVSIZE
 #    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
 #  endif
 #endif
diff --git a/gv.c b/gv.c
index 8cf40c7..768824d 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -75,7 +75,7 @@ Perl_gv_fetchfile(pTHX_ const char *name)
        gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
        sv_setpv(GvSV(gv), name);
        if (PERLDB_LINE)
-           hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
+           hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, 'L');
     }
     if (tmpbuf != smallbuf)
        Safefree(tmpbuf);
@@ -159,18 +159,18 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
 
 Returns the glob with the given C<name> and a defined subroutine or
 C<NULL>.  The glob lives in the given C<stash>, or in the stashes
-accessible via @ISA and @UNIVERSAL. 
+accessible via @ISA and @UNIVERSAL.
 
 The argument C<level> should be either 0 or -1.  If C<level==0>, as a
 side-effect creates a glob with the given C<name> in the given C<stash>
 which in the case of success contains an alias for the subroutine, and sets
-up caching info for this glob.  Similarly for all the searched stashes. 
+up caching info for this glob.  Similarly for all the searched stashes.
 
 This function grants C<"SUPER"> token as a postfix of the stash name. The
 GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
 visible to Perl code.  So when calling C<call_sv>, you should not use
 the GV directly; instead, you should use the method's CV, which can be
-obtained from the GV with the C<GvCV> macro. 
+obtained from the GV with the C<GvCV> macro.
 
 =cut
 */
@@ -317,24 +317,24 @@ Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 Returns the glob which contains the subroutine to call to invoke the method
 on the C<stash>.  In fact in the presence of autoloading this may be the
 glob for "AUTOLOAD".  In this case the corresponding variable $AUTOLOAD is
-already setup. 
+already setup.
 
 The third parameter of C<gv_fetchmethod_autoload> determines whether
 AUTOLOAD lookup is performed if the given method is not present: non-zero
-means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. 
+means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD.
 Calling C<gv_fetchmethod> is equivalent to calling C<gv_fetchmethod_autoload>
-with a non-zero C<autoload> parameter. 
+with a non-zero C<autoload> parameter.
 
 These functions grant C<"SUPER"> token as a prefix of the method name. Note
 that if you want to keep the returned glob for a long time, you need to
 check for it being "AUTOLOAD", since at the later time the call may load a
 different subroutine due to $AUTOLOAD changing its value. Use the glob
-created via a side effect to do this. 
+created via a side effect to do this.
 
 These functions have the same side-effects and as C<gv_fetchmeth> with
 C<level==0>.  C<name> should be writable if contains C<':'> or C<'
 ''>. The warning against passing the GV returned by C<gv_fetchmeth> to
-C<call_sv> apply equally to these functions. 
+C<call_sv> apply equally to these functions.
 
 =cut
 */
@@ -346,7 +346,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
     register const char *nend;
     const char *nsplit = 0;
     GV* gv;
-    
+
     for (nend = name; *nend; nend++) {
        if (*nend == '\'')
            nsplit = nend;
@@ -424,7 +424,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     /*
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
-    if (ckWARN(WARN_DEPRECATED) && !method && 
+    if (ckWARN(WARN_DEPRECATED) && !method &&
        (GvCVGEN(gv) || GvSTASH(gv) != stash))
        Perl_warner(aTHX_ WARN_DEPRECATED,
          "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
@@ -735,7 +735,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
             GvMULTI_on(gv);
-            hv_magic(hv, gv, 'A');
+            hv_magic(hv, Nullgv, 'A');
         }
         break;
     case 'S':
@@ -749,7 +749,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
            }
            GvMULTI_on(gv);
            hv = GvHVn(gv);
-           hv_magic(hv, gv, 'S');
+           hv_magic(hv, Nullgv, 'S');
            for (i = 1; PL_sig_name[i]; i++) {
                SV ** init;
                init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
@@ -1088,7 +1088,7 @@ Perl_gp_ref(pTHX_ GP *gp)
 void
 Perl_gp_free(pTHX_ GV *gv)
 {
-    dTHR;  
+    dTHR;
     GP* gp;
 
     if (!gv || !(gp = GvGP(gv)))
@@ -1128,7 +1128,7 @@ Perl_gp_free(pTHX_ GV *gv)
 AV *GvAVn(gv)
 register GV *gv;
 {
-    if (GvGP(gv)->gp_av) 
+    if (GvGP(gv)->gp_av)
        return GvGP(gv)->gp_av;
     else
        return GvGP(gv_AVadd(gv))->gp_av;
@@ -1200,7 +1200,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
     for (i = 1; i < NofAMmeth; i++) {
       cv = 0;
       cp = (char *)PL_AMG_names[i];
-      
+
         svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
         if (svp && ((sv = *svp) != &PL_sv_undef)) {
           switch (SvTYPE(sv)) {
@@ -1270,19 +1270,19 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                /* GvSV contains the name of the method. */
                GV *ngv;
                
-               DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", 
+               DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
                             SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
-               if (!SvPOK(GvSV(gv)) 
+               if (!SvPOK(GvSV(gv))
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
                                                       FALSE)))
                {
                    /* Can be an import stub (created by `can'). */
                    if (GvCVGEN(gv)) {
-                       Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", 
+                       Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'",
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                    } else
-                       Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'", 
+                       Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'",
                              (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
                              cp, HvNAME(stash));
                }
@@ -1293,7 +1293,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                         GvNAME(CvGV(cv))) );
            filled = 1;
        }
-#endif 
+#endif
        amt.table[i]=(CV*)SvREFCNT_inc(cv);
     }
     if (filled) {
@@ -1313,8 +1313,8 @@ SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
   dTHR;
-  MAGIC *mg; 
-  CV *cv; 
+  MAGIC *mg;
+  CV *cv;
   CV **cvp=NULL, **ocvp=NULL;
   AMT *amtp, *oamtp;
   int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
@@ -1322,10 +1322,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   HV* stash;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
-      && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
+      && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
                        : (CV **) NULL))
-      && ((cv = cvp[off=method+assignshift]) 
+      && ((cv = cvp[off=method+assignshift])
          || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
                                                          * usual method */
                  (fl = 1, cv = cvp[off=method])))) {
@@ -1361,7 +1361,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
           (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
           break;
  case not_amg:
-   (void)((cv = cvp[off=bool__amg]) 
+   (void)((cv = cvp[off=bool__amg])
          || (cv = cvp[off=numer_amg])
          || (cv = cvp[off=string_amg]));
    postpr = 1;
@@ -1386,7 +1386,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
           }
           break;
         case abs_amg:
-          if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) 
+          if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
               && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
             SV* nullsv=sv_2mortal(newSViv(0));
             if (off1==lt_amg) {
@@ -1417,13 +1417,16 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
           }
           break;
         case iter_amg:                 /* XXXX Eventually should do to_gv. */
+            /* FAIL safe */
+            return NULL;       /* Delegate operation to standard mechanisms. */
+            break;
         case to_sv_amg:
         case to_av_amg:
         case to_hv_amg:
         case to_gv_amg:
         case to_cv_amg:
             /* FAIL safe */
-            return NULL;       /* Delegate operation to standard mechanisms. */
+            return left;       /* Delegate operation to standard mechanisms. */
             break;
         default:
           goto not_found;
@@ -1431,14 +1434,14 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
         if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
               && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
-              && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) 
+              && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : (CV **) NULL))
               && (cv = cvp[off=method])) { /* Method for right
                                             * argument found */
       lr=1;
-    } else if (((ocvp && oamtp->fallback > AMGfallNEVER 
-                && (cvp=ocvp) && (lr = -1)) 
+    } else if (((ocvp && oamtp->fallback > AMGfallNEVER
+                && (cvp=ocvp) && (lr = -1))
                || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
@@ -1471,6 +1474,16 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       }
     } else {
     not_found:                 /* No method found, either report or croak */
+      switch (method) {
+        case to_sv_amg:
+        case to_av_amg:
+        case to_hv_amg:
+        case to_gv_amg:
+        case to_cv_amg:
+            /* FAIL safe */
+            return left;       /* Delegate operation to standard mechanisms. */
+            break;
+      }
       if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */
        notfound = 1; lr = -1;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
@@ -1478,22 +1491,22 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       } else {
        SV *msg;
        if (off==-1) off=method;
-       msg = sv_2mortal(Perl_newSVpvf(aTHX_ 
+       msg = sv_2mortal(Perl_newSVpvf(aTHX_
                      "Operation `%s': no method found,%sargument %s%s%s%s",
                      PL_AMG_names[method + assignshift],
                      (flags & AMGf_unary ? " " : "\n\tleft "),
-                     SvAMAGIC(left)? 
+                     SvAMAGIC(left)?
                        "in overloaded package ":
                        "has no overloaded magic",
-                     SvAMAGIC(left)? 
+                     SvAMAGIC(left)?
                        HvNAME(SvSTASH(SvRV(left))):
                        "",
-                     SvAMAGIC(right)? 
+                     SvAMAGIC(right)?
                        ",\n\tright argument in overloaded package ":
-                       (flags & AMGf_unary 
+                       (flags & AMGf_unary
                         ? ""
                         : ",\n\tright argument has no overloaded magic"),
-                     SvAMAGIC(right)? 
+                     SvAMAGIC(right)?
                        HvNAME(SvSTASH(SvRV(right))):
                        ""));
        if (amtp && amtp->fallback >= AMGfallYES) {
@@ -1507,7 +1520,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     }
   }
   if (!notfound) {
-    DEBUG_o( Perl_deb(aTHX_ 
+    DEBUG_o( Perl_deb(aTHX_
   "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
                 PL_AMG_names[off],
                 method+assignshift==off? "" :
@@ -1518,7 +1531,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                 flags & AMGf_unary? "" :
                   lr==1 ? " for right argument": " for left argument",
                 flags & AMGf_unary? " for argument" : "",
-                HvNAME(stash), 
+                HvNAME(stash),
                 fl? ",\n\tassignment variant used": "") );
   }
     /* Since we use shallow copy during assignment, we need
@@ -1531,10 +1544,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
      * b) Increment or decrement, called directly.
      *                 assignshift==0,  assign==0, method + 0 == off
      * c) Increment or decrement, translated to assignment add/subtr.
-     *                 assignshift==0,  assign==T, 
+     *                 assignshift==0,  assign==T,
      *         force_cpy == T
      * d) Increment or decrement, translated to nomethod.
-     *                 assignshift==0,  assign==0, 
+     *                 assignshift==0,  assign==0,
      *         force_cpy == T
      * e) Assignment form translated to nomethod.
      *                 assignshift==1,  assign==T, method + 1 != off
index c07e79c..cf1270d 100644 (file)
@@ -128,6 +128,13 @@ d_setreuid='undef'
 # Tell perl which symbols to export for dynamic linking.
 case "$cc" in
 *gcc*) ccdlflags='-Xlinker' ;;
+*) ccversion=`lslpp -L | grep 'C for AIX Compiler$' | awk '{print $2}'`
+   case "$ccversion" in
+     4.4.0.0|4.4.0.1|4.4.0.2)
+       echo >&4 "*** This C compiler ($ccversion) is outdated."
+       echo >&4 "*** Please upgrade to at least 4.4.0.3."
+       ;;
+     esac
 esac
 # the required -bE:$installarchlib/CORE/perl.exp is added by
 # libperl.U (Configure) later.
@@ -171,9 +178,9 @@ $define|true|[yY]*)
            ;;
        *)
            cat >&4 <<EOM
-For pthreads you should use the AIX C compiler cc_r.
-(now your compiler was set to '$cc')
-Cannot continue, aborting.
+*** For pthreads you should use the AIX C compiler cc_r.
+*** (now your compiler was set to '$cc')
+*** Cannot continue, aborting.
 EOM
            exit 1
            ;;
index c110d1e..86e8f94 100644 (file)
@@ -99,6 +99,7 @@ EOF
        fi
         ;;
 *)     # compile something small: taint.c is fine for this.
+       ccversion=`cc -V | grep 'DEC C' | awk '{print $3}'`
        # the main point is the '-v' flag of 'cc'.
                case "`cc -v -I. -c taint.c -o taint$$.o 2>&1`" in
        */gemc_cc*)     # we have the new DEC GEM CC
index 522fd46..b1758ed 100644 (file)
@@ -105,9 +105,13 @@ EOM
     ;;
 esac
 
+cc=${cc:-cc}
+
 case `$cc -v 2>&1`"" in
 *gcc*) ccisgcc="$define" ;;
-*) ccisgcc='' ;;
+*) ccisgcc=''
+   ccversion=`which cc | xargs what | grep Compiler | awk '{print $2}'`
+   ;;
 esac
 
 # Determine the architecture type of this system.
index ce301df..32335a0 100644 (file)
@@ -48,7 +48,13 @@ case "$cc" in
     *) test -f /usr/lib32/libm.so && cc='cc -n32' ;;
     esac       
 esac
-test -z "$cc" && cc=cc
+
+cc=${cc:-cc}
+
+case "$cc" in
+*gcc*) ;;
+*) ccversion=`cc -version` ;;
+esac
 
 case "$use64bitint" in
 $define|true|[yY]*)
index cb54a08..e8175f2 100644 (file)
@@ -45,7 +45,13 @@ case "$archname" in
     ;;
 esac
 
-test -z "`${cc:-cc} -V 2>&1|grep -i workshop`" || ccname=workshop
+cc=${cc:-cc}
+
+ccversion="`$cc -V 2>&1|head -1|sed 's/^cc: //'`"
+case "$ccversion" in
+*WorkShop*) ccname=workshop ;;
+*) ccversion='' ;;
+esac
 
 cat >UU/workshoplibpth.cbu<<'EOCBU'
 case "$workshoplibpth_done" in
@@ -398,34 +404,26 @@ case "$usemorebits" in
        ;;
 esac
 
-cat > UU/use64bitint.cbu <<'EOCBU'
-# This script UU/use64bitint.cbu will get 'called-back' by Configure 
-# after it has prompted the user for whether to use 64 bit integers.
-case "$use64bitint" in
-"$define"|true|[yY]*)
+cat > UU/use64bitall.cbu <<'EOCBU'
+# This script UU/use64bitall.cbu will get 'called-back' by Configure 
+# after it has prompted the user for whether to be maximally 64 bitty.
+case "$use64bitall-$use64bitall_done" in
+"$define-"|true-|[yY]*-)
            case "`uname -r`" in
            5.[1-6])
                cat >&4 <<EOM
-Solaris `uname -r|sed -e 's/^5\.\([789]\)$/\1/'` does not support 64-bit integers.
+Solaris `uname -r|sed -e 's/^5\.\([789]\)$/\1/'` does not support 64-bit pointers.
 You should upgrade to at least Solaris 7.
 EOM
                exit 1
                ;;
            esac
-           ;;
-esac
-EOCBU
-
-cat > UU/use64bitall.cbu <<'EOCBU'
-# This script UU/use64bitall.cbu will get 'called-back' by Configure 
-# after it has prompted the user for whether to be maximally 64 bitty.
-case "$use64bitall-$use64bitall_done" in
-"$define-"|true-|[yY]*-)
            libc='/usr/lib/sparcv9/libc.so'
            if test ! -f $libc; then
                cat >&4 <<EOM
 
 I do not see the 64-bit libc, $libc.
+(You are either in an old sparc or in an x86.)
 Cannot continue, aborting.
 
 EOM
index 20b67be..59d14d3 100644 (file)
@@ -1,3 +1,4 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
 use vars qw{$Try_autoload
             $Revision
@@ -6,13 +7,13 @@ use vars qw{$Try_autoload
            $Frontend  $Defaultsite
           }; #};
 
-$VERSION = '1.57_51';
+$VERSION = '1.57_57';
 
-# $Id: CPAN.pm,v 1.314 2000/08/21 12:37:43 k Exp $
+# $Id: CPAN.pm,v 1.324 2000/09/01 12:04:57 k Exp $
 
 # only used during development:
 $Revision = "";
-# $Revision = "[".substr(q$Revision: 1.314 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.324 $, 10)."]";
 
 use Carp ();
 use Config ();
@@ -135,7 +136,7 @@ sub shell {
     $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
     my $rl_avail = $Suppress_readline ? "suppressed" :
        ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
-           "available (try ``install Bundle::CPAN'')";
+           "available (try 'install Bundle::CPAN')";
 
     $CPAN::Frontend->myprint(
                             qq{
@@ -511,7 +512,11 @@ sub all_objects {
 }
 *all = \&all_objects;
 
-# Called by shell, not in batch mode. Not clean XXX
+# Called by shell, not in batch mode. In batch mode I see no risk in
+# having many processes updating something as installations are
+# continually checked at runtime. In shell mode I suspect it is
+# unintentional to open more than one shell at a time
+
 #-> sub CPAN::checklock ;
 sub checklock {
     my($self) = @_;
@@ -829,6 +834,7 @@ sub cachesize {
     shift->{DU};
 }
 
+#-> sub CPAN::CacheMgr::tidyup ;
 sub tidyup {
   my($self) = @_;
   return unless -d $self->{ID};
@@ -1150,8 +1156,8 @@ sub load {
                                         # system wide settings
       shift @INC;
     }
-    return unless @miss = $self->not_loaded;
-    # XXX better check for arrayrefs too
+    return unless @miss = $self->missing_config_data;
+
     require CPAN::FirstTime;
     my($configpm,$fh,$redo,$theycalled);
     $redo ||= "";
@@ -1218,16 +1224,19 @@ $configpm initialized.
     CPAN::FirstTime::init($configpm);
 }
 
-#-> sub CPAN::Config::not_loaded ;
-sub not_loaded {
+#-> sub CPAN::Config::missing_config_data ;
+sub missing_config_data {
     my(@miss);
-    for (qw(
-           cpan_home keep_source_where build_dir build_cache scan_cache
-           index_expire gzip tar unzip make pager makepl_arg make_arg
-           make_install_arg urllist inhibit_startup_message
-           ftp_proxy http_proxy no_proxy prerequisites_policy
-           cache_metadata
-          )) {
+    for (
+         "cpan_home", "keep_source_where", "build_dir", "build_cache",
+         "scan_cache", "index_expire", "gzip", "tar", "unzip", "make", "pager",
+         "makepl_arg", "make_arg", "make_install_arg", "urllist",
+         "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy",
+         "prerequisites_policy",
+
+         # "cache_metadata" # not yet stable enough
+
+        ) {
        push @miss, $_ unless defined $CPAN::Config->{$_};
     }
     return @miss;
@@ -1546,8 +1555,8 @@ sub _u_r_common {
     my($self) = shift @_;
     my($what) = shift @_;
     CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
-    Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
-    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
+    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
+          $what && $what =~ /^[aru]$/;
     my(@args) = @_;
     @args = '/./' unless @args;
     my(@result,$module,%seen,%need,$headerdone,
@@ -1610,14 +1619,6 @@ sub _u_r_common {
                   "in CPAN file"
                   ));
        }
-####        for ($have,$latest) {
-####          # $_ = CPAN::Version->readable($_); # %vd already applied
-####          if (length($_) > 8){
-####            my $trunc = substr($_,0,8);
-####            $CPAN::Frontend->mywarn("Truncating VERSION from [$_] to [$trunc]\n");
-####            $_ = $trunc;
-####          }
-####        }
        $CPAN::Frontend->myprint(sprintf $sprintf,
                                  $module->id,
                                  $have,
@@ -1867,6 +1868,8 @@ sub rematein {
        my $obj;
        if (ref $s) {
            $obj = $s;
+       } elsif ($s =~ m|^/|) { # looks like a regexp
+          $CPAN::Frontend->mydie("Sorry, $meth with a regular expression is not supported");
        } elsif ($s =~ m|/|) { # looks like a file
            $obj = $CPAN::META->instance('CPAN::Distribution',$s);
        } elsif ($s =~ m|^Bundle::|) {
@@ -1876,22 +1879,22 @@ sub rematein {
                if $CPAN::META->exists('CPAN::Module',$s);
        }
        if (ref $obj) {
+            if ($pragma
+                &&
+                ($] < 5.00303 || $obj->can($pragma))){
+              ### compatibility with 5.003
+              $obj->$pragma($meth); # the pragma "force" in
+                                    # "CPAN::Distribution" must know
+                                    # what we are intending
+            }
+           if ($]>=5.00303 && $obj->can('called_for')) {
+             $obj->called_for($s);
+           }
            CPAN->debug(
                        qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
                        $obj->as_string.
                        qq{\]}
                       ) if $CPAN::DEBUG;
-           $obj->$pragma()
-               if
-                   $pragma
-                       &&
-                   ($] < 5.00303 || $obj->can($pragma)); ###
-                                                          ### compatibility
-                                                          ### with
-                                                          ### 5.003
-           if ($]>=5.00303 && $obj->can('called_for')) {
-             $obj->called_for($s);
-           }
            CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
                                                       # than once in
                                                       # the queue
@@ -2023,8 +2026,6 @@ sub is_reachable {
 }
 
 #-> sub CPAN::FTP::localize ;
-# sorry for the ugly code here, I'll clean it up as soon as Net::FTP
-# is in the core
 sub localize {
     my($self,$file,$aslocal,$force) = @_;
     $force ||= 0;
@@ -2067,13 +2068,16 @@ sub localize {
            $Ua = LWP::UserAgent->new;
            my($var);
            $Ua->proxy('ftp',  $var)
-               if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
+               if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
            $Ua->proxy('http', $var)
-               if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+               if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
            $Ua->no_proxy($var)
-               if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+               if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
        }
     }
+    $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy};
+    $ENV{http_proxy} = $CPAN::Config->{http_proxy} if $CPAN::Config->{http_proxy};
+    $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy};
 
     # Try the list of urls for each single object. We keep a record
     # where we did get a file from
@@ -2096,14 +2100,16 @@ sub localize {
                ($a == $Thesite)
            } 0..$last;
     }
-    my($level,@levels);
+    my(@levels);
     if ($Themethod) {
        @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
     } else {
        @levels = qw/easy hard hardest/;
     }
     @levels = qw/easy/ if $^O eq 'MacOS';
-    for $level (@levels) {
+    my($levelno);
+    for $levelno (0..$#levels) {
+        my $level = $levels[$levelno];
        my $method = "host$level";
        my @host_seq = $level eq "easy" ?
            @reordered : 0..$last;  # reordered has CDROM up front
@@ -2118,17 +2124,20 @@ sub localize {
          return $ret;
        } else {
          unlink $aslocal;
+          last if $CPAN::Signal; # need to cleanup
        }
     }
-    my(@mess);
-    push @mess,
-    qq{Please check, if the URLs I found in your configuration file \(}.
-       join(", ", @{$CPAN::Config->{urllist}}).
-           qq{\) are valid. The urllist can be edited.},
-           qq{E.g. with ``o conf urllist push ftp://myurl/''};
-    $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
-    sleep 2;
-    $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+    unless ($CPAN::Signal) {
+        my(@mess);
+        push @mess,
+            qq{Please check, if the URLs I found in your configuration file \(}.
+                join(", ", @{$CPAN::Config->{urllist}}).
+                    qq{\) are valid. The urllist can be edited.},
+                        qq{E.g. with 'o conf urllist push ftp://myurl/'};
+        $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
+        sleep 2;
+        $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+    }
     if ($restore) {
        rename "$aslocal.bak", $aslocal;
        $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
@@ -2142,7 +2151,7 @@ sub hosteasy {
     my($self,$host_seq,$file,$aslocal) = @_;
     my($i);
   HOSTEASY: for $i (@$host_seq) {
-      my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
+        my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
        unless ($self->is_reachable($url)) {
            $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
            sleep 2;
@@ -2182,7 +2191,7 @@ sub hosteasy {
                }
            }
        }
-      if ($CPAN::META->has_usable('LWP')) {
+        if ($CPAN::META->has_usable('LWP')) {
          $CPAN::Frontend->myprint("Fetching with LWP:
   $url
 ");
@@ -2208,18 +2217,16 @@ sub hosteasy {
               ) {
              $Thesite = $i;
              return $aslocal;
-           } else {
-             # next HOSTEASY ;
            }
          } else {
-           # Alan Burlison informed me that in firewall envs Net::FTP
-           # can still succeed where LWP fails. So we do not skip
-           # Net::FTP anymore when LWP is available.
-           # next HOSTEASY ;
+           # Alan Burlison informed me that in firewall environments
+           # Net::FTP can still succeed where LWP fails. So we do not
+           # skip Net::FTP anymore when LWP is available.
          }
        } else {
          $self->debug("LWP not installed") if $CPAN::DEBUG;
        }
+        return if $CPAN::Signal;
        if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
            # that's the nice and easy way thanks to Graham
            my($host,$dir,$getfile) = ($1,$2,$3);
@@ -2252,6 +2259,7 @@ sub hosteasy {
                # next HOSTEASY;
            }
        }
+        return if $CPAN::Signal;
     }
 }
 
@@ -2378,8 +2386,9 @@ System call "$system"
 returned status $estatus (wstat $wstatus)$size
 });
          }
-       }
-    }
+          return if $CPAN::Signal;
+       } # lynx,ncftpget,ncftp
+    } # host
 }
 
 sub hosthardest {
@@ -2450,6 +2459,7 @@ sub hosthardest {
                } else {
                    $CPAN::Frontend->myprint("Hmm... Still failed!\n");
                }
+                return if $CPAN::Signal;
            } else {
                $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
                                        qq{correctly protected.\n});
@@ -2479,9 +2489,10 @@ sub hosthardest {
        } else {
            $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
        }
+        return if $CPAN::Signal;
        $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
        sleep 2;
-    }
+    } # host
 }
 
 sub talk_ftp {
@@ -2899,15 +2910,17 @@ CPAN mirror. I'll continue but problems seem likely to happen.\a\n},
 $index_target, $line_count, scalar(@lines);
 
     }
+    # A necessity since we have metadata_cache: delete what isn't
+    # there anymore
+    my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN");
+    CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG;
+    my(%exists);
     foreach (@lines) {
        chomp;
         # before 1.56 we split into 3 and discarded the rest. From
         # 1.57 we assign remaining text to $comment thus allowing to
         # influence isa_perl
        my($mod,$version,$dist,$comment) = split " ", $_, 4;
-###    $version =~ s/^\+//;
-
-       # if it is a bundle, instantiate a bundle object
        my($bundle,$id,$userid);
 
        if ($mod eq 'CPAN' &&
@@ -2916,18 +2929,18 @@ $index_target, $line_count, scalar(@lines);
               CPAN::Queue->exists('CPAN')
              )
           ) {
-           local($^W)= 0;
-           if ($version > $CPAN::VERSION){
-               $CPAN::Frontend->myprint(qq{
-  There\'s a new CPAN.pm version (v$version) available!
+            local($^W)= 0;
+            if ($version > $CPAN::VERSION){
+                $CPAN::Frontend->myprint(qq{
+  There's a new CPAN.pm version (v$version) available!
   [Current version is v$CPAN::VERSION]
   You might want to try
     install Bundle::CPAN
     reload cpan
   without quitting the current session. It should be a seamless upgrade
   while we are running...
-});
-               sleep 2;
+}); #});
+                sleep 2;
                $CPAN::Frontend->myprint(qq{\n});
            }
            last if $CPAN::Signal;
@@ -2937,21 +2950,15 @@ $index_target, $line_count, scalar(@lines);
 
        if ($bundle){
            $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
-           # warn "made mod[$mod]a bundle";
            # Let's make it a module too, because bundles have so much
            # in common with modules
            $CPAN::META->instance('CPAN::Module',$mod);
-           # warn "made mod[$mod]a module";
 
-# This "next" makes us faster but if the job is running long, we ignore
-# rereads which is bad. So we have to be a bit slower again.
-#      } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
-#          next;
+       } else {
 
-       }
-       else {
            # instantiate a module object
            $id = $CPAN::META->instance('CPAN::Module',$mod);
+
        }
 
        if ($id->cpan_file ne $dist){ # update only if file is
@@ -2982,10 +2989,24 @@ $index_target, $line_count, scalar(@lines);
                                      'CPAN_USERID' => $userid
                                     );
        }
-
+        if ($secondtime) {
+            for my $name ($mod,$dist) {
+                # CPAN->debug("confirm existence of name[$name]") if $CPAN::DEBUG;
+                $exists{$name} = undef;
+            }
+        }
        return if $CPAN::Signal;
     }
     undef $fh;
+    if ($secondtime) {
+        for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) {
+            for my $o ($CPAN::META->all_objects($class)) {
+                next if exists $exists{$o->{ID}};
+                $CPAN::META->delete($class,$o->{ID});
+                CPAN->debug("deleting ID[$o->{ID}] in class[$class]") if $CPAN::DEBUG;
+            }
+        }
+    }
 }
 
 #-> sub CPAN::Index::rd_modlist ;
@@ -3038,7 +3059,7 @@ sub write_metadata_cache {
     my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata");
     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
     $cache->{last_time} = $last_time;
-    eval { Storable::store($cache, $metadata_file) };
+    eval { Storable::nstore($cache, $metadata_file) };
     $CPAN::Frontent->mywarn($@) if $@;
 }
 
@@ -3056,6 +3077,11 @@ sub read_metadata_cache {
     return if (!$cache || ref $cache ne 'HASH');
     while(my($k,$v) = each %$cache) {
        next unless $k =~ /^CPAN::/;
+        for my $k2 (keys %$v) {
+          delete $v->{$k2}{force_update}; # if a buggy CPAN.pm left
+                                          # over such a mess, it's
+                                          # high time to correct now
+        }
        $CPAN::META->{$k} = $v;
     }
     $last_time = $cache->{last_time};
@@ -3147,12 +3173,6 @@ sub as_glimpse {
     join "", @m;
 }
 
-# Dead code, I would have liked to have,,, but it was never reached,,,
-#sub make {
-#    my($self) = @_;
-#    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
-#}
-
 #-> sub CPAN::Author::fullname ;
 sub fullname { shift->{'FULLNAME'} }
 *name = \&fullname;
@@ -3194,7 +3214,7 @@ sub get {
   EXCUSE: {
        my @e;
        exists $self->{'build_dir'} and push @e,
-           "Unwrapped into directory $self->{'build_dir'}";
+           "Is already unwrapped into directory $self->{'build_dir'}";
        $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     my($local_file);
@@ -3210,6 +3230,7 @@ sub get {
     $local_file =
        CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
            or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
+    return if $CPAN::Signal;
     $self->{localfile} = $local_file;
     $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
     my $builddir = $CPAN::META->{cachemgr}->dir;
@@ -3229,6 +3250,7 @@ sub get {
     mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
     chdir "tmp" or $CPAN::Frontend->mydie(qq{Could not chdir to "tmp": $!});;
     $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
+    return if $CPAN::Signal;
     if (! $local_file) {
        Carp::croak "bad download, can't do anything :-(\n";
     } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)(?!\n)\Z/i){
@@ -3327,22 +3349,12 @@ sub untar_me {
 sub unzip_me {
     my($self,$local_file) = @_;
     $self->{archived} = "zip";
-    if ($CPAN::META->has_inst("Archive::Zip")) {
-      if (CPAN::Tarzip->unzip($local_file)) {
-       $self->{unwrapped} = "YES";
-      } else {
-       $self->{unwrapped} = "NO";
-      }
-      return;
-    }
-    my $unzip = $CPAN::Config->{unzip} or
-        $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
-    my @system = ($unzip, $local_file);
-    if (system(@system) == 0) {
+    if (CPAN::Tarzip->unzip($local_file)) {
        $self->{unwrapped} = "YES";
     } else {
        $self->{unwrapped} = "NO";
     }
+    return;
 }
 
 sub pm2dir_me {
@@ -3577,14 +3589,18 @@ sub MD5_check_file {
                                                          )->as_string);
 
            my $wrap = qq{I\'d recommend removing $file. Its MD5
-checksum is incorrect. Maybe you have configured your \`urllist\' with
-a bad URL. Please check this array with \`o conf urllist\', and
+checksum is incorrect. Maybe you have configured your 'urllist' with
+a bad URL. Please check this array with 'o conf urllist', and
 retry.};
 
-           $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
-           $CPAN::Frontend->myprint("\n\n");
-           sleep 3;
-           return;
+            $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap));
+
+            # former versions just returned here but this seems a
+            # serious threat that deserves a die
+
+           # $CPAN::Frontend->myprint("\n\n");
+           # sleep 3;
+           # return;
        }
        # close $fh if fileno($fh);
     } else {
@@ -3617,15 +3633,34 @@ sub eq_MD5 {
 }
 
 #-> sub CPAN::Distribution::force ;
+
+# Both modules and distributions know if "force" is in effect by
+# autoinspection, not by inspecting a global variable. One of the
+# reason why this was chosen to work that way was the treatment of
+# dependencies. They should not autpomatically inherit the force
+# status. But this has the downside that ^C and die() will return to
+# the prompt but will not be able to reset the force_update
+# attributes. We try to correct for it currently in the read_metadata
+# routine, and immediately before we check for a Signal. I hope this
+# works out in one of v1.57_53ff
+
 sub force {
-  my($self) = @_;
-  $self->{'force_update'}++;
+  my($self, $method) = @_;
   for my $att (qw(
   MD5_STATUS archived build_dir localfile make install unwrapped
   writemakefile
  )) {
     delete $self->{$att};
   }
+  if ($method && $method eq "install") {
+    $self->{"force_update"}++; # name should probably have been force_install
+  }
+}
+
+#-> sub CPAN::Distribution::unforce ;
+sub unforce {
+  my($self) = @_;
+  delete $self->{'force_update'};
 }
 
 #-> sub CPAN::Distribution::isa_perl ;
@@ -3682,7 +3717,8 @@ sub make {
     # Emergency brake if they said install Pippi and get newest perl
     if ($self->isa_perl) {
       if (
-         $self->called_for ne $self->id && ! $self->{'force_update'}
+         $self->called_for ne $self->id &&
+          ! $self->{force_update}
         ) {
         # if we die here, we break bundles
        $CPAN::Frontend->mywarn(sprintf qq{
@@ -3785,6 +3821,7 @@ or
        }
        if (-f "Makefile") {
          $self->{writemakefile} = "YES";
+          delete $self->{make_clean}; # if cleaned before, enable next
        } else {
          $self->{writemakefile} =
              qq{NO Makefile.PL refused to write a Makefile.};
@@ -3794,7 +3831,10 @@ or
          # $self->{writemakefile} .= <$fh>;
        }
     }
-    return if $CPAN::Signal;
+    if ($CPAN::Signal){
+      delete $self->{force_update};
+      return;
+    }
     if (my @prereq = $self->needs_prereq){
       my $id = $self->id;
       $CPAN::Frontend->myprint("---- Dependencies detected ".
@@ -3901,7 +3941,10 @@ sub needs_prereq {
 sub test {
     my($self) = @_;
     $self->make;
-    return if $CPAN::Signal;
+    if ($CPAN::Signal){
+      delete $self->{force_update};
+      return;
+    }
     $CPAN::Frontend->myprint("Running make test\n");
   EXCUSE: {
        my @e;
@@ -3910,7 +3953,7 @@ sub test {
 
        exists $self->{'make'} and
            $self->{'make'} eq 'NO' and
-               push @e, "Oops, make had returned bad status";
+               push @e, "Can't test without successful make";
 
        exists $self->{'build_dir'} or push @e, "Has no own directory";
        $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
@@ -3941,7 +3984,9 @@ sub clean {
     $CPAN::Frontend->myprint("Running make clean\n");
   EXCUSE: {
        my @e;
-       exists $self->{'build_dir'} or push @e, "Has no own directory";
+        exists $self->{make_clean} and $self->{make_clean} eq "YES" and
+            push @e, "make clean already called once";
+       exists $self->{build_dir} or push @e, "Has no own directory";
        $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     chdir $self->{'build_dir'} or
@@ -3955,10 +4000,31 @@ sub clean {
 
     my $system = join " ", $CPAN::Config->{'make'}, "clean";
     if (system($system) == 0) {
-       $CPAN::Frontend->myprint("  $system -- OK\n");
-       $self->force;
+      $CPAN::Frontend->myprint("  $system -- OK\n");
+
+      # $self->force;
+
+      # Jost Krieger pointed out that this "force" was wrong because
+      # it has the effect that the next "install" on this distribution
+      # will untar everything again. Instead we should bring the
+      # object's state back to where it is after untarring.
+
+      delete $self->{force_update};
+      delete $self->{install};
+      delete $self->{writemakefile};
+      delete $self->{make};
+      delete $self->{make_test}; # no matter if yes or no, tests must be redone
+      $self->{make_clean} = "YES";
+
     } else {
-       # Hmmm, what to do if make clean failed?
+      # Hmmm, what to do if make clean failed?
+
+      $CPAN::Frontend->myprint(qq{  $system -- NOT OK
+
+make clean did not succeed, marking directory as unusable for further work.
+});
+      $self->force("make"); # so that this directory won't be used again
+
     }
 }
 
@@ -3966,7 +4032,10 @@ sub clean {
 sub install {
     my($self) = @_;
     $self->test;
-    return if $CPAN::Signal;
+    if ($CPAN::Signal){
+      delete $self->{force_update};
+      return;
+    }
     $CPAN::Frontend->myprint("Running make install\n");
   EXCUSE: {
        my @e;
@@ -3977,7 +4046,7 @@ sub install {
 
        exists $self->{'make'} and
            $self->{'make'} eq 'NO' and
-               push @e, "Oops, make had returned bad status";
+               push @e, "make had returned bad status, won't install without force";
 
        push @e, "make test had returned bad status, ".
            "won't install without force"
@@ -4022,6 +4091,7 @@ sub install {
                                      qq{to root to install the package\n});
         }
     }
+    delete $self->{force_update};
 }
 
 #-> sub CPAN::Distribution::dir ;
@@ -4404,7 +4474,7 @@ sub cpan_file    {
        my $email = $CPAN::META->instance(CPAN::Author,
                                      $self->{'userid'})->email;
        unless (defined $fullname && defined $email) {
-           return "Contact Author $self->{userid} (Try ``a $self->{userid}'')";
+           return "Contact Author $self->{userid} (Try 'a $self->{userid}')";
        }
        return "Contact Author $fullname <$email>";
     } else {
@@ -4447,7 +4517,7 @@ sub rematein {
 
   Either the module has not yet been uploaded to CPAN, or it is
   temporary unavailable. Please contact the author to find out
-  more about the status. Try ``i %s''.
+  more about the status. Try 'i %s'.
 },
                              $self->id,
                              $self->id,
@@ -4456,8 +4526,9 @@ sub rematein {
     }
     my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
     $pack->called_for($self->id);
-    $pack->force if exists $self->{'force_update'};
+    $pack->force($meth) if exists $self->{'force_update'};
     $pack->$meth();
+    $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'};
     delete $self->{'force_update'};
 }
 
@@ -4550,36 +4621,40 @@ sub inst_version {
 
     # there was a bug in 5.6.0 that let lots of unini warnings out of
     # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove
-    # this workaround after 5.6.1 is out.
+    # the following workaround after 5.6.1 is out.
     local($SIG{__WARN__}) =  sub { my $w = shift;
                                    return if $w =~ /uninitialized/i;
                                    warn $w;
                                  };
+
     $have = MM->parse_version($parsefile) || "undef";
     $have =~ s/^ //; # since the %vd hack these two lines here are needed
     $have =~ s/ $//; # trailing whitespace happens all the time
 
     # local($SIG{__WARN__}) =  sub { warn "2. have[$have]"; };
 
-    # Should %vd hack happen here? Must we not maintain the original
-    # version string until it is used? Do we for printing make it
-    # human readable? Or do we maintain it in a human readable form?
-    # "v1.0.2"?
+    # My thoughts about why %vd processing should happen here
 
-    # OK, let's discuss the pros and cons:
-    #-maintain it as string with leading v:
+    # Alt1 maintain it as string with leading v:
     # read index files     do nothing
     # compare it           use utility for compare
     # print it             do nothing
 
-    # maintain it as what is is
+    # Alt2 maintain it as what is is
     # read index files     convert
     # compare it           use utility because there's still a ">" vs "gt" issue
     # print it             use CPAN::Version for print
 
     # Seems cleaner to hold it in memory as a string starting with a "v"
 
+    # If the author of this module made a mistake and wrote a quoted
+    # "v1.13" instead of v1.13, we simply leave it at that with the
+    # effect that *we* will treat it like a v-tring while the rest of
+    # perl won't. Seems sensible when we consider that any action we
+    # could take now would just add complexity.
+
     $have = CPAN::Version->readable($have);
+
     $have =~ s/\s*//g; # stringify to float around floating point issues
     $have; # no stringify needed, \s* above matches always
 }
@@ -4714,8 +4789,26 @@ sub DESTROY {
 # CPAN::Tarzip::untar
 sub untar {
   my($class,$file) = @_;
-  # had to disable, because version 0.07 seems to be buggy
-  if (MM->maybe_command($CPAN::Config->{'gzip'})
+  if (0) { # makes changing order easier
+  } elsif ($CPAN::META->has_inst("Archive::Tar")
+      &&
+      $CPAN::META->has_inst("Compress::Zlib") ) {
+    my $tar = Archive::Tar->new($file,1);
+    my $af; # archive file
+    for $af ($tar->list_files) {
+        if ($af =~ m!^(/|\.\./)!) {
+            $CPAN::Frontend->mydie("ALERT: Archive contains illegal member [$af]");
+        }
+        $CPAN::Frontend->myprint("$af\n");
+        $tar->extract($af);
+        return if $CPAN::Signal;
+    }
+
+    ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+        if ($^O eq 'MacOS');
+
+    return 1;
+  } elsif (MM->maybe_command($CPAN::Config->{'gzip'})
       &&
       MM->maybe_command($CPAN::Config->{'tar'})) {
     my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
@@ -4743,17 +4836,6 @@ sub untar {
     } else {
       return 1;
     }
-  } elsif ($CPAN::META->has_inst("Archive::Tar")
-      &&
-      $CPAN::META->has_inst("Compress::Zlib") ) {
-    my $tar = Archive::Tar->new($file,1);
-    $tar->extract($tar->list_files); # I'm pretty sure we have nothing
-                                     # that isn't compressed
-
-    ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
-        if ($^O eq 'MacOS');
-
-    return 1;
   } else {
     $CPAN::Frontend->mydie(qq{
 CPAN.pm needs either both external programs tar and gzip installed or
@@ -4764,38 +4846,65 @@ is available. Can\'t continue.
 }
 
 sub unzip {
-  my($class,$file) = @_;
-  return unless $CPAN::META->has_inst("Archive::Zip");
-  # blueprint of the code from Archive::Zip::Tree::extractTree();
-  my $zip = Archive::Zip->new();
-  my $status;
-  $status = $zip->read($file);
-  die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
-  $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
-  my @members = $zip->members();
-  for my $member ( @members ) {
-    my $f = $member->fileName();
-    my $status = $member->extractToFileNamed( $f );
-    $CPAN::META->debug("f[$f]status[$status]") if $CPAN::DEBUG;
-    die "Extracting of file[$f] from zipfile[$file] failed\n" if
-        $status != Archive::Zip::AZ_OK();
-  }
-  return 1;
+    my($class,$file) = @_;
+    if ($CPAN::META->has_inst("Archive::Zip")) {
+        # blueprint of the code from Archive::Zip::Tree::extractTree();
+        my $zip = Archive::Zip->new();
+        my $status;
+        $status = $zip->read($file);
+        die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
+        $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
+        my @members = $zip->members();
+        for my $member ( @members ) {
+            my $af = $member->fileName();
+            if ($af =~ m!^(/|\.\./)!) {
+                $CPAN::Frontend->mydie("ALERT: Archive contains illegal member [$af]");
+            }
+            my $status = $member->extractToFileNamed( $af );
+            $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
+            die "Extracting of file[$af] from zipfile[$file] failed\n" if
+                $status != Archive::Zip::AZ_OK();
+            return if $CPAN::Signal;
+        }
+        return 1;
+    } else {
+        my $unzip = $CPAN::Config->{unzip} or
+            $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
+        my @system = ($unzip, $file);
+        return system(@system) == 0;
+    }
 }
 
-package CPAN::Version;
 
-sub vgt {
+package CPAN::Version;
+# CPAN::Version::vcmp courtesy Jost Krieger
+sub vcmp {
   my($self,$l,$r) = @_;
   local($^W) = 0;
   CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
-  return 1 if $r eq "undef" && $l ne "undef";
-  return if $l eq "undef" && $r ne "undef";
-  return 1 if $] >= 5.006 && $l =~ /^v/ && $r =~ /^v/ &&
-      $self->vstring($l) gt $self->vstring($r);
-  return 1 if $l > $r;
-  return 1 if $l gt $r;
-  return;
+
+  return 0 if $l eq $r; # short circuit for quicker success
+
+  if ($l=~/^v/ <=> $r=~/^v/) {
+      for ($l,$r) {
+          next if /^v/;
+          $_ = $self->float2vv($_);
+      }
+  }
+
+  return
+      ($l ne "undef") <=> ($r ne "undef") ||
+          ($] >= 5.006 &&
+           $l =~ /^v/ &&
+           $r =~ /^v/ &&
+           $self->vstring($l) cmp $self->vstring($r)) ||
+               $l <=> $r ||
+                   $l cmp $r;
+}
+
+sub vgt {
+  my($self,$l,$r) = @_;
+  $self->vcmp($l,$r) > 0;
 }
 
 sub vstring {
@@ -4804,10 +4913,35 @@ sub vstring {
   pack "U*", split /\./, $n;
 }
 
+# vv => visible vstring
+sub float2vv {
+    my($self,$n) = @_;
+    my($rev) = int($n);
+    $rev ||= 0;
+    my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits so that
+                                          # architecture cannot
+                                          # influnce
+    $mantissa ||= 0;
+    $mantissa .= "0" while length($mantissa)%3;
+    my $ret = "v" . $rev;
+    while ($mantissa) {
+        $mantissa =~ s/(\d{1,3})// or
+            die "Panic: length>0 but not a digit? mantissa[$mantissa]";
+        $ret .= ".".int($1);
+    }
+    # warn "n[$n]ret[$ret]";
+    $ret;
+}
+
 sub readable {
   my($self,$n) = @_;
   $n =~ /^([\w\-\+\.]+)/;
-  return $1 if length($1)>0;
+
+  return $1 if defined $1 && length($1)>0;
+  # if the first user reaches version v43, he will be treated as "+".
+  # We'll have to decide about a new rule here then, depending on what
+  # will be the prevailing versioning behavior then.
+
   if ($] < 5.006) { # or whenever v-strings were introduced
     # we get them wrong anyway, whatever we do, because 5.005 will
     # have already interpreted 0.2.4 to be "0.24". So even if he
@@ -5454,7 +5588,7 @@ There are two that I can think off.
 =item SOCKS
 
 If you are using a SOCKS firewall you will need to compile perl and link
-it with the SOCKS library, this is what is normally called a ``socksified''
+it with the SOCKS library, this is what is normally called a 'socksified'
 perl. With this executable you will be able to connect to servers outside
 the firewall as if it is not there.
 
@@ -5468,7 +5602,7 @@ special compiling is need as you can access hosts directly.
 
 =back
 
-=head2 Configuring lynx or ncftp for going through the firewall
+=head2 Configuring lynx or ncftp for going through a firewall
 
 If you can go through your firewall with e.g. lynx, presumably with a
 command such as
@@ -5519,14 +5653,59 @@ You may want to configure something like
 
 so that STDOUT is captured in a file for later inspection.
 
+
+=item I am not root, how can I install a module in a personal directory?
+
+You will most probably like something like this:
+
+  o conf makepl_arg "LIB=~/myperl/lib \
+                    INSTALLMAN1DIR=~/myperl/man/man1 \
+                    INSTALLMAN3DIR=~/myperl/man/man3"
+  install Sybase::Sybperl
+
+You can make this setting permanent like all C<o conf> settings with
+C<o conf commit>.
+
+You will have to add ~/myperl/man to the MANPATH environment variable
+and also tell your perl programs to look into ~/myperl/lib, e.g. by
+including
+
+  use lib "$ENV{HOME}/myperl/lib";
+
+or setting the PERL5LIB environment variable.
+
+Another thing you should bear in mind is that the UNINST parameter
+should never be set if you are not root.
+
+=item How to get a package, unwrap it, and make a change before building it?
+
+  look Sybase::Sybperl
+
+=item I installed a Bundle and had a couple of fails. When I retried,
+      everything resolved nicely. Can this be fixed to work on first
+      try?
+
+The reason for this is that CPAN does not know the dependencies of all
+modules when it starts out. To decide about the additional items to
+install, it just uses data found in the generated Makefile. An
+undetected missing piece breaks the process. But it may well be that
+your Bundle installs some prerequisite later than some depending item
+and thus your second try is able to resolve everything. Please note,
+CPAN.pm does not know the dependency tree in advance and cannot sort
+the queue of things to install in a topologically correct sequence.
+For bundles which you need to install often, it is recommended to do
+the sorting manually. It is planned to improve the metadata situation
+for dependencies on CPAN in general, but this will still take some
+time.
+
 =back
 
 =head1 BUGS
 
 We should give coverage for B<all> of the CPAN and not just the PAUSE
 part, right? In this discussion CPAN and PAUSE have become equal --
-but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus
-the clpa/, doc/, misc/, ports/, src/, scripts/.
+but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is 
+PAUSE plus the clpa/, doc/, misc/, ports/, and src/.
 
 Future development should be directed towards a better integration of
 the other parts.
index cd2c49d..713d7dd 100644 (file)
@@ -16,7 +16,7 @@ use FileHandle ();
 use File::Basename ();
 use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.41 $, 10;
+$VERSION = substr q$Revision: 1.43 $, 10;
 
 =head1 NAME
 
@@ -177,12 +177,13 @@ disable the cache scanning with 'never'.
     print qq{
 
 To speed up the initial CPAN shell startup, it is possible to use
-Storable or FreezeThaw to create an cache of metadata. If no
-serializer is avaiable, the normal index mechanism will be used.
+Storable to create an cache of metadata. If Storable is not available,
+the normal index mechanism will be used. This feature is still
+considered experimantal and not recommended for production use.
 
 };
 
-    defined($default = $CPAN::Config->{cache_metadata}) or $default = 1;
+    defined($default = $CPAN::Config->{cache_metadata}) or $default = 0;
     do {
         $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no'));
     } while ($ans !~ /^\s*[yn]/i);
index 16efd5b..2dec72c 100644 (file)
@@ -608,8 +608,12 @@ sub _is_safe {
   # Check to see whether owner is neither superuser (or a system uid) nor me
   # Use the real uid from the $< variable
   # UID is in [4]
-  if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
-    carp "Directory owned neither by root nor the current user";
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+               File::Temp->top_system_uid());
+
+    carp "Directory owned neither by root nor the current user.";
     return 0;
   }
 
index 01ac486..37ed68f 100644 (file)
@@ -202,7 +202,7 @@ These may not necessarily cause trouble, but indicate mediocre style.
 
 =over 4
 
-=item * multiple occurrence of link target I<name>
+=item * multiple occurence of link target I<name>
 
 The POD file has some C<=item> and/or C<=head> commands that have
 the same text. Potential hyperlinks to such a text cannot be unique then.
index f7772c1..bead929 100644 (file)
@@ -106,7 +106,7 @@ sub mycan {                         # Real can would leave stubs.
 }
 
 %constants = (
-             'integer'   =>  0x1000, 
+             'integer'   =>  0x1000,
              'float'     =>  0x2000,
              'binary'    =>  0x4000,
              'q'         =>  0x8000,
@@ -127,11 +127,29 @@ sub mycan {                               # Real can would leave stubs.
         dereferencing    => '${} @{} %{} &{} *{}',
         special          => 'nomethod fallback =');
 
+use warnings::register;
 sub constant {
   # Arguments: what, sub
   while (@_) {
-    $^H{$_[0]} = $_[1];
-    $^H |= $constants{$_[0]} | $overload::hint_bits;
+    if (@_ == 1) {
+        warnings::warnif ("Odd number of arguments for overload::constant");
+        last;
+    }
+    elsif (!exists $constants {$_ [0]}) {
+        warnings::warnif ("`$_[0]' is not an overloadable type");
+    }
+    elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
+        # Can't use C<ref $_[1] eq "CODE"> above as code references can be
+        # blessed, and C<ref> would return the package the ref is blessed into.
+        if (warnings::enabled) {
+            $_ [1] = "undef" unless defined $_ [1];
+            warnings::warn ("`$_[1]' is not a code reference");
+        }
+    }
+    else {
+        $^H{$_[0]} = $_[1];
+        $^H |= $constants{$_[0]} | $overload::hint_bits;
+    }
     shift, shift;
   }
 }
@@ -149,7 +167,7 @@ sub remove_constant {
 
 __END__
 
-=head1 NAME 
+=head1 NAME
 
 overload - Package for overloading perl operations
 
@@ -157,7 +175,7 @@ overload - Package for overloading perl operations
 
     package SomeThing;
 
-    use overload 
+    use overload
        '+' => \&myadd,
        '-' => \&mysub;
        # etc
@@ -179,12 +197,12 @@ The compilation directive
 
     package Number;
     use overload
-       "+" => \&add, 
+       "+" => \&add,
        "*=" => "muas";
 
 declares function Number::add() for addition, and method muas() in
 the "class" C<Number> (or one of its base classes)
-for the assignment form C<*=> of multiplication.  
+for the assignment form C<*=> of multiplication.
 
 Arguments of this directive come in (key, value) pairs.  Legal values
 are values legal inside a C<&{ ... }> call, so the name of a
@@ -279,20 +297,20 @@ if C<+=> is not overloaded.
 =back
 
 B<Warning.>  Due to the presense of assignment versions of operations,
-routines which may be called in assignment context may create 
-self-referential structures.  Currently Perl will not free self-referential 
+routines which may be called in assignment context may create
+self-referential structures.  Currently Perl will not free self-referential
 structures until cycles are C<explicitly> broken.  You may get problems
 when traversing your structures too.
 
-Say, 
+Say,
 
   use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
 
 is asking for trouble, since for code C<$obj += $foo> the subroutine
-is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj, 
+is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj,
 \$foo]>.  If using such a subroutine is an important optimization, one
 can overload C<+=> explicitly by a non-"optimized" version, or switch
-to non-optimized version if C<not defined $_[2]> (see 
+to non-optimized version if C<not defined $_[2]> (see
 L<Calling Conventions for Binary Operations>).
 
 Even if no I<explicit> assignment-variants of operators are present in
@@ -382,6 +400,12 @@ If not overloaded, the argument will be dereferenced I<as is>, thus
 should be of correct type.  These functions should return a reference
 of correct type, or another object with overloaded dereferencing.
 
+As a special case if the overload returns the object itself then it
+will be used directly (provided it is the correct type).
+
+The dereference operators must be specified explicitly they will not be passed to
+"nomethod".
+
 =item * I<Special>
 
     "nomethod", "fallback", "=",
@@ -464,11 +488,16 @@ the last one is used.  Say, C<1-$a> can be equivalent to
 if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
 C<use overload> directive.
 
+The C<"nomethod"> mechanism is I<not> used for the dereference operators
+( ${} @{} %{} &{} *{} ).
+
+
 If some operation cannot be resolved, and there is no function
 assigned to C<"nomethod">, then an exception will be raised via die()--
 unless C<"fallback"> was specified as a key in C<use overload> directive.
 
-=head2 Fallback 
+
+=head2 Fallback
 
 The key C<"fallback"> governs what to do if a method for a particular
 operation is not found.  Three different cases are possible depending on
@@ -492,7 +521,7 @@ present.
 =item * defined, but FALSE
 
 No autogeneration is tried.  Perl tries to call
-C<"nomethod"> value, and if this is missing, raises an exception. 
+C<"nomethod"> value, and if this is missing, raises an exception.
 
 =back
 
@@ -510,7 +539,7 @@ This operation is called in the situations when a mutator is applied
 to a reference that shares its object with some other reference, such
 as
 
-       $a=$b; 
+       $a=$b;
        ++$a;
 
 To make this change $a and not change $b, a copy of C<$$a> is made,
@@ -521,7 +550,7 @@ done if C<++> is expressed via a method for C<'++'> or C<'+='> (or
 C<nomethod>).  Note that if this operation is expressed via C<'+'>
 a nonmutator, i.e., as in
 
-       $a=$b; 
+       $a=$b;
        $a=$a+1;
 
 then C<$a> does not reference a new copy of C<$$a>, since $$a does not
@@ -535,15 +564,15 @@ string copy if the object is a plain scalar.
 
 =item B<Example>
 
-The actually executed code for 
+The actually executed code for
 
-       $a=$b; 
+       $a=$b;
         Something else which does not modify $a or $b....
        ++$a;
 
 may be
 
-       $a=$b; 
+       $a=$b;
         Something else which does not modify $a or $b....
        $a = $a->clone(undef,"");
         $a->incr(undef,"");
@@ -570,7 +599,7 @@ substitutions are possible for the following operations:
 C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
 is not defined.
 
-=item I<Conversion operations> 
+=item I<Conversion operations>
 
 String, numeric, and boolean conversion are calculated in terms of one
 another if not all of them are defined.
@@ -597,7 +626,7 @@ string or numerical conversion.
 
 can be expressed in terms of string conversion.
 
-=item I<Comparison operations> 
+=item I<Comparison operations>
 
 can be expressed in terms of its "spaceship" counterpart: either
 C<E<lt>=E<gt>> or C<cmp>:
@@ -705,20 +734,20 @@ to overload constant pieces of regular expressions.
 
 The corresponding values are references to functions which take three arguments:
 the first one is the I<initial> string form of the constant, the second one
-is how Perl interprets this constant, the third one is how the constant is used.  
+is how Perl interprets this constant, the third one is how the constant is used.
 Note that the initial string form does not
-contain string delimiters, and has backslashes in backslash-delimiter 
+contain string delimiters, and has backslashes in backslash-delimiter
 combinations stripped (thus the value of delimiter is not relevant for
-processing of this string).  The return value of this function is how this 
+processing of this string).  The return value of this function is how this
 constant is going to be interpreted by Perl.  The third argument is undefined
 unless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
 context (comes from strings, regular expressions, and single-quote HERE
-documents), it is C<tr> for arguments of C<tr>/C<y> operators, 
+documents), it is C<tr> for arguments of C<tr>/C<y> operators,
 it is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
 
 Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
 it is expected that overloaded constant strings are equipped with reasonable
-overloaded catenation operator, otherwise absurd results will result.  
+overloaded catenation operator, otherwise absurd results will result.
 Similarly, negative numbers are considered as negations of positive constants.
 
 Note that it is probably meaningless to call the functions overload::constant()
@@ -732,7 +761,7 @@ From these methods they may be called as
          overload::constant integer => sub {Math::BigInt->new(shift)};
        }
 
-B<BUGS> Currently overloaded-ness of constants does not propagate 
+B<BUGS> Currently overloaded-ness of constants does not propagate
 into C<eval '...'>.
 
 =head1 IMPLEMENTATION
@@ -774,7 +803,7 @@ packages acquire a magic during the next C<bless>ing into the
 package. This magic is three-words-long for packages without
 overloading, and carries the cache table if the package is overloaded.
 
-Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is 
+Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
 carried out before any operation that can imply an assignment to the
 object $a (or $b) refers to, like C<$a++>.  You can override this
 behavior by defining your own copy constructor (see L<"Copy Constructor">).
@@ -785,8 +814,8 @@ to be changed are constant (but this is not enforced).
 =head1 Metaphor clash
 
 One may wonder why the semantic of overloaded C<=> is so counter intuitive.
-If it I<looks> counter intuitive to you, you are subject to a metaphor 
-clash.  
+If it I<looks> counter intuitive to you, you are subject to a metaphor
+clash.
 
 Here is a Perl object metaphor:
 
@@ -805,10 +834,10 @@ that $a and $b are separate entities.
 
 The difference is not relevant in the absence of mutators.  After
 a Perl-way assignment an operation which mutates the data referenced by $a
-would change the data referenced by $b too.  Effectively, after 
+would change the data referenced by $b too.  Effectively, after
 C<$a = $b> values of $a and $b become I<indistinguishable>.
 
-On the other hand, anyone who has used algebraic notation knows the 
+On the other hand, anyone who has used algebraic notation knows the
 expressive power of the arithmetic metaphor.  Overloading works hard
 to enable this metaphor while preserving the Perlian way as far as
 possible.  Since it is not not possible to freely mix two contradicting
@@ -817,7 +846,7 @@ far as all the mutators are called via overloaded access only>.  The
 way it is done is described in L<Copy Constructor>.
 
 If some mutator methods are directly applied to the overloaded values,
-one may need to I<explicitly unlink> other values which references the 
+one may need to I<explicitly unlink> other values which references the
 same value:
 
     $a = new Data 23;
@@ -841,7 +870,7 @@ However, it would not make
 preserve "objectness" of $a.  But Perl I<has> a way to make assignments
 to an object do whatever you want.  It is just not the overload, but
 tie()ing interface (see L<perlfunc/tie>).  Adding a FETCH() method
-which returns the object itself, and STORE() method which changes the 
+which returns the object itself, and STORE() method which changes the
 value of the object, one can reproduce the arithmetic metaphor in its
 completeness, at least for variables which were tie()d from the start.
 
@@ -885,8 +914,8 @@ allowing index 0 to be treated as a normal element.
 
   package two_refs;
   use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} };
-  sub new { 
-    my $p = shift; 
+  sub new {
+    my $p = shift;
     bless \ [@_], $p;
   }
   sub gethash {
@@ -900,13 +929,13 @@ allowing index 0 to be treated as a normal element.
   my %fields;
   my $i = 0;
   $fields{$_} = $i++ foreach qw{zero one two three};
-  sub STORE { 
+  sub STORE {
     my $self = ${shift()};
     my $key = $fields{shift()};
     defined $key or die "Out of band access";
     $$self->[$key] = shift;
   }
-  sub FETCH { 
+  sub FETCH {
     my $self = ${shift()};
     my $key = $fields{shift()};
     defined $key or die "Out of band access";
@@ -939,7 +968,7 @@ overloaded dereference operator).  Here is one possible fetching routine:
   sub access_hash {
     my ($self, $key) = (shift, shift);
     my $class = ref $self;
-    bless $self, 'overload::dummy'; # Disable overloading of %{} 
+    bless $self, 'overload::dummy'; # Disable overloading of %{}
     my $out = $self->{$key};
     bless $self, $class;       # Restore overloading
     $out;
@@ -951,8 +980,8 @@ level of indirection which allows a non-circular structure of references:
   package two_refs1;
   use overload '%{}' => sub { ${shift()}->[1] },
                '@{}' => sub { ${shift()}->[0] };
-  sub new { 
-    my $p = shift; 
+  sub new {
+    my $p = shift;
     my $a = [@_];
     my %h;
     tie %h, $p, $a;
@@ -969,13 +998,13 @@ level of indirection which allows a non-circular structure of references:
   my %fields;
   my $i = 0;
   $fields{$_} = $i++ foreach qw{zero one two three};
-  sub STORE { 
+  sub STORE {
     my $a = ${shift()};
     my $key = $fields{shift()};
     defined $key or die "Out of band access";
     $a->[$key] = shift;
   }
-  sub FETCH { 
+  sub FETCH {
     my $a = ${shift()};
     my $key = $fields{shift()};
     defined $key or die "Out of band access";
@@ -985,7 +1014,7 @@ level of indirection which allows a non-circular structure of references:
 Now if $baz is overloaded like this, then C<$bar> is a reference to a
 reference to the intermediate array, which keeps a reference to an
 actual array, and the access hash.  The tie()ing object for the access
-hash is also a reference to a reference to the actual array, so 
+hash is also a reference to a reference to the actual array, so
 
 =over
 
@@ -1060,7 +1089,7 @@ Add a pretty-printer method to the module F<symbolic.pm>:
     $a = $a->pretty if ref $a;
     $b = $b->pretty if ref $b;
     "[$meth $a $b]";
-  } 
+  }
 
 Now one can finish the script by
 
@@ -1081,7 +1110,7 @@ look for an overloaded operator C<"">.  Thus it is enough to use
     $a = 'u' unless defined $a;
     $b = 'u' unless defined $b;
     "[$meth $a $b]";
-  } 
+  }
 
 Now one can change the last line of the script to
 
@@ -1092,7 +1121,7 @@ which outputs
   side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
 
 and one can inspect the value in debugger using all the possible
-methods.  
+methods.
 
 Something is is still amiss: consider the loop variable $cnt of the
 script.  It was a number, not an object.  We cannot make this value of
@@ -1126,9 +1155,9 @@ slightly modified str()):
     } else {
       "[$meth $a]";
     }
-  } 
-  my %subr = ( n => sub {$_[0]}, 
-              sqrt => sub {sqrt $_[0]}, 
+  }
+  my %subr = ( n => sub {$_[0]},
+              sqrt => sub {sqrt $_[0]},
               '-' => sub {shift() - shift()},
               '+' => sub {shift() + shift()},
               '/' => sub {shift() / shift()},
@@ -1137,7 +1166,7 @@ slightly modified str()):
             );
   sub num {
     my ($meth, $a, $b) = @{+shift};
-    my $subr = $subr{$meth} 
+    my $subr = $subr{$meth}
       or die "Do not know how to ($meth) in symbolic";
     $a = $a->num if ref $a eq __PACKAGE__;
     $b = $b->num if ref $b eq __PACKAGE__;
@@ -1206,7 +1235,7 @@ deep only, so recursive copying is not needed):
     bless [@$self], ref $self;
   }
 
-To make C<++> and C<--> work, we need to implement actual mutators, 
+To make C<++> and C<--> work, we need to implement actual mutators,
 either directly, or in C<nomethod>.  We continue to do things inside
 C<nomethod>, thus add
 
@@ -1215,7 +1244,7 @@ C<nomethod>, thus add
       return $obj;
     }
 
-after the first line of wrap().  This is not a most effective 
+after the first line of wrap().  This is not a most effective
 implementation, one may consider
 
   sub inc { $_[0] = bless ['++', shift, 1]; }
@@ -1238,8 +1267,8 @@ As a final remark, note that one can fill %subr by
   $subr{'++'} = $subr{'+'};
   $subr{'--'} = $subr{'-'};
 
-This finishes implementation of a primitive symbolic calculator in 
-50 lines of Perl code.  Since the numeric values of subexpressions 
+This finishes implementation of a primitive symbolic calculator in
+50 lines of Perl code.  Since the numeric values of subexpressions
 are not cached, the calculator is very slow.
 
 Here is the answer for the exercise: In the case of str(), we need no
@@ -1265,9 +1294,9 @@ until the value is I<used>.
 
 To see it in action, add a method
 
-  sub STORE { 
-    my $obj = shift; 
-    $#$obj = 1; 
+  sub STORE {
+    my $obj = shift;
+    $#$obj = 1;
     @$obj->[0,1] = ('=', shift);
   }
 
@@ -1336,6 +1365,27 @@ key (in fact a presence of this method shows that this package has
 overloading enabled, and it is what is used by the C<Overloaded>
 function of module C<overload>).
 
+The module might issue the following warnings:
+
+=over 4
+
+=item Odd number of arguments for overload::constant
+
+(W) The call to overload::constant contained an odd number of arguments.
+The arguments should come in pairs.
+
+=item `%s' is not an overloadable type
+
+(W) You tried to overload a constant type the overload package is unaware of.
+
+=item `%s' is not a code reference
+
+(W) The second (fourth, sixth, ...) argument of overload::constant needs
+to be a code reference. Either an anonymous subroutine, or a reference
+to a subroutine.
+
+=back
+
 =head1 BUGS
 
 Because it is used for overloading, the per-package hash %OVERLOAD now
@@ -1347,12 +1397,12 @@ C<fallback> is present (possibly undefined). This may create
 interesting effects if some package is not overloaded, but inherits
 from two overloaded packages.
 
-Relation between overloading and tie()ing is broken.  Overloading is 
+Relation between overloading and tie()ing is broken.  Overloading is
 triggered or not basing on the I<previous> class of tie()d value.
 
-This happens because the presence of overloading is checked too early, 
+This happens because the presence of overloading is checked too early,
 before any tie()d access is attempted.  If the FETCH()ed class of the
-tie()d value does not change, a simple workaround is to access the value 
+tie()d value does not change, a simple workaround is to access the value
 immediately after tie()ing, so that after this call the I<previous> class
 coincides with the current one.
 
diff --git a/mg.c b/mg.c
index 57209cd..e9832da 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -292,7 +292,8 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        if (isUPPER(mg->mg_type)) {
            sv_magic(nsv,
-                    mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj,
+                    mg->mg_type == 'P' ? SvTIED_obj(sv, mg) :
+                    (mg->mg_type == 'D' && mg->mg_obj) ? sv : mg->mg_obj,
                     toLOWER(mg->mg_type), key, klen);
            count++;
        }
index 8642fae..1feb68a 100644 (file)
@@ -34,13 +34,11 @@ Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL
     config_args='$config_args'
     hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
     usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads usemultiplicity=$usemultiplicity
-    useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles 
-    use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble usesocks=$usesocks
+    useperlio=$useperlio d_sfio=$d_sfio uselargefiles=$uselargefiles usesocks=$usesocks
+    use64bitint=$use64bitint use64bitall=$use64bitall uselongdouble=$uselongdouble
   Compiler:
-    cc='$cc', optimize='$optimize', gccversion=$gccversion, gccosandvers=$gccosandvers
-    cppflags='$cppflags'
-    ccflags ='$ccflags'
-    stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork
+    cc='$cc', ccflags ='$ccflags', optimize='$optimize', cppflags='$cppflags'
+    ccversion='$ccversion', gccversion='$gccversion', gccosandvers='$gccosandvers'
     intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize, byteorder=$byteorder
     d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize
     ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize
diff --git a/perl.h b/perl.h
index c6a4646..de5b8c5 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1149,6 +1149,18 @@ typedef NVTYPE NV;
 #   ifdef LDBL_MANT_DIG
 #       define NV_MANT_DIG LDBL_MANT_DIG
 #   endif
+#   ifdef LDBL_MAX
+#       define NV_MAX LDBL_MAX
+#       define NV_MIN LDBL_MIN
+#   else
+#       ifdef HUGE_VALL
+#           define NV_MAX HUGE_VALL
+#       else
+#           ifdef HUGE_VAL
+#               define NV_MAX ((NV)HUGE_VAL)
+#           endif
+#       endif
+#   endif
 #   ifdef HAS_SQRTL
 #       define Perl_cos cosl
 #       define Perl_sin sinl
@@ -1185,6 +1197,14 @@ typedef NVTYPE NV;
 #   ifdef DBL_MANT_DIG
 #       define NV_MANT_DIG DBL_MANT_DIG
 #   endif
+#   ifdef DBL_MAX
+#       define NV_MAX DBL_MAX
+#       define NV_MIN DBL_MIN
+#   else
+#       ifdef HUGE_VAL
+#           define NV_MAX HUGE_VAL
+#       endif
+#   endif
 #   define Perl_cos cos
 #   define Perl_sin sin
 #   define Perl_sqrt sqrt
index 2fca6bc..3257fec 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -3359,7 +3359,7 @@ Perl_utf8_hop(pTHXo_ U8 *s, I32 off)
 
 #undef  Perl_utf8_to_bytes
 U8*
-Perl_utf8_to_bytes(pTHXo_ U8 *s, STRLEN len)
+Perl_utf8_to_bytes(pTHXo_ U8 *s, STRLEN *len)
 {
     return ((CPerlObj*)pPerl)->Perl_utf8_to_bytes(s, len);
 }
index 3eda765..b6dab89 100644 (file)
@@ -3115,11 +3115,12 @@ Found in file utf8.c
 
 =item utf8_to_bytes
 
-Converts a string C<s> of length C<len> from UTF8 into ASCII encoding.
-Unlike C<bytes_to_utf8>, this over-writes the original string.
-Returns zero on failure after converting as much as possible.
+Converts a string C<s> of length C<len> from UTF8 into byte encoding.
+Unlike C<bytes_to_utf8>, this over-writes the original string, and
+updates len to contain the new length.
+Returns zero on failure leaving the string and len unchanged
 
-       U8 *    utf8_to_bytes(U8 *s, STRLEN len)
+       U8 *    utf8_to_bytes(U8 *s, STRLEN *len)
 
 =for hackers
 Found in file utf8.c
index 70e7d84..4c3b8e1 100644 (file)
@@ -789,8 +789,7 @@ already.  The fatal error has been downgraded to an optional warning:
         
 This warns you that C<"fred@example.com"> is going to turn into
 C<fred.com> if you don't backslash the C<@>.
-
-See L<http://www.plover.com/~mjd/perl/at-error.html> for more details
+See http://www.plover.com/~mjd/perl/at-error.html for more details
 about the history here.
 
 =head1 Modules and Pragmata
index 2858b36..2a07a22 100644 (file)
@@ -1018,6 +1018,11 @@ references can be weakened.
 with an assignment operator, which implies modifying the value itself.
 Perhaps you need to copy the value to a temporary, and repeat that.
 
+=item Character > 255 in vec()
+
+(F) You applied the vec() function to a UTF8 string which contained
+a character > 255.   vec() currently only operates on characters < 256.
+
 =item chmod() mode argument is missing initial 0
 
 (W chmod) A novice will sometimes say
@@ -1683,6 +1688,16 @@ silently ignored.
 (F) Your machine apparently doesn't implement ioctl(), which is pretty
 strange for a machine that supports C.
 
+=item `%s' is not a code reference
+
+(W) The second (fourth, sixth, ...) argument of overload::constant needs
+to be a code reference. Either an anonymous subroutine, or a reference
+to a subroutine.
+
+=item `%s' is not an overloadable type
+
+(W) You tried to overload a constant type the overload package is unaware of.
+
 =item junk on end of regexp
 
 (P) The regular expression parser is confused.
@@ -2205,6 +2220,11 @@ L<perlport> for more on portability concerns.
 
 See also L<perlport> for writing portable code.
 
+=item Odd number of arguments for overload::constant
+
+(W) The call to overload::constant contained an odd number of arguments.
+The arguments should come in pairs.
+
 =item Odd number of elements in hash assignment
 
 (W misc) You specified an odd number of elements to initialize a hash,
index cdf929e..9cd1a08 100644 (file)
@@ -701,8 +701,8 @@ See the discussion of pack() above.
 
 As of perl 5.005_03 the letter range regular expression such as 
 [A-Z] and [a-z] have been especially coded to not pick up gap 
-characters.  For example, characters such as 'ô' C<o WITH CIRCUMFLEX> 
-(or E<ocirc>) that lie between I and J would not be matched by the 
+characters.  For example, characters such as E<ocirc> C<o WITH CIRCUMFLEX> 
+that lie between I and J would not be matched by the 
 regular expression range C</[H-K]/>.  
 
 If you do want to match the alphabet gap characters in a single octet 
@@ -844,12 +844,12 @@ for drive, that is:
 
 The property of lower case before uppercase letters in EBCDIC is
 even carried to the Latin 1 EBCDIC pages such as 0037 and 1047.
-An example would be that 'Ë' (or E<Euml>) C<E WITH DIAERESIS> (203) comes 
-before 'ë' (or E<euml>) C<e WITH DIAERESIS> (235) on and ASCII machine, but 
+An example would be that E<Euml> C<E WITH DIAERESIS> (203) comes 
+before E<euml> C<e WITH DIAERESIS> (235) on an ASCII machine, but 
 the latter (83) comes before the former (115) on an EBCDIC machine.  
-(Astute readers will note that the upper case version of 'ß' (or E<szlig>) 
+(Astute readers will note that the upper case version of E<szlig> 
 C<SMALL LETTER SHARP S> is simply "SS" and that the upper case version of 
-'^?' (or E<yuml>) C<y WITH DIAERESIS> is not in the 0..255 range but it is 
+E<yuml> C<y WITH DIAERESIS> is not in the 0..255 range but it is 
 at U+x0178 in Unicode, or C<"\x{178}"> in a Unicode enabled Perl).
 
 The sort order will cause differences between results obtained on
@@ -875,8 +875,8 @@ and include Latin-1 characters then apply:
     s/ß/SS/g; 
 
 then sort().  Do note however that such Latin-1 manipulation does not 
-address the '^?' (or E<yuml>) C<y WITH DIAERESIS> character that will 
-remain at code point 255 on ASCII machines, but 223 on most EBCDIC machines 
+address the E<yuml> C<y WITH DIAERESIS> character that will remain at 
+code point 255 on ASCII machines, but 223 on most EBCDIC machines 
 where it will sort to a place less than the EBCDIC numerals.  With a 
 Unicode enabled Perl you might try:
 
@@ -1010,7 +1010,8 @@ translation difficulties.  In particular one popular nroff implementation
 was known to strip accented characters to their unaccented counterparts 
 while attempting to view this document through the B<pod2man> program 
 (for example, you may see a plain C<y> rather than one with a diaeresis 
-as in C<^?> or E<yuml> ).
+as in E<yuml>).  Another nroff truncated the resultant man page at
+the first occurence of 8 bit characters.
 
 Not all shells will allow multiple C<-e> string arguments to perl to
 be concatenated together properly as recipes 2, 3, and 4 might seem
@@ -1018,12 +1019,14 @@ to imply.
 
 Perl does not yet work with any Unicode features on EBCDIC platforms.
 
+=head1 SEE ALSO
+
+L<perllocale>, L<perlfunc>.
+
 =head1 REFERENCES
 
 http://anubis.dkuug.dk/i18n/charmaps
 
-L<perllocale>, L<perlfunc>.
-
 http://www.unicode.org/
 
 http://www.unicode.org/unicode/reports/tr16/
@@ -1047,10 +1050,10 @@ ISSN 1523-0309; Multilingual Computing Inc. Sandpoint ID, USA.
 
 =head1 AUTHOR
 
-Peter Prymmer E<lt>pvhp@best.comE<gt> wrote this in 1999 and 2000 
+Peter Prymmer pvhp@best.com wrote this in 1999 and 2000 
 with CCSID 0819 and 0037 help from Chris Leach and 
-AndrE<eacute> Pirard E<lt>A.Pirard@ulg.ac.beE<gt> as well as POSIX-BC 
-help from Thomas Dorner E<lt>Thomas.Dorner@start.deE<gt>.
+AndrE<eacute> Pirard A.Pirard@ulg.ac.be as well as POSIX-BC 
+help from Thomas Dorner Thomas.Dorner@start.de.
 Thanks also to Philip Newton and Vickie Cooper.  Trademarks, registered 
 trademarks, service marks and registered service marks used in this 
 document are the property of their respective owners.
index 112b1ed..79905f8 100644 (file)
@@ -1189,7 +1189,6 @@ Use this:
         my $i;
         for ($i = @$array; --$i; ) {
             my $j = int rand ($i+1);
-            next if $i == $j;
             @$array[$i,$j] = @$array[$j,$i];
         }
     }
index ec6e0a2..9d9e9b4 100644 (file)
@@ -5093,6 +5093,7 @@ A class implementing a hash should have the following methods:
     FIRSTKEY this
     NEXTKEY this, lastkey
     DESTROY this
+    UNTIE this
 
 A class implementing an ordinary array should have the following methods:
 
@@ -5109,6 +5110,7 @@ A class implementing an ordinary array should have the following methods:
     SPLICE this, offset, length, LIST
     EXTEND this, count
     DESTROY this
+    UNTIE this
 
 A class implementing a file handle should have the following methods:
 
@@ -5121,6 +5123,7 @@ A class implementing a file handle should have the following methods:
     PRINTF this, format, LIST
     CLOSE this
     DESTROY this
+    UNTIE this
 
 A class implementing a scalar should have the following methods:
 
@@ -5128,6 +5131,7 @@ A class implementing a scalar should have the following methods:
     FETCH this,
     STORE this, value
     DESTROY this
+    UNTIE this
 
 Not all methods indicated above need be implemented.  See L<perltie>,
 L<Tie::Hash>, L<Tie::Array>, L<Tie::Scalar>, and L<Tie::Handle>.
@@ -5508,6 +5512,9 @@ If an element off the end of the string is written to, Perl will first
 extend the string with sufficiently many zero bytes.   It is an error
 to try to write off the beginning of the string (i.e. negative OFFSET).
 
+The string must not contain any character with value > 255 (which
+can only happen if you're using UTF8 encoding).
+
 Strings created with C<vec> can also be manipulated with the logical
 operators C<|>, C<&>, C<^>, and C<~>.  These operators will assume a bit
 vector operation is desired when both operands are strings.
index 5c8724a..da67c89 100644 (file)
@@ -4,10 +4,10 @@ perlguts - Introduction to the Perl API
 
 =head1 DESCRIPTION
 
-This document attempts to describe how to use the Perl API, as well as containing 
-some info on the basic workings of the Perl core. It is far from complete 
-and probably contains many errors. Please refer any questions or 
-comments to the author below.
+This document attempts to describe how to use the Perl API, as well as
+containing some info on the basic workings of the Perl core. It is far
+from complete and probably contains many errors. Please refer any
+questions or comments to the author below.
 
 =head1 Variables
 
@@ -1949,8 +1949,7 @@ produced a new character set containing all the characters you can
 possibly think of and more. There are several ways of representing these
 characters, and the one Perl uses is called UTF8. UTF8 uses
 a variable number of bytes to represent a character, instead of just
-one. You can learn more about Unicode at
-L<http://www.unicode.org/|http://www.unicode.org/>
+one. You can learn more about Unicode at http://www.unicode.org/
 
 =head2 How can I recognise a UTF8 string?
 
index 4311ee2..2aa928c 100644 (file)
@@ -36,7 +36,7 @@ Perl history in brief, by Larry Wall:
 
 Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick
 Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy
-Sarathy, Graham Barr.
+Sarathy, Graham Barr, Jarkko Hietaniemi.
 
 =head2 PUMPKIN?
 
@@ -341,6 +341,10 @@ the strings?).
          5.6.0-RC3     2000-Mar-21     release candidate 3
          5.6.0         2000-Mar-22
 
+ Sarathy  5.6.1         2000-***-**    The 5.6 maintenance track.
+
+ Jarkko   5.7.0         2000-Sep-02    The 5.7 track: Development.
+
 =head2 SELECTED RELEASE SIZES
 
 For example the notation "core: 212  29" in the release 1.000 means that
index 87669e5..2c449f8 100644 (file)
@@ -2046,8 +2046,41 @@ in the regexp.  Here are some silly examples:
                                          # prints 'Hi Mom!'
     $x =~ /aaa(?{print "Hi Mom!";})def/; # doesn't match,
                                          # no 'Hi Mom!'
+
+Pay careful attention to the next example:
+
     $x =~ /abc(?{print "Hi Mom!";})ddd/; # doesn't match,
                                          # no 'Hi Mom!'
+                                         # but why not?
+
+At first glance, you'd think that it shouldn't print, because obviously
+the C<ddd> isn't going to match the target string. But look at this
+example:
+
+    $x =~ /abc(?{print "Hi Mom!";})[d]dd/; # doesn't match,
+                                           # but _does_ print
+
+Hmm. What happened here? If you've been following along, you know that
+the above pattern should be effectively the same as the last one --
+enclosing the d in a character class isn't going to change what it
+matches. So why does the first not print while the second one does?
+
+The answer lies in the optimizations the REx engine makes. In the first
+case, all the engine sees are plain old characters (aside from the
+C<?{}> construct). It's smart enough to realize that the string 'ddd'
+doesn't occur in our target string before actually running the pattern
+through. But in the second case, we've tricked it into thinking that our
+pattern is more complicated than it is. It takes a look, sees our
+character class, and decides that it will have to actually run the
+pattern to determine whether or not it matches, and in the process of
+running it hits the print statement before it discovers that we don't
+have a match.
+
+To take a closer look at how the engine does optimizations, see the
+section L<"Pragmas and debugging"> below.
+
+More fun with C<?{}>:
+
     $x =~ /(?{print "Hi Mom!";})/;       # matches,
                                          # prints 'Hi Mom!'
     $x =~ /(?{$c = 1;})(?{print "$c";})/;  # matches,
index b39d7d5..60df0cb 100644 (file)
@@ -48,7 +48,7 @@ for you--you need to do that explicitly yourself.
 =head2 Tying Scalars
 
 A class implementing a tied scalar should define the following methods:
-TIESCALAR, FETCH, STORE, and possibly DESTROY.
+TIESCALAR, FETCH, STORE, and possibly UNTIE and/or DESTROY.
 
 Let's look at each in turn, using as an example a tie class for
 scalars that allows the user to do something like:
@@ -157,6 +157,12 @@ argument--the new value the user is trying to assign.
         return $new_nicety;
     }
 
+=item UNTIE this
+
+This method will be triggered when the C<untie> occurs. This can be useful
+if the class needs to know when no further calls will be made. (Except DESTROY
+of course.) See below for more details.
+
 =item DESTROY this
 
 This method will be triggered when the tied variable needs to be destructed.
@@ -180,7 +186,7 @@ TIESCALAR classes are certainly possible.
 =head2 Tying Arrays
 
 A class implementing a tied ordinary array should define the following
-methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY. 
+methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps UNTIE and/or DESTROY.
 
 FETCHSIZE and STORESIZE are used to provide C<$#array> and
 equivalent C<scalar(@array)> access.
@@ -192,7 +198,7 @@ base class to implement the first five of these in terms of the basic
 methods above.  The default implementations of DELETE and EXISTS in
 B<Tie::Array> simply C<croak>.
 
-In addition EXTEND will be called when perl would have pre-extended 
+In addition EXTEND will be called when perl would have pre-extended
 allocation in a real array.
 
 This means that tied arrays are now I<complete>. The example below needs
@@ -260,10 +266,10 @@ index whose value we're trying to fetch.
       return $self->{ARRAY}[$idx];
     }
 
-If a negative array index is used to read from an array, the index 
+If a negative array index is used to read from an array, the index
 will be translated to a positive one internally by calling FETCHSIZE
-before being passed to FETCH. 
+before being passed to FETCH.
+
 As you may have noticed, the name of the FETCH method (et al.) is the same
 for all accesses, even though the constructors differ in names (TIESCALAR
 vs TIEARRAY).  While in theory you could have the same class servicing
@@ -285,8 +291,12 @@ there.  For example:
       }
       return $self->{ARRAY}[$idx] = $value;
     }
-Negative indexes are treated the same as with FETCH.  
+
+Negative indexes are treated the same as with FETCH.
+
+=item UNTIE this
+
+Will be called when C<untie> happens. (See below.)
 
 =item DESTROY this
 
@@ -316,8 +326,8 @@ the constructor.  FETCH and STORE access the key and value pairs.  EXISTS
 reports whether a key is present in the hash, and DELETE deletes one.
 CLEAR empties the hash by deleting all the key and value pairs.  FIRSTKEY
 and NEXTKEY implement the keys() and each() functions to iterate over all
-the keys.  And DESTROY is called when the tied variable is garbage
-collected.
+the keys.  UNTIE is called when C<untie> happens, and DESTROY is called when
+the tied variable is garbage collected.
 
 If this seems like a lot, then feel free to inherit from merely the
 standard Tie::Hash module for most of your methods, redefining only the
@@ -599,6 +609,10 @@ thing, but we'll have to go through the LIST field indirectly.
        return each %{ $self->{LIST} }
     }
 
+=item UNTIE this
+
+This is called when C<untie> occurs.
+
 =item DESTROY this
 
 This method is triggered when a tied hash is about to go out of
@@ -629,7 +643,7 @@ This is partially implemented now.
 
 A class implementing a tied filehandle should define the following
 methods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC,
-READ, and possibly CLOSE and DESTROY.  The class can also provide: BINMODE, 
+READ, and possibly CLOSE, UNTIE and DESTROY.  The class can also provide: BINMODE,
 OPEN, EOF, FILENO, SEEK, TELL - if the corresponding perl operators are
 used on the handle.
 
@@ -718,6 +732,11 @@ function.
 
     sub CLOSE { print "CLOSE called.\n" }
 
+=item UNTIE this
+
+As with the other types of ties, this method will be called when C<untie> happens.
+It may be appropriate to "auto CLOSE" when this occurs.
+
 =item DESTROY this
 
 As with the other types of ties, this method will be called when the
@@ -736,6 +755,11 @@ Here's how to use our little example:
     print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
     print <FOO>;
 
+=head2 UNTIE this
+
+You can define for all tie types an UNTIE method that will be called
+at untie().
+
 =head2 The C<untie> Gotcha
 
 If you intend making use of the object returned from either tie() or
@@ -850,7 +874,8 @@ closed.  The reason there is no output is because the file buffers
 have not been flushed to disk.
 
 Now that you know what the problem is, what can you do to avoid it?
-Well, the good old C<-w> flag will spot any instances where you call
+Prior to the introduction of the optional UNTIE method the only way
+was the good old C<-w> flag. Which will spot any instances where you call
 untie() and there are still valid references to the tied object.  If
 the second script above this near the top C<use warnings 'untie'>
 or was run with the C<-w> flag, Perl prints this
@@ -865,6 +890,25 @@ called:
     undef $x;
     untie $fred;
 
+Now that UNTIE exists the class designer can decide which parts of the
+class functionality are really associated with C<untie> and which with
+the object being destroyed. What makes sense for a given class depends
+on whether the inner references are being kept so that non-tie-related
+methods can be called on the object. But in most cases it probably makes
+sense to move the functionality that would have been in DESTROY to the UNTIE
+method.
+
+If the UNTIE method exists then the warning above does not occur. Instead the
+UNTIE method is passed the count of "extra" references and can issue its own
+warning if appropriate. e.g. to replicate the no UNTIE case this method can
+be used:
+
+    sub UNTIE
+    {
+     my ($obj,$count) = @_;
+     carp "untie attempted while $count inner references still exist" if $count;
+    }
+
 =head1 SEE ALSO
 
 See L<DB_File> or L<Config> for some interesting tie() implementations.
@@ -886,3 +930,6 @@ source code to MLDBM.
 Tom Christiansen
 
 TIEHANDLE by Sven Verdoolaege <F<skimo@dns.ufsia.ac.be>> and Doug MacEachern <F<dougm@osf.org>>
+
+UNTIE by Nick Ing-Simmons <F<nick@ing-simmons.net>>
+
index 97975b3..496e5ff 100644 (file)
@@ -1775,23 +1775,27 @@ isa(CLASS), can(METHOD), VERSION( [NEED] )
 
 =item Tying Scalars
 
-TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this
+TIESCALAR classname, LIST, FETCH this, STORE this, value, UNTIE this,
+DESTROY this
 
 =item Tying Arrays
 
 TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value,
-DESTROY this
+UNTIE this, DESTROY this
 
 =item Tying Hashes
 
 USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key, STORE
 this, key, value, DELETE this, key, CLEAR this, EXISTS this, key, FIRSTKEY
-this, NEXTKEY this, lastkey, DESTROY this
+this, NEXTKEY this, lastkey, UNTIE this, DESTROY this
 
 =item Tying FileHandles
 
 TIEHANDLE classname, LIST, WRITE this, LIST, PRINT this, LIST, PRINTF this,
-LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, DESTROY this
+LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, UNTIE this,
+DESTROY this
+
+=item UNTIE this
 
 =item The C<untie> Gotcha
 
@@ -2364,11 +2368,11 @@ chr(), ord(), pack(), print(), printf(), sort(), sprintf(), unpack()
 
 =over
 
-=item Ignore ASCII vs EBCDIC sort differences.
+=item Ignore ASCII vs. EBCDIC sort differences.
 
-=item MONOCASE then sort data.
+=item MONO CASE then sort data.
 
-=item Convert, sort data, then reconvert.
+=item Convert, sort data, then re convert.
 
 =item Perform sorting on one type of machine only.
 
@@ -2390,7 +2394,7 @@ IFS access
 
 =item OS/390 
 
-dataset access, locales
+chcp, dataset access, iconv, locales
 
 =item VM/ESA?
 
@@ -2398,6 +2402,10 @@ dataset access, locales
 
 =back
 
+=item BUGS
+
+=item SEE ALSO
+
 =item REFERENCES
 
 =item AUTHOR
@@ -3895,6 +3903,8 @@ A, p, d, s, n, r, f, m, o, j, x
 
 =item Formatted Printing of IVs, UVs, and NVs
 
+=item Pointer-To-Integer and Integer-To-Pointer
+
 =item Source Documentation
 
 =back
@@ -4664,7 +4674,19 @@ accidentally using the context of the sort() itself)
 
 =item Building Extensions Can Fail Because Of Largefiles
 
-In string, @%s now must be written as \@%s
+=item ftmp-security tests warn 'system possibly insecure'
+
+=item Test lib/posix Subtest 9 Fails In LP64-Configured HP-UX
+
+=item Long Doubles Still Don't Work In Solaris
+
+=item Linux With Sfio Fails op/misc Test 48
+
+=item Storable tests fail in some platforms
+
+=item Threads Are Still Experimental
+
+=item The Compiler Suite Is Still Experimental
 
 =back
 
@@ -6179,18 +6201,6 @@ FETCH_I<type>_ATTRIBUTES, MODIFY_I<type>_ATTRIBUTES
 
 =back
 
-=head2 attrs - set/get attributes of a subroutine (deprecated)
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-method, locked
-
-=back
-
 =head2 autouse - postpone load of modules until a function is used
 
 =over
@@ -6410,18 +6420,6 @@ operations
 
 =back
 
-=head2 ops - Perl pragma to restrict unsafe operations when compiling
-
-=over
-
-=item SYNOPSIS 
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
-=back
-
 =head2 overload - Package for overloading perl operations
 
 =over
@@ -6514,6 +6512,9 @@ integer, float, binary, q, qr
 
 =item DIAGNOSTICS
 
+Odd number of arguments for overload::constant, `%s' is not an overloadable
+type, `%s' is not a code reference
+
 =item BUGS
 
 =back
@@ -7682,7 +7683,7 @@ optionE<gt> [shift|pop]>, C<o conf E<lt>list optionE<gt>
 
 http firewall, ftp firewall, One way visibility, SOCKS, IP Masquerade
 
-=item Configuring lynx or ncftp for going through the firewall
+=item Configuring lynx or ncftp for going through a firewall
 
 =back
 
@@ -7691,7 +7692,11 @@ http firewall, ftp firewall, One way visibility, SOCKS, IP Masquerade
 I installed a new version of module X but CPAN keeps saying, I      have
 the old version installed, So why is UNINST=1 not the default?, When I
 install bundles or multiple modules with one command      there is too
-much output to keep track of
+much output to keep track of, I am not root, how can I install a module in
+a personal directory?, How to get a package, unwrap it, and make a change
+before building it?, I installed a Bundle and had a couple of fails. When I
+retried,       everything resolved nicely. Can this be fixed to work on
+first      try?
 
 =item BUGS
 
@@ -7817,9 +7822,9 @@ C<byacc>, C<byteorder>
 =item c
 
 C<c>, C<castflags>, C<cat>, C<cc>, C<cccdlflags>, C<ccdlflags>, C<ccflags>,
-C<ccflags_uselargefiles>, C<ccsymbols>, C<cf_by>, C<cf_email>, C<cf_time>,
-C<charsize>, C<chgrp>, C<chmod>, C<chown>, C<clocktype>, C<comm>,
-C<compress>
+C<ccflags_uselargefiles>, C<ccname>, C<ccsymbols>, C<ccversion>, C<cf_by>,
+C<cf_email>, C<cf_time>, C<charsize>, C<chgrp>, C<chmod>, C<chown>,
+C<clocktype>, C<comm>, C<compress>
 
 =item C
 
@@ -7864,22 +7869,23 @@ C<d_msync>, C<d_munmap>, C<d_mymalloc>, C<d_nice>, C<d_nv_preserves_uv>,
 C<d_nv_preserves_uv_bits>, C<d_off64_t>, C<d_old_pthread_create_joinable>,
 C<d_oldpthreads>, C<d_oldsock>, C<d_open3>, C<d_pathconf>, C<d_pause>,
 C<d_perl_otherlibdirs>, C<d_phostname>, C<d_pipe>, C<d_poll>,
-C<d_portable>, C<d_PRId64>, C<d_PRIeldbl>, C<d_PRIEldbl>, C<d_PRIfldbl>,
-C<d_PRIFldbl>, C<d_PRIgldbl>, C<d_PRIGldbl>, C<d_PRIi64>, C<d_PRIo64>,
-C<d_PRIu64>, C<d_PRIx64>, C<d_PRIX64>, C<d_pthread_yield>, C<d_pwage>,
+C<d_portable>, C<d_PRId64>, C<d_PRIeldbl>, C<d_PRIEUldbl>, C<d_PRIfldbl>,
+C<d_PRIFUldbl>, C<d_PRIgldbl>, C<d_PRIGUldbl>, C<d_PRIi64>, C<d_PRIo64>,
+C<d_PRIu64>, C<d_PRIx64>, C<d_PRIXU64>, C<d_pthread_yield>, C<d_pwage>,
 C<d_pwchange>, C<d_pwclass>, C<d_pwcomment>, C<d_pwexpire>, C<d_pwgecos>,
 C<d_pwpasswd>, C<d_pwquota>, C<d_qgcvt>, C<d_quad>, C<d_readdir>,
 C<d_readlink>, C<d_rename>, C<d_rewinddir>, C<d_rmdir>, C<d_safebcpy>,
 C<d_safemcpy>, C<d_sanemcmp>, C<d_sched_yield>, C<d_scm_rights>,
-C<d_seekdir>, C<d_select>, C<d_sem>, C<d_semctl>, C<d_semctl_semid_ds>,
-C<d_semctl_semun>, C<d_semget>, C<d_semop>, C<d_setegid>, C<d_seteuid>,
-C<d_setgrent>, C<d_setgrps>, C<d_sethent>, C<d_setlinebuf>, C<d_setlocale>,
-C<d_setnent>, C<d_setpent>, C<d_setpgid>, C<d_setpgrp2>, C<d_setpgrp>,
-C<d_setprior>, C<d_setproctitle>, C<d_setpwent>, C<d_setregid>,
-C<d_setresgid>, C<d_setresuid>, C<d_setreuid>, C<d_setrgid>, C<d_setruid>,
-C<d_setsent>, C<d_setsid>, C<d_setvbuf>, C<d_sfio>, C<d_shm>, C<d_shmat>,
-C<d_shmatprototype>, C<d_shmctl>, C<d_shmdt>, C<d_shmget>, C<d_sigaction>,
-C<d_sigsetjmp>, C<d_socket>, C<d_socklen_t>, C<d_sockpair>, C<d_sqrtl>,
+C<d_SCNfldbl>, C<d_seekdir>, C<d_select>, C<d_sem>, C<d_semctl>,
+C<d_semctl_semid_ds>, C<d_semctl_semun>, C<d_semget>, C<d_semop>,
+C<d_setegid>, C<d_seteuid>, C<d_setgrent>, C<d_setgrps>, C<d_sethent>,
+C<d_setlinebuf>, C<d_setlocale>, C<d_setnent>, C<d_setpent>, C<d_setpgid>,
+C<d_setpgrp2>, C<d_setpgrp>, C<d_setprior>, C<d_setproctitle>,
+C<d_setpwent>, C<d_setregid>, C<d_setresgid>, C<d_setresuid>,
+C<d_setreuid>, C<d_setrgid>, C<d_setruid>, C<d_setsent>, C<d_setsid>,
+C<d_setvbuf>, C<d_sfio>, C<d_shm>, C<d_shmat>, C<d_shmatprototype>,
+C<d_shmctl>, C<d_shmdt>, C<d_shmget>, C<d_sigaction>, C<d_sigsetjmp>,
+C<d_socket>, C<d_socklen_t>, C<d_sockpair>, C<d_socks5_init>, C<d_sqrtl>,
 C<d_statblks>, C<d_statfs_f_flags>, C<d_statfs_s>, C<d_statvfs>,
 C<d_stdio_cnt_lval>, C<d_stdio_ptr_lval>, C<d_stdio_stream_array>,
 C<d_stdiobase>, C<d_stdstdio>, C<d_strchr>, C<d_strcoll>, C<d_strctcpy>,
@@ -7969,8 +7975,8 @@ C<myhostname>, C<myuname>
 
 C<n>, C<netdb_hlen_type>, C<netdb_host_type>, C<netdb_name_type>,
 C<netdb_net_type>, C<nm>, C<nm_opt>, C<nm_so_opt>, C<nonxs_ext>, C<nroff>,
-C<nveformat>, C<nvEformat>, C<nvfformat>, C<nvFformat>, C<nvgformat>,
-C<nvGformat>, C<nvsize>, C<nvtype>
+C<nveformat>, C<nvEUformat>, C<nvfformat>, C<nvFUformat>, C<nvgformat>,
+C<nvGUformat>, C<nvsize>, C<nvtype>
 
 =item o
 
@@ -8008,12 +8014,13 @@ C<sitearch>, C<sitearchexp>, C<sitebin>, C<sitebinexp>, C<sitelib>,
 C<sitelib_stem>, C<sitelibexp>, C<siteprefix>, C<siteprefixexp>,
 C<sizesize>, C<sizetype>, C<sleep>, C<smail>, C<small>, C<so>,
 C<sockethdr>, C<socketlib>, C<socksizetype>, C<sort>, C<spackage>,
-C<spitshell>, C<split>, C<sPRId64>, C<sPRIeldbl>, C<sPRIEldbl>,
-C<sPRIfldbl>, C<sPRIFldbl>, C<sPRIgldbl>, C<sPRIGldbl>, C<sPRIi64>,
-C<sPRIo64>, C<sPRIu64>, C<sPRIx64>, C<sPRIX64>, C<src>, C<ssizetype>,
-C<startperl>, C<startsh>, C<static_ext>, C<stdchar>, C<stdio_base>,
-C<stdio_bufsiz>, C<stdio_cnt>, C<stdio_filbuf>, C<stdio_ptr>,
-C<stdio_stream_array>, C<strings>, C<submit>, C<subversion>, C<sysman>
+C<spitshell>, C<split>, C<sPRId64>, C<sPRIeldbl>, C<sPRIEUldbl>,
+C<sPRIfldbl>, C<sPRIFUldbl>, C<sPRIgldbl>, C<sPRIGUldbl>, C<sPRIi64>,
+C<sPRIo64>, C<sPRIu64>, C<sPRIx64>, C<sPRIXU64>, C<src>, C<sSCNfldbl>,
+C<ssizetype>, C<startperl>, C<startsh>, C<static_ext>, C<stdchar>,
+C<stdio_base>, C<stdio_bufsiz>, C<stdio_cnt>, C<stdio_filbuf>,
+C<stdio_ptr>, C<stdio_stream_array>, C<strings>, C<submit>, C<subversion>,
+C<sysman>
 
 =item t
 
@@ -8030,7 +8037,7 @@ C<uselongdouble>, C<usemorebits>, C<usemultiplicity>, C<usemymalloc>,
 C<usenm>, C<useopcode>, C<useperlio>, C<useposix>, C<usesfio>,
 C<useshrplib>, C<usesocks>, C<usethreads>, C<usevendorprefix>, C<usevfork>,
 C<usrinc>, C<uuname>, C<uvoformat>, C<uvsize>, C<uvtype>, C<uvuformat>,
-C<uvxformat>, C<uvXformat>
+C<uvxformat>, C<uvXUformat>
 
 =item v
 
@@ -8456,22 +8463,6 @@ arrays
 
 =back
 
-=head2 Errno - System errno constants
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CAVEATS
-
-=item AUTHOR
-
-=item COPYRIGHT
-
-=back
-
 =head2 Exporter - Implements default import method for modules
 
 =over
@@ -9807,11 +9798,11 @@ $fh->print, $fh->printf, $fh->getline, $fh->getlines
 
 =item Configuring Getopt::Long
 
-default, posix_default, auto_abbrev, getopt_compat, require_order, permute,
-bundling (default: disabled), bundling_override (default: disabled),
-ignore_case  (default: enabled), ignore_case_always (default: disabled),
-pass_through (default: disabled), prefix, prefix_pattern, debug (default:
-disabled)
+default, posix_default, auto_abbrev, getopt_compat, gnu_compat, gnu_getopt,
+require_order, permute, bundling (default: disabled), bundling_override
+(default: disabled), ignore_case  (default: enabled), ignore_case_always
+(default: disabled), pass_through (default: disabled), prefix,
+prefix_pattern, debug (default: disabled)
 
 =item Return values and Errors
 
@@ -10349,28 +10340,6 @@ hostpath(), peerpath()
 
 =back
 
-=head2 IPC::Msg - SysV Msg IPC object class
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item METHODS
-
-new ( KEY , FLAGS ), id, rcv ( BUF, LEN [, TYPE [, FLAGS ]] ), remove, set
-( STAT ), set ( NAME => VALUE [, NAME => VALUE ...] ), snd ( TYPE, MSG [,
-FLAGS ] ), stat
-
-=item SEE ALSO
-
-=item AUTHOR
-
-=item COPYRIGHT
-
-=back
-
 =head2 IPC::Open2, open2 - open a process for both reading and writing
 
 =over
@@ -10398,29 +10367,6 @@ handling
 
 =back
 
-=head2 IPC::Semaphore - SysV Semaphore IPC object class
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item METHODS
-
-new ( KEY , NSEMS , FLAGS ), getall, getncnt ( SEM ), getpid ( SEM ),
-getval ( SEM ), getzcnt ( SEM ), id, op ( OPLIST ), remove, set ( STAT ),
-set ( NAME => VALUE [, NAME => VALUE ...] ), setall ( VALUES ), setval ( N
-, VALUE ), stat
-
-=item SEE ALSO
-
-=item AUTHOR
-
-=item COPYRIGHT
-
-=back
-
 =head2 IPC::SysV - SysV IPC constants
 
 =over
@@ -11002,7 +10948,7 @@ after =back
 
 =item Warnings
 
-multiple occurrence of link target I<name>, line containing nothing but
+multiple occurence of link target I<name>, line containing nothing but
 whitespace in paragraph, file does not start with =head, No numeric
 argument for =over, previous =item has no contents, preceding non-item
 paragraph(s), =item type mismatch (I<one> vs. I<two>), I<N> unescaped
@@ -11483,7 +11429,8 @@ section
 =item DIAGNOSTICS
 
 roff font should be 1 or 2 chars, not `%s', Invalid link %s, Unknown escape
-EE<lt>%sE<gt>, Unknown sequence %s, Unmatched =back
+EE<lt>%sE<gt>, Unknown sequence %s, %s: Unknown command paragraph "%s" on
+line %d, Unmatched =back
 
 =item BUGS
 
@@ -12071,39 +12018,6 @@ C<O_RDONLY>, C<O_WRONLY>, C<O_RDWR>
 
 =back
 
-=head2 Safe - Compile and execute code in restricted compartments
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-a new namespace, an operator mask
-
-=item WARNING
-
-=over
-
-=item RECENT CHANGES
-
-=item Methods in class Safe
-
-permit (OP, ...), permit_only (OP, ...), deny (OP, ...), deny_only (OP,
-...), trap (OP, ...), untrap (OP, ...), share (NAME, ...), share_from
-(PACKAGE, ARRAYREF), varglob (VARNAME), reval (STRING), rdo (FILENAME),
-root (NAMESPACE), mask (MASK)
-
-=item Some Safety Issues
-
-Memory, CPU, Snooping, Signals, State Changes
-
-=item AUTHOR
-
-=back
-
-=back
-
 =head2 Search::Dict, look - search for key in dictionary file
 
 =over
@@ -12261,27 +12175,6 @@ C<Storable::is_retrieving>
 
 =back
 
-=head2 Syslog, Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl
-interface to the UNIX syslog(3) calls
-
-=over
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-openlog $ident, $logopt, $facility, syslog $priority, $format, @args,
-setlogmask $mask_priority, setlogsock $sock_type (added in 5.004_02),
-closelog
-
-=item EXAMPLES
-
-=item SEE ALSO
-
-=item AUTHOR
-
-=back
-
 =head2 Syslog::Syslog, Sys::Syslog, openlog, closelog, setlogmask, syslog -
 Perl interface to the UNIX syslog(3) calls
 
index 5e333c0..06b8230 100644 (file)
@@ -71,9 +71,8 @@ is usually referred to as the XS language.
 See L<perlxstut> for a tutorial on the whole extension creation process.
 
 Note: For some extensions, Dave Beazley's SWIG system may provide a
-significantly more convenient mechanism for creating the extension glue
-code. See L<http://www.swig.org> for more 
-information.
+significantly more convenient mechanism for creating the extension
+glue code.  See http://www.swig.org/ for more information.
 
 =head2 On The Road
 
diff --git a/pp.h b/pp.h
index 7f396b2..029583a 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -147,7 +147,7 @@ used, guarantees that there is room for at least C<nitems> to be pushed
 onto the stack.
 
 =for apidoc Am|void|PUSHs|SV* sv
-Push an SV onto the stack.  The stack must have room for this element. 
+Push an SV onto the stack.  The stack must have room for this element.
 Does not handle 'set' magic.  See C<XPUSHs>.
 
 =for apidoc Am|void|PUSHp|char* str|STRLEN len
@@ -185,7 +185,7 @@ Push an integer onto the stack, extending the stack if necessary.  Handles
 'set' magic. See C<PUSHi>.
 
 =for apidoc Am|void|XPUSHu|UV uv
-Push an unsigned integer onto the stack, extending the stack if necessary. 
+Push an unsigned integer onto the stack, extending the stack if necessary.
 See C<PUSHu>.
 
 =cut
@@ -342,10 +342,13 @@ See C<PUSHu>.
            { dTARGETSTACKED;                                           \
                { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}}
 
-#define setAGAIN(ref) sv = arg = ref;                                  \
-  if (!SvROK(ref))                                                     \
+#define setAGAIN(ref) sv = ref;                                                        \
+  if (!SvROK(ref))                                                             \
       Perl_croak(aTHX_ "Overloaded dereference did not return a reference");   \
-  goto am_again;
+  if (ref != arg && SvRV(ref) != SvRV(arg)) {                                  \
+      arg = ref;                                                               \
+      goto am_again;                                                           \
+  }
 
 #define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
 
index 641a781..f0791f2 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -29,7 +29,7 @@
  * --jhi */
 #   ifdef __hpux__
 /* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h>
- * and another MAXINT from "perl.h" <- <sys/param.h>. */ 
+ * and another MAXINT from "perl.h" <- <sys/param.h>. */
 #       undef MAXINT
 #   endif
 #   include <shadow.h>
@@ -40,8 +40,8 @@
 # include <unistd.h>
 #endif
 
-#ifdef HAS_SYSCALL   
-#ifdef __cplusplus              
+#ifdef HAS_SYSCALL
+#ifdef __cplusplus
 extern "C" int syscall(unsigned long,...);
 #endif
 #endif
@@ -58,7 +58,7 @@ extern "C" int syscall(unsigned long,...);
 # include <sys/socket.h>
 # if defined(USE_SOCKS) && defined(I_SOCKS)
 #   include <socks.h>
-# endif 
+# endif
 # ifdef I_NETDB
 #  include <netdb.h>
 # endif
@@ -703,7 +703,7 @@ PP(pp_binmode)
     if (MAXARG > 1)
        discp = POPs;
 
-    gv = (GV*)POPs; 
+    gv = (GV*)POPs;
 
     if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
        PUSHMARK(SP);
@@ -722,7 +722,7 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
 
-    if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp))) 
+    if (do_binmode(fp,IoTYPE(io),mode_from_discipline(discp)))
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -769,7 +769,7 @@ PP(pp_tie)
            PUSHs(*MARK++);
        PUTBACK;
        call_method(methname, G_SCALAR);
-    } 
+    }
     else {
        /* Not clear why we don't call call_method here too.
         * perhaps to get different error message ?
@@ -777,7 +777,7 @@ PP(pp_tie)
        stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
            DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(*MARK,n_a));                   
+                methname, SvPV(*MARK,n_a));
        }
        ENTER;
        PUSHSTACKi(PERLSI_MAGIC);
@@ -813,22 +813,23 @@ PP(pp_untie)
        SV *obj = SvRV(mg->mg_obj);
        GV *gv;
        CV *cv = NULL;
-        if (ckWARN(WARN_UNTIE)) {
-           if (mg && SvREFCNT(obj) > 1)
-               Perl_warner(aTHX_ WARN_UNTIE,
-                   "untie attempted while %"UVuf" inner references still exist",
-                   (UV)SvREFCNT(obj) - 1 ) ;
-        }
        if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
             isGV(gv) && (cv = GvCV(gv))) {
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj((SV*)gv, mg));
+           XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
            PUTBACK;
            ENTER;
            call_sv((SV *)cv, G_VOID);
            LEAVE;
            SPAGAIN;
         }
+        else if (ckWARN(WARN_UNTIE)) {
+           if (mg && SvREFCNT(obj) > 1)
+               Perl_warner(aTHX_ WARN_UNTIE,
+                   "untie attempted while %"UVuf" inner references still exist",
+                   (UV)SvREFCNT(obj) - 1 ) ;
+        }
     }
     sv_unmagic(sv, how);
     RETPUSHYES;
@@ -901,7 +902,7 @@ PP(pp_dbmopen)
     }
 
     if (sv_isobject(TOPs)) {
-       sv_unmagic((SV *) hv, 'P');            
+       sv_unmagic((SV *) hv, 'P');
        sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
     }
     LEAVE;
@@ -1082,7 +1083,7 @@ PP(pp_select)
     else {
        GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
        if (gvp && *gvp == egv) {
-           gv_efullname4(TARG, PL_defoutgv, Nullch, FALSE);
+           gv_efullname4(TARG, PL_defoutgv, Nullch, TRUE);
            XPUSHTARG;
        }
        else {
@@ -1788,7 +1789,7 @@ PP(pp_eof)
 PP(pp_tell)
 {
     djSP; dTARGET;
-    GV *gv;     
+    GV *gv;
     MAGIC *mg;
 
     if (MAXARG == 0)
@@ -1890,7 +1891,7 @@ PP(pp_truncate)
     len = (Off_t)POPi;
 #endif
     /* Checking for length < 0 is problematic as the type might or
-     * might not be signed: if it is not, clever compilers will moan. */ 
+     * might not be signed: if it is not, clever compilers will moan. */
     /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
     SETERRNO(0,0);
 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
@@ -1904,7 +1905,7 @@ PP(pp_truncate)
            PerlIO_flush(IoIFP(GvIOp(tmpgv)));
 #ifdef HAS_TRUNCATE
            if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
-#else 
+#else
            if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
 #endif
                result = 0;
@@ -2005,7 +2006,7 @@ PP(pp_ioctl)
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
 #else
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
-#endif 
+#endif
 #else
        DIE(aTHX_ "fcntl is not implemented");
 #endif
@@ -2492,7 +2493,7 @@ PP(pp_getpeername)
            if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
                !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
                        sizeof(u_short) + sizeof(struct in_addr))) {
-               goto nuts2;         
+               goto nuts2;     
            }
        }
 #endif
@@ -2601,7 +2602,7 @@ PP(pp_stat)
        PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
 #   endif
 #endif
-#if Gid_t_size > IVSIZE 
+#if Gid_t_size > IVSIZE
        PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
 #else
 #   if Gid_t_sign <= 0
@@ -3153,7 +3154,7 @@ PP(pp_fttext)
            break;
        }
 #ifdef EBCDIC
-        else if (!(isPRINT(*s) || isSPACE(*s))) 
+        else if (!(isPRINT(*s) || isSPACE(*s)))
             odd++;
 #else
        else if (*s & 128) {
@@ -3741,7 +3742,7 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) 
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
     djSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -3762,7 +3763,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) 
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
     djSP; dTARGET;
     Pid_t childpid;
     int optype;
@@ -4552,7 +4553,7 @@ PP(pp_gprotoent)
 #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
     I32 which = PL_op->op_type;
     register char **elem;
-    register SV *sv;  
+    register SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *PerlSock_getprotobyname(Netdb_name_t);
     struct protoent *PerlSock_getprotobynumber(int);
@@ -4837,7 +4838,7 @@ PP(pp_gpwent)
     register SV *sv;
     STRLEN n_a;
     struct passwd *pwent  = NULL;
-    /* 
+    /*
      * We currently support only the SysV getsp* shadow password interface.
      * The interface is declared in <shadow.h> and often one needs to link
      * with -lsecurity or some such.
@@ -4878,7 +4879,7 @@ PP(pp_gpwent)
      *
      * Note that <sys/security.h> is already probed for, but currently
      * it is only included in special cases.
-     * 
+     *
      * In Digital UNIX/Tru64 if using the getespw*() (which seems to be
      * be preferred interface, even though also the getprpw*() interface
      * is available) one needs to link with -lsecurity -ldb -laud -lm.
@@ -5209,7 +5210,7 @@ PP(pp_syscall)
            a[i++] = SvIV(*MARK);
        else if (*MARK == &PL_sv_undef)
            a[i++] = 0;
-       else 
+       else
            a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
        if (i > 15)
            break;
@@ -5277,7 +5278,7 @@ PP(pp_syscall)
 }
 
 #ifdef FCNTL_EMULATE_FLOCK
+
 /*  XXX Emulate flock() with fcntl().
     What's really needed is a good file locking module.
 */
@@ -5286,7 +5287,7 @@ static int
 fcntl_emulate_flock(int fd, int operation)
 {
     struct flock flock;
+
     switch (operation & ~LOCK_NB) {
     case LOCK_SH:
        flock.l_type = F_RDLCK;
@@ -5303,7 +5304,7 @@ fcntl_emulate_flock(int fd, int operation)
     }
     flock.l_whence = SEEK_SET;
     flock.l_start = flock.l_len = (Off_t)0;
+
     return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
 }
 
diff --git a/proto.h b/proto.h
index 841e32a..931997c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -814,7 +814,7 @@ PERL_CALLCONV U8*   Perl_utf16_to_utf8(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newle
 PERL_CALLCONV U8*      Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen);
 PERL_CALLCONV I32      Perl_utf8_distance(pTHX_ U8 *a, U8 *b);
 PERL_CALLCONV U8*      Perl_utf8_hop(pTHX_ U8 *s, I32 off);
-PERL_CALLCONV U8*      Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN len);
+PERL_CALLCONV U8*      Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len);
 PERL_CALLCONV U8*      Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len);
 PERL_CALLCONV UV       Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen);
 PERL_CALLCONV U8*      Perl_uv_to_utf8(pTHX_ U8 *d, UV uv);
diff --git a/sv.c b/sv.c
index a4e8bb1..7478456 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2209,7 +2209,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
         * --jhi Sep 1999 */
        if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
-       SvGROW(sv, NV_DIG + 10); /* sign, decimal separator, e+NNNNN, nul */
+       /* The +20 is pure guesswork.  Configure test needed. --jhi */ 
+       SvGROW(sv, NV_DIG + 20);
        s = SvPVX(sv);
        olderrno = errno;       /* some Xenix systems wipe out errno here */
 #ifdef apollo
index 021d699..e470f3a 100755 (executable)
@@ -6,6 +6,8 @@ print "1..14\n";
 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
 
 # Create our test datafile
+1 while unlink 'foo';                # in case junk left around
+rmdir 'foo';
 open TESTFILE, ">./foo" or die "error $! $^E opening";
 binmode TESTFILE;
 print TESTFILE $teststring;
index b8ae4e5..96b2c42 100755 (executable)
@@ -117,6 +117,11 @@ sub test_security {
   }
 
   # Explicitly 
+  if ( $< < File::Temp->top_system_uid() ){
+      skip("Skip Test inappropriate for root", 1);
+      eval q{ END { skip($skip,1); } 1; } || die;
+      return;
+  }
   my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
   if (defined $fname2) {
       print "# fname2 = $fname2\n";
index 52b20cd..b75bebf 100755 (executable)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..23\n";
+print "1..30\n";
 
 print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
 print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
@@ -48,3 +48,32 @@ print "not " if defined $x or $@ !~ /^Assigning to negative offset in vec/;
 print "ok 22\n";
 print "not " if vec('abcd', 7, 8);
 print "ok 23\n";
+
+# UTF8
+# N.B. currently curiously coded to circumvent bugs elswhere in UTF8 handling
+
+$foo = "\x{100}" . "\xff\xfe";
+$x = substr $foo, 1;
+print "not " if vec($x, 0, 8) != 255;
+print "ok 24\n";
+eval { vec($foo, 1, 8) };
+print "not " unless $@ =~ /^Character > 255 in vec\(\) /;
+print "ok 25\n";
+eval { vec($foo, 1, 8) = 13 };
+print "not " unless $@ =~ /^Character > 255 in vec\(\) /;
+print "ok 26\n";
+print "not " if $foo ne "\x{100}" . "\xff\xfe";
+print "ok 27\n";
+$x = substr $foo, 1;
+vec($x, 2, 4) = 7;
+print "not " if $x ne "\xff\xf7";
+print "ok 28\n";
+
+# mixed magic
+
+$foo = "\x61\x62\x63\x64\x65\x66";
+print "not " if vec(substr($foo, 2, 2), 0, 16) != 25444;
+print "ok 29\n";
+vec(substr($foo, 1,3), 5, 4) = 3;
+print "not " if $foo ne "\x61\x62\x63\x34\x65\x66";
+print "ok 30\n";
index c40c8b4..e0ab63e 100644 (file)
@@ -38,7 +38,7 @@ my $compare = join(',', qw(
 ));
 if ($^O eq 'VMS') {
     $compare = lc($compare);
-    $result = join(',', sort grep {pod::} values %pods);
+    $result = join(',', sort grep(/pod::/, values %pods));
     $result =~ s/$Qlib_dir/pod::/g;
     my $count = 0;
     my @result = split(/,/,$result);
index a8bb9e4..d13626b 100755 (executable)
@@ -935,5 +935,39 @@ unless ($aaa) {
   main::test $x, '0pq1';               # 209
 };
 
+# Test module-specific warning
+{
+    # check the Odd number of arguments for overload::constant warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a eq "") ; # 210
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+    # check the `$_[0]' is not an overloadable type warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a eq "") ; # 212
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+    # check the `$_[1]' is not a code reference warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = @_[0]} ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a eq "") ; # 214
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a =~ /^`1' is not a code reference at/); # 215
+}
+
 # Last test is:
-sub last {209}
+sub last {215}
diff --git a/toke.c b/toke.c
index 3fb35c3..eaf2a5f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5744,13 +5744,12 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     SAVETMPS;
     
     PUSHMARK(SP) ;
-    EXTEND(sp, 4);
+    EXTEND(sp, 3);
     if (pv)
        PUSHs(pv);
     PUSHs(sv);
     if (pv)
        PUSHs(typesv);
-    PUSHs(cv);
     PUTBACK;
     call_sv(cv, G_SCALAR | ( PL_in_eval ? 0 : G_EVAL));
     
diff --git a/utf8.c b/utf8.c
index 65dd2e4..495c695 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -204,7 +204,8 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen)
     return uv;
 }
 
-/* utf8_distance(a,b) is intended to be a - b in pointer arithmetic */
+/* utf8_distance(a,b) returns the number of UTF8 characters between
+   the pointers a and b                                                        */
 
 I32
 Perl_utf8_distance(pTHX_ U8 *a, U8 *b)
@@ -247,40 +248,46 @@ Perl_utf8_hop(pTHX_ U8 *s, I32 off)
 }
 
 /*
-=for apidoc Am|U8 *|utf8_to_bytes|U8 *s|STRLEN len
+=for apidoc Am|U8 *|utf8_to_bytes|U8 *s|STRLEN *len
 
-Converts a string C<s> of length C<len> from UTF8 into ASCII encoding.
-Unlike C<bytes_to_utf8>, this over-writes the original string.
-Returns zero on failure after converting as much as possible.
+Converts a string C<s> of length C<len> from UTF8 into byte encoding.
+Unlike C<bytes_to_utf8>, this over-writes the original string, and
+updates len to contain the new length.
+Returns zero on failure leaving the string and len unchanged
 
 =cut
 */
 
 U8 *
-Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN len)
+Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
 {
     dTHR;
     U8 *send;
     U8 *d;
     U8 *save;
 
-    send = s + len;
+    send = s + *len;
     d = save = s;
+
+    /* ensure valid UTF8 and chars < 256 before updating string */
+    while (s < send) {
+       U8 c = *s++;
+        if (c >= 0x80 &&
+           ( (s >= send) || ((*s++ & 0xc0) != 0x80) || ((c & 0xfe) != 0xc2)))
+           return 0;    
+    }
+    s = save;
     while (s < send) {
         if (*s < 0x80)
             *d++ = *s++;
         else {
             I32 ulen;
-            UV uv = utf8_to_uv(s, &ulen);
-            if (uv > 255) {
-                *d = '\0';
-                return 0;
-            }
+            *d++ = (U8)utf8_to_uv(s, &ulen);
             s += ulen;
-            *d++ = (U8)uv;
         }
     }
     *d = '\0';
+    *len = d - save;
     return save;
 }
 
index dc14c5f..d9ea5fa 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1,9 +1,12 @@
 /* vms.c
  *
  * VMS-specific routines for perl5
+ * Version: 5.7.0
  *
- * Last revised: 20-Aug-1999 by Charles Bailey  bailey@newman.upenn.edu
- * Version: 5.5.60
+ * August 2000 tweaks to vms_image_init, my_flush, my_fwrite, cando_by_name, 
+ *             and Perl_cando by Craig Berry
+ * 29-Aug-2000 Charles Lane's piping improvements rolled in
+ * 20-Aug-1999 revisions by Charles Bailey  bailey@newman.upenn.edu
  */
 
 #include <acedef.h>
@@ -4726,6 +4729,13 @@ my_flush(FILE *fp)
 #endif
            res = fsync(fileno(fp));
     }
+/*
+ * If the flush succeeded but set end-of-file, we need to clear
+ * the error because our caller may check ferror().  BTW, this 
+ * probably means we just flushed an empty file.
+ */
+    if (res == 0 && vaxc$errno == RMS$_EOF) clearerr(fp);
+
     return res;
 }
 /*}}}*/
@@ -5569,6 +5579,7 @@ is_null_device(name)
 bool
 Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
 {
+  char fname_phdev[NAM$C_MAXRSS+1];
   if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
   else {
     char fname[NAM$C_MAXRSS+1];
@@ -5587,7 +5598,15 @@ Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
                              &namdsc,&namdsc.dsc$w_length,0,0);
     if (retsts & 1) {
       fname[namdsc.dsc$w_length] = '\0';
-      return cando_by_name(bit,effective,fname);
+/* 
+ * lib$fid_to_name returns DVI$_LOGVOLNAM as the device part of the name,
+ * but if someone has redefined that logical, Perl gets very lost.  Since
+ * we have the physical device name from the stat buffer, just paste it on.
+ */
+      strcpy( fname_phdev, statbufp->st_devnam );
+      strcat( fname_phdev, strrchr(fname, ':') );
+
+      return cando_by_name(bit,effective,fname_phdev);
     }
     else if (retsts == SS$_NOSUCHDEV || retsts == SS$_NOSUCHFILE) {
       Perl_warn(aTHX_ "Can't get filespec - stale stat buffer?\n");
index 9f439a5..cdb8f81 100644 (file)
@@ -167,8 +167,12 @@ $d_pause='define'
 $d_phostname='undef'
 $d_pipe='define'
 $d_poll='define'
+$d_PRIeldbl='define'
 $d_PRIfldbl='define'
 $d_PRIgldbl='define'
+$d_PRIEUldbl='define'
+$d_PRIFUldbl='define'
+$d_PRIGUldbl='define'
 $d_pthread_yield='undef'
 $d_pwage='undef'
 $d_pwchange='undef'
index ecb8ae4..9454c79 100644 (file)
  *     This symbol, if defined, contains the string used by stdio to
  *     format long doubles (format 'g') for output.
  */
+/* PERL_PRIeldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'e') for output.
+ */
+/* PERL_SCNfldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'f') for input.
+ */
 #define PERL_PRIfldbl  "Lf"    /**/
 #define PERL_PRIgldbl  "Lg"    /**/
+#define PERL_PRIeldbl  $sPRIeldbl      /**/
+# PERL_SCNfldbl        $sSCNfldbl      /**/
 
 /* Off_t:
  *     This symbol holds the type used to declare offsets in the kernel.
index a9bb0ea..7c70ab3 100755 (executable)
@@ -2548,8 +2548,18 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *     This symbol, if defined, contains the string used by stdio to
  *     format long doubles (format 'g') for output.
  */
+/* PERL_PRIeldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'e') for output.
+ */
+/* PERL_SCNfldbl:
+ *     This symbol, if defined, contains the string used by stdio to
+ *     format long doubles (format 'f') for input.
+ */
 #$d_PRIfldbl PERL_PRIfldbl     $sPRIfldbl      /**/
 #$d_PRIgldbl PERL_PRIgldbl     $sPRIgldbl      /**/
+#$d_PRIeldbl PERL_PRIeldbl     $sPRIeldbl      /**/
+#$d_SCNfldbl PERL_SCNfldbl     $sSCNfldbl      /**/
 
 /* Off_t:
  *     This symbol holds the type used to declare offsets in the kernel.
index 172404b..3fe0c4d 100644 (file)
@@ -72,10 +72,10 @@ crosscompile='undef'
 cryptlib=''
 csh='undef'
 d_Gconvert='gcvt((x),(n),(b))'
-d_PRIEldbl='undef'
-d_PRIFldbl='undef'
-d_PRIGldbl='undef'
-d_PRIX64='undef'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
 d_PRId64='undef'
 d_PRIeldbl='undef'
 d_PRIfldbl='undef'
@@ -642,10 +642,10 @@ revision='5'
 rm='del'
 rmail=''
 runnm='true'
-sPRIEldbl='"E"'
-sPRIFldbl='"F"'
-sPRIGldbl='"G"'
-sPRIX64='"lX"'
+sPRIEUldbl='"E"'
+sPRIFUldbl='"F"'
+sPRIGUldbl='"G"'
+sPRIXU64='"lX"'
 sPRId64='"ld"'
 sPRIeldbl='"e"'
 sPRIfldbl='"f"'
index 498bb40..731ba39 100644 (file)
@@ -72,10 +72,10 @@ crosscompile='undef'
 cryptlib=''
 csh='undef'
 d_Gconvert='sprintf((b),"%.*g",(n),(x))'
-d_PRIEldbl='undef'
-d_PRIFldbl='undef'
-d_PRIGldbl='undef'
-d_PRIX64='undef'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
 d_PRId64='undef'
 d_PRIeldbl='undef'
 d_PRIfldbl='undef'
@@ -642,10 +642,10 @@ revision='5'
 rm='del'
 rmail=''
 runnm='true'
-sPRIEldbl='"E"'
-sPRIFldbl='"F"'
-sPRIGldbl='"G"'
-sPRIX64='"lX"'
+sPRIEUldbl='"E"'
+sPRIFUldbl='"F"'
+sPRIGUldbl='"G"'
+sPRIXU64='"lX"'
 sPRId64='"ld"'
 sPRIeldbl='"e"'
 sPRIfldbl='"f"'
index 0371234..1152d84 100644 (file)
@@ -72,10 +72,10 @@ crosscompile='undef'
 cryptlib=''
 csh='undef'
 d_Gconvert='sprintf((b),"%.*g",(n),(x))'
-d_PRIEldbl='undef'
-d_PRIFldbl='undef'
-d_PRIGldbl='undef'
-d_PRIX64='undef'
+d_PRIEUldbl='undef'
+d_PRIFUldbl='undef'
+d_PRIGUldbl='undef'
+d_PRIXU64='undef'
 d_PRId64='undef'
 d_PRIeldbl='undef'
 d_PRIfldbl='undef'
@@ -642,10 +642,10 @@ revision='5'
 rm='del'
 rmail=''
 runnm='true'
-sPRIEldbl='"E"'
-sPRIFldbl='"F"'
-sPRIGldbl='"G"'
-sPRIX64='"lX"'
+sPRIEUldbl='"E"'
+sPRIFUldbl='"F"'
+sPRIGUldbl='"G"'
+sPRIXU64='"lX"'
 sPRId64='"ld"'
 sPRIeldbl='"e"'
 sPRIfldbl='"f"'
index 687ffe0..9fc83c1 100644 (file)
@@ -3912,6 +3912,9 @@ XS(w32_GetShortPathName)
 
     shortpath = sv_mortalcopy(ST(0));
     SvUPGRADE(shortpath, SVt_PV);
+    if (!SvPVX(shortpath) || !SvLEN(shortpath))
+        XSRETURN_UNDEF;
+
     /* src == target is allowed */
     do {
        len = GetShortPathName(SvPVX(shortpath),
@@ -3941,6 +3944,9 @@ XS(w32_GetFullPathName)
     filename = ST(0);
     fullpath = sv_mortalcopy(filename);
     SvUPGRADE(fullpath, SVt_PV);
+    if (!SvPVX(fullpath) || !SvLEN(fullpath))
+        XSRETURN_UNDEF;
+
     do {
        len = GetFullPathName(SvPVX(filename),
                              SvLEN(fullpath),