Front page | perl.perl5.changes |
Postings from May 2008
Change 33972: Integrate:
From:
Dave Mitchell
Date:
May 31, 2008 16:45
Subject:
Change 33972: Integrate:
Change 33972 by davem@davem-pigeon on 2008/05/31 23:40:24
Integrate:
[ 32851]
Make Perl_pregcomp() use SvUTF8() of the pattern, rather than the flag
bit in pmflags, to decide whether the pattern is UTF-8.
[ 32894]
Don't set the public IV or NV flags if the string converted from has
trailing garbage. This behaviour is consistent with not setting the
public IV or NV flags if the value is out of range for the type.
[ 32953] (the Configure parts were integrated earlier)
Subject: [PATCH] Add dtrace support
From: Andy Armstrong <andy@hexten.net>
Message-Id: <F4AC553F-7C7F-49C3-98C2-E04681E1004F@hexten.net>
Date: Thu, 10 Jan 2008 22:20:52 +0000
with fixups as discussed on list, plus adding usedtrace to Glossary,
plus propagating all the new config variables everywhere.
(Was there an automatic way to do that? I did it with emacs macros)
[ 32978]
Subject: consting IO.xs
From: "Robin Barker" <Robin.Barker@npl.co.uk>
Date: Sat, 22 Dec 2007 00:56:18 -0000
Message-ID: <46A0F33545E63740BC7563DE59CA9C6D0939A1@exchsvr2.npl.ad.local>
[ 33747]
Subject: [PATCH] update Pod-Perldoc to version 3.14_04
From: "Adriano Ferreira" <a.r.ferreira@gmail.com>
Date: Wed, 23 Apr 2008 09:45:35 -0300
Message-ID: <73ddeb6c0804230545v75fee05dmeb849636addb14e1@mail.gmail.com>
[ 33807]
Fix [perl #52740] crash when localizing a symtab entry
[ 33956]
Add conditional code to initialise RETVAL, to avoid compiler warnings.
(There was never an error, as croak() was called before the return).
[ 33971]
Must install mydtrace.h on VMS even it doesn't do much there.
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#38 integrate
... //depot/maint-5.10/perl/Makefile.SH#7 integrate
... //depot/maint-5.10/perl/cop.h#6 integrate
... //depot/maint-5.10/perl/ext/IO/IO.xs#2 integrate
... //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#5 integrate
... //depot/maint-5.10/perl/lib/Pod/Perldoc.pm#2 integrate
... //depot/maint-5.10/perl/mydtrace.h#1 branch
... //depot/maint-5.10/perl/op.c#14 integrate
... //depot/maint-5.10/perl/perl.c#14 integrate
... //depot/maint-5.10/perl/perldtrace.d#1 branch
... //depot/maint-5.10/perl/pp_ctl.c#16 integrate
... //depot/maint-5.10/perl/regcomp.c#15 integrate
... //depot/maint-5.10/perl/regexec.c#9 integrate
... //depot/maint-5.10/perl/sv.c#20 integrate
... //depot/maint-5.10/perl/vms/descrip_mms.template#4 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#38 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#37~33970~ 2008-05-31 09:19:43.000000000 -0700
+++ perl/MANIFEST 2008-05-31 16:40:24.000000000 -0700
@@ -3032,6 +3032,7 @@
mpeix/relink MPE/iX port
mro.c Method Resolution Order code
myconfig.SH Prints summary of the current configuration
+mydtrace.h Support for optional DTrace probes
NetWare/bat/Buildtype.bat NetWare port
NetWare/bat/SetCodeWar.bat NetWare port
NetWare/bat/Setnlmsdk.bat NetWare port
@@ -3162,6 +3163,7 @@
patchlevel.h The current patch level of perl
perlapi.c Perl API functions
perlapi.h Perl API function declarations
+perldtrace.d D script for Perl probes
perl.c main()
perl.h Global declarations
perlio.c C code for PerlIO abstraction
==== //depot/maint-5.10/perl/Makefile.SH#7 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#6~33945~ 2008-05-28 13:51:40.000000000 -0700
+++ perl/Makefile.SH 2008-05-31 16:40:24.000000000 -0700
@@ -183,6 +183,16 @@
nonxs_list="$nonxs_list ext/$f/pm_to_blib"
done
+dtrace_h=''
+dtrace_o=''
+case "$usedtrace" in
+define|true)
+ dtrace_h='perldtrace.h'
+ $dtrace -G -s perldtrace.d -o perldtrace.tmp >/dev/null 2>&1 \
+ && rm -f perldtrace.tmp && dtrace_o='perldtrace$(OBJ_EXT)'
+ ;;
+esac
+
echo "Extracting Makefile (with variable substitutions)"
$spitshell >Makefile <<!GROK!THIS!
# Makefile.SH
@@ -274,6 +284,10 @@
# then you'll need to change this, or override it on the make command line.
VALGRIND=valgrind
+DTRACE = $dtrace
+DTRACE_H = $dtrace_h
+DTRACE_O = $dtrace_o
+
FIRSTMAKEFILE = $firstmakefile
# Any special object files needed by this architecture, e.g. os2/os2.obj
@@ -357,7 +371,7 @@
h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h opcode.h
h3 = pad.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h
h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
-h5 = utf8.h warnings.h
+h5 = utf8.h warnings.h mydtrace.h
h = $(h1) $(h2) $(h3) $(h4) $(h5)
c1 = av.c scope.c op.c doop.c doio.c dump.c gv.c hv.c mg.c reentr.c mro.c perl.c
@@ -372,7 +386,8 @@
obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) perl$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT)
-obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
+ndt_obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
+obj = $(ndt_obj) $(DTRACE_O)
lintflags = \
-b \
@@ -595,6 +610,26 @@
Makefile: $Makefile_s
!GROK!THIS!
else
+ case "$dtrace_h" in
+ ?*)
+ $spitshell >>Makefile <<'!NO!SUBS!'
+$(DTRACE_H): perldtrace.d
+ $(DTRACE) -h -s perldtrace.d -o $(DTRACE_H)
+
+mydtrace.h: $(DTRACE_H)
+
+!NO!SUBS!
+ ;;
+ esac
+ case "$dtrace_o" in
+ ?*)
+ $spitshell >>Makefile <<'!NO!SUBS!'
+$(DTRACE_O): perldtrace.d
+ $(DTRACE) -G -s perldtrace.d -o $(DTRACE_O) $(ndt_obj)
+
+!NO!SUBS!
+ ;;
+ esac
$spitshell >>Makefile <<'!NO!SUBS!'
$(LIBPERL): $& $(obj) $(DYNALOADER) $(LIBPERLEXPORT)
!NO!SUBS!
@@ -1088,7 +1123,7 @@
-rm -f cygwin.c libperl*.def libperl*.dll cygperl*.dll *.exe.stackdump
-rm -f perl$(EXE_EXT) suidperl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl
-rm -f opcode.h-old opnames.h-old pp.sym-old pp_proto.h-old
- -rm -f config.arch config.over
+ -rm -f config.arch config.over $(DTRACE_H)
# Do not 'make _tidy' directly.
_tidy:
==== //depot/maint-5.10/perl/cop.h#6 (text) ====
Index: perl/cop.h
--- perl/cop.h#5~33856~ 2008-05-18 09:11:18.000000000 -0700
+++ perl/cop.h 2008-05-31 16:40:24.000000000 -0700
@@ -132,6 +132,7 @@
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+#include "mydtrace.h"
struct cop {
BASEOP
@@ -295,6 +296,10 @@
* decremented by LEAVESUB, the other by LEAVE. */
#define PUSHSUB_BASE(cx) \
+ ENTRY_PROBE(GvENAME(CvGV(cv)), \
+ CopFILE((COP*)CvSTART(cv)), \
+ CopLINE((COP*)CvSTART(cv))); \
+ \
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
cx->blk_sub.hasargs = hasargs; \
@@ -342,6 +347,10 @@
#define POPSUB(cx,sv) \
STMT_START { \
+ RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)), \
+ CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)), \
+ CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv))); \
+ \
if (CxHASARGS(cx)) { \
POP_SAVEARRAY(); \
/* abandon @_ if it got reified */ \
==== //depot/maint-5.10/perl/ext/IO/IO.xs#2 (text) ====
Index: perl/ext/IO/IO.xs
--- perl/ext/IO/IO.xs#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/IO/IO.xs 2008-05-31 16:40:24.000000000 -0700
@@ -205,7 +205,7 @@
void
new_tmpfile(packname = "IO::File")
- char * packname
+ const char * packname
PREINIT:
OutputStream fp;
GV *gv;
==== //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#5 (text) ====
Index: perl/ext/POSIX/POSIX.xs
--- perl/ext/POSIX/POSIX.xs#4~33955~ 2008-05-30 18:54:46.000000000 -0700
+++ perl/ext/POSIX/POSIX.xs 2008-05-31 16:40:24.000000000 -0700
@@ -656,6 +656,11 @@
POSIX::WSTOPSIG = 4
POSIX::WTERMSIG = 5
CODE:
+#if !(defined(WEXITSTATUS) || defined(WIFEXITED) || defined(WIFSIGNALED) \
+ || defined(WIFSTOPPED) || defined(WSTOPSIG) || defined (WTERMSIG))
+ RETVAL = 0; /* Silence compilers that notice this, but don't realise
+ that not_here() can't return. */
+#endif
switch(ix) {
case 0:
#ifdef WEXITSTATUS
==== //depot/maint-5.10/perl/lib/Pod/Perldoc.pm#2 (text) ====
Index: perl/lib/Pod/Perldoc.pm
--- perl/lib/Pod/Perldoc.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Pod/Perldoc.pm 2008-05-31 16:40:24.000000000 -0700
@@ -12,7 +12,7 @@
use vars qw($VERSION @Pagers $Bindir $Pod2man
$Temp_Files_Created $Temp_File_Lifetime
);
-$VERSION = '3.14_02';
+$VERSION = '3.14_04';
#..........................................................................
BEGIN { # Make a DEBUG constant very first thing...
@@ -824,17 +824,20 @@
#.........................................................................
-sub pod_dirs { # @dirs = pod_dirs($translator);
- my $tr = shift;
- return $tr->pod_dirs if $tr->can('pod_dirs');
-
- my $mod = ref $tr || $tr;
- $mod =~ s|::|/|g;
- $mod .= '.pm';
-
- my $dir = $INC{$mod};
- $dir =~ s/\.pm\z//;
- return $dir;
+sub new_translator { # $tr = $self->new_translator($lang);
+ my $self = shift;
+ my $lang = shift;
+
+ my $pack = 'POD2::' . uc($lang);
+ eval "require $pack";
+ if ( !$@ && $pack->can('new') ) {
+ return $pack->new();
+ }
+
+ eval { require POD2::Base };
+ return if $@;
+
+ return POD2::Base->new({ lang => $lang });
}
#.........................................................................
@@ -842,15 +845,17 @@
sub add_translator { # $self->add_translator($lang);
my $self = shift;
for my $lang (@_) {
- my $pack = 'POD2::' . uc($lang);
- eval "require $pack";
- if ( $@ ) {
- # XXX warn: non-installed translator package
+ my $tr = $self->new_translator($lang);
+ if ( defined $tr ) {
+ push @{ $self->{'translators'} }, $tr;
+ push @{ $self->{'extra_search_dirs'} }, $tr->pod_dirs;
+
+ $self->aside( "translator for '$lang' loaded\n" );
} else {
- push @{ $self->{'translators'} }, $pack;
- push @{ $self->{'extra_search_dirs'} }, pod_dirs($pack);
- # XXX DEBUG
+ # non-installed or bad translator package
+ warn "Perldoc cannot load translator package for '$lang': ignored\n";
}
+
}
return;
}
@@ -1456,13 +1461,13 @@
# Does this look like a module or extension directory?
- if (-f "Makefile.PL") {
+ if (-f "Makefile.PL" || -f "Build.PL") {
# Add "." and "lib" to @INC (if they exist)
eval q{ use lib qw(. lib); 1; } or die;
# don't add if superuser
- if ($< && $> && -f "blib") { # don't be looking too hard now!
+ if ($< && $> && -d "blib") { # don't be looking too hard now!
eval q{ use blib; 1 };
warn $@ if $@ && $self->opt_v;
}
==== //depot/maint-5.10/perl/mydtrace.h#1 (text) ====
Index: perl/mydtrace.h
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/mydtrace.h 2008-05-31 16:40:24.000000000 -0700
@@ -0,0 +1,42 @@
+/* mydtrace.h
+ *
+ * Copyright (C) 2008, by Larry Wall and others
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ * Provides macros that wrap the various DTrace probes we use. We add
+ * an extra level of wrapping to encapsulate the _ENABLED tests.
+ */
+
+#if defined(USE_DTRACE) && defined(PERL_CORE)
+
+# include "perldtrace.h"
+
+# define ENTRY_PROBE(func, file, line) \
+ if (PERL_SUB_ENTRY_ENABLED()) { \
+ PERL_SUB_ENTRY(func, file, line); \
+ }
+
+# define RETURN_PROBE(func, file, line) \
+ if (PERL_SUB_RETURN_ENABLED()) { \
+ PERL_SUB_RETURN(func, file, line); \
+ }
+
+#else
+
+/* NOPs */
+# define ENTRY_PROBE(func, file, line)
+# define RETURN_PROBE(func, file, line)
+
+#endif
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
==== //depot/maint-5.10/perl/op.c#14 (text) ====
Index: perl/op.c
--- perl/op.c#13~33947~ 2008-05-28 18:09:23.000000000 -0700
+++ perl/op.c 2008-05-31 16:40:24.000000000 -0700
@@ -3452,14 +3452,24 @@
pm = (PMOP*)o;
if (expr->op_type == OP_CONST) {
- SV * const pat = ((SVOP*)expr)->op_sv;
+ SV *pat = ((SVOP*)expr)->op_sv;
U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
if (o->op_flags & OPf_SPECIAL)
pm_flags |= RXf_SPLIT;
- if (DO_UTF8(pat))
- pm_flags |= RXf_UTF8;
+ if (DO_UTF8(pat)) {
+ assert (SvUTF8(pat));
+ } else if (SvUTF8(pat)) {
+ /* Not doing UTF-8, despite what the SV says. Is this only if we're
+ trapped in use 'bytes'? */
+ /* Make a copy of the octet sequence, but without the flag on, as
+ the compiler now honours the SvUTF8 flag on pat. */
+ STRLEN len;
+ const char *const p = SvPV(pat, len);
+ pat = newSVpvn_flags(p, len, SVs_TEMP);
+ }
+ assert(!(pm_flags & RXf_UTF8));
PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
==== //depot/maint-5.10/perl/perl.c#14 (text) ====
Index: perl/perl.c
--- perl/perl.c#13~33947~ 2008-05-28 18:09:23.000000000 -0700
+++ perl/perl.c 2008-05-31 16:40:24.000000000 -0700
@@ -306,9 +306,13 @@
sv_setpv(&PL_sv_no,PL_No);
/* value lookup in void context - happens to have the side effect
- of caching the numeric forms. */
+ of caching the numeric forms. However, as &PL_sv_no doesn't contain
+ a string that is a valid numer, we have to turn the public flags by
+ hand: */
SvNV(&PL_sv_no);
SvIV(&PL_sv_no);
+ SvIOK_on(&PL_sv_no);
+ SvNOK_on(&PL_sv_no);
SvREADONLY_on(&PL_sv_no);
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
==== //depot/maint-5.10/perl/perldtrace.d#1 (text) ====
Index: perl/perldtrace.d
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/perldtrace.d 2008-05-31 16:40:24.000000000 -0700
@@ -0,0 +1,9 @@
+/*
+ * Written by Alan Burlinson -- taken from his blog post
+ * at <http://blogs.sun.com/alanbur/date/20050909>.
+ */
+
+provider perl {
+ probe sub__entry(char *, char *, int);
+ probe sub__return(char *, char *, int);
+};
==== //depot/maint-5.10/perl/pp_ctl.c#16 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#15~33946~ 2008-05-28 16:09:01.000000000 -0700
+++ perl/pp_ctl.c 2008-05-31 16:40:24.000000000 -0700
@@ -149,8 +149,18 @@
if (PL_op->op_flags & OPf_SPECIAL)
PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
- if (DO_UTF8(tmpstr))
- pm_flags |= RXf_UTF8;
+ if (DO_UTF8(tmpstr)) {
+ assert (SvUTF8(tmpstr));
+ } else if (SvUTF8(tmpstr)) {
+ /* Not doing UTF-8, despite what the SV says. Is this only if
+ we're trapped in use 'bytes'? */
+ /* Make a copy of the octet sequence, but without the flag on,
+ as the compiler now honours the SvUTF8 flag on tmpstr. */
+ STRLEN len;
+ const char *const p = SvPV(tmpstr, len);
+ tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
+ }
+ assert(!(pm_flags & RXf_UTF8));
if (eng)
PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
==== //depot/maint-5.10/perl/regcomp.c#15 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#14~33947~ 2008-05-28 18:09:23.000000000 -0700
+++ perl/regcomp.c 2008-05-31 16:40:24.000000000 -0700
@@ -4149,7 +4149,7 @@
#endif
REGEXP *
-Perl_re_compile(pTHX_ const SV * const pattern, const U32 pm_flags)
+Perl_re_compile(pTHX_ const SV * const pattern, U32 pm_flags)
{
dVAR;
register REGEXP *r;
@@ -4172,7 +4172,10 @@
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_r(if (!PL_colorset) reginitcolors());
- RExC_utf8 = RExC_orig_utf8 = pm_flags & RXf_UTF8;
+ RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
+ assert(!(pm_flags & RXf_UTF8));
+ if (RExC_utf8)
+ pm_flags |= RXf_UTF8;
DEBUG_COMPILE_r({
SV *dsv= sv_newmortal();
==== //depot/maint-5.10/perl/regexec.c#9 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#8~33855~ 2008-05-18 07:30:48.000000000 -0700
+++ perl/regexec.c 2008-05-31 16:40:24.000000000 -0700
@@ -3735,7 +3735,19 @@
U32 pm_flags = 0;
const I32 osize = PL_regsize;
- if (DO_UTF8(ret)) pm_flags |= RXf_UTF8;
+ if (DO_UTF8(ret)) {
+ assert (SvUTF8(ret));
+ } else if (SvUTF8(ret)) {
+ /* Not doing UTF-8, despite what the SV says. Is
+ this only if we're trapped in use 'bytes'? */
+ /* Make a copy of the octet sequence, but without
+ the flag on, as the compiler now honours the
+ SvUTF8 flag on ret. */
+ STRLEN len;
+ const char *const p = SvPV(ret, len);
+ ret = newSVpvn_flags(p, len, SVs_TEMP);
+ }
+ assert(!(pm_flags & RXf_UTF8));
re = CALLREGCOMP(ret, pm_flags);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY
==== //depot/maint-5.10/perl/sv.c#20 (text) ====
Index: perl/sv.c
--- perl/sv.c#19~33955~ 2008-05-30 18:54:46.000000000 -0700
+++ perl/sv.c 2008-05-31 16:40:24.000000000 -0700
@@ -1931,7 +1931,11 @@
we're outside the range of NV integer precision */
#endif
) {
- SvIOK_on(sv); /* Can this go wrong with rounding? NWC */
+ if (SvNOK(sv))
+ SvIOK_on(sv); /* Can this go wrong with rounding? NWC */
+ else {
+ /* scalar has trailing garbage, eg "42a" */
+ }
DEBUG_c(PerlIO_printf(Perl_debug_log,
"0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
PTR2UV(sv),
@@ -1970,6 +1974,7 @@
came from a (by definition imprecise) NV operation, and
we're outside the range of NV integer precision */
#endif
+ && SvNOK(sv)
)
SvIOK_on(sv);
SvIsUV_on(sv);
@@ -2131,6 +2136,12 @@
}
}
#endif /* NV_PRESERVES_UV */
+ /* It might be more code efficient to go through the entire logic above
+ and conditionally set with SvIOKp_on() rather than SvIOK(), but it
+ gets complex and potentially buggy, so more programmer efficient
+ to do it this way, by turning off the public flags: */
+ if (!numtype)
+ SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
}
}
else {
@@ -2399,11 +2410,15 @@
if (SvIOKp(sv)) {
SvNV_set(sv, SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv));
#ifdef NV_PRESERVES_UV
- SvNOK_on(sv);
+ if (SvIOK(sv))
+ SvNOK_on(sv);
+ else
+ SvNOKp_on(sv);
#else
/* Only set the public NV OK flag if this NV preserves the IV */
/* Check it's not 0xFFFFFFFFFFFFFFFF */
- if (SvIsUV(sv) ? ((SvUVX(sv) != UV_MAX)&&(SvUVX(sv) == U_V(SvNVX(sv))))
+ if (SvIOK(sv) &&
+ SvIsUV(sv) ? ((SvUVX(sv) != UV_MAX)&&(SvUVX(sv) == U_V(SvNVX(sv))))
: (SvIVX(sv) == I_V(SvNVX(sv))))
SvNOK_on(sv);
else
@@ -2422,7 +2437,10 @@
SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -(NV)value : (NV)value);
} else
SvNV_set(sv, Atof(SvPVX_const(sv)));
- SvNOK_on(sv);
+ if (numtype)
+ SvNOK_on(sv);
+ else
+ SvNOKp_on(sv);
#else
SvNV_set(sv, Atof(SvPVX_const(sv)));
/* Only set the public NV OK flag if this NV preserves the value in
@@ -2489,6 +2507,12 @@
}
}
}
+ /* It might be more code efficient to go through the entire logic above
+ and conditionally set with SvNOKp_on() rather than SvNOK(), but it
+ gets complex and potentially buggy, so more programmer efficient
+ to do it this way, by turning off the public flags: */
+ if (!numtype)
+ SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
#endif /* NV_PRESERVES_UV */
}
else {
@@ -3577,8 +3601,10 @@
GvMULTI_on(dstr);
return;
}
- glob_assign_glob(dstr, sstr, dtype);
- return;
+ if (isGV_with_GP(sstr)) {
+ glob_assign_glob(dstr, sstr, dtype);
+ return;
+ }
}
if (dtype >= SVt_PV) {
==== //depot/maint-5.10/perl/vms/descrip_mms.template#4 (text) ====
Index: perl/vms/descrip_mms.template
--- perl/vms/descrip_mms.template#3~33894~ 2008-05-20 16:39:57.000000000 -0700
+++ perl/vms/descrip_mms.template 2008-05-31 16:40:24.000000000 -0700
@@ -293,7 +293,7 @@
h0 = av.h cc_runtime.h config.h cop.h cv.h embed.h embedvar.h
h1 = EXTERN.h form.h gv.h handy.h hv.h INTERN.h intrpvar.h
-h2 = iperlsys.h keywords.h mg.h nostdio.h op.h opcode.h opnames.h overload.h pad.h
+h2 = iperlsys.h keywords.h mydtrace.h mg.h nostdio.h op.h opcode.h opnames.h overload.h pad.h
h3 = parser.h patchlevel.h perl.h perlapi.h perlio.h perlsdio.h perlvars.h perly.h
h4 = pp.h pp_proto.h proto.h regcomp.h regexp.h regnodes.h scope.h
h5 = sv.h thread.h utf8.h util.h vmsish.h warnings.h
@@ -305,7 +305,7 @@
ac2 = $(ARCHCORE)embedvar.h $(ARCHCORE)EXTERN.h $(ARCHCORE)fakethr.h
ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
ac4 = $(ARCHCORE)INTERN.h $(ARCHCORE)intrpvar.h $(ARCHCORE)iperlsys.h
-ac5 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)nostdio.h
+ac5 = $(ARCHCORE)keywords.h $(ARCHCORE)mydtrace.h $(ARCHCORE)mg.h $(ARCHCORE)nostdio.h
ac6 = $(ARCHCORE)op.h $(ARCHCORE)opcode.h $(ARCHCORE)opnames.h $(ARCHCORE)overload.h
ac7 = $(ARCHCORE)pad.h $(ARCHCORE)parser.h $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h
ac8 = $(ARCHCORE)perlapi.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h
@@ -1515,6 +1515,9 @@
$(ARCHCORE)keywords.h : keywords.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE)
+$(ARCHCORE)mydtrace.h : mydtrace.h
+ @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE)
$(ARCHCORE)mg.h : mg.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/NoConfirm/Log $(MMS$SOURCE) $(ARCHCORE)
End of Patch.
-
Change 33972: Integrate:
by Dave Mitchell