# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Thu Apr 4 20:10:51 EET DST 2002 [metaconfig 3.0 PL70]
+# Generated on Fri Apr 5 20:56:35 EET DST 2002 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
;;
next*) osname=next ;;
nonstop-ux) osname=nonstopux ;;
+ openbsd) osname=openbsd
+ osvers="$3"
+ ;;
POSIX-BC | posix-bc ) osname=posix-bc
osvers="$3"
;;
HEADERS :
@echo . . . . making stdio.h and string.h
- @copy << stdio.h >\nul
+ @copy << stdio.h >\nwnul
/*
* (C) Copyright 2001-2002 Novell Inc. All rights reserved.
<<
@copy stdio.h $(COREDIR)
- @copy << string.h >\nul
+ @copy << string.h >\nwnul
/*
* (C) Copyright 2001-2002 Novell Inc. All rights reserved.
@copy string.h $(COREDIR)
-$(NLM_NAME): MESSAGE HEADERS $(BLDDIR)\nul $(NLM_OBJ) $(NEWTARE_OBJ_DEP) $(PERL_IO_OBJ_DEP) $(PERL_LIB_OBJ_DEP) $(DLL_OBJ) .XDC $(PERLIMPLIB) $(EXT_MAIN_OBJ)
+$(NLM_NAME): MESSAGE HEADERS $(BLDDIR)\nwnul $(NLM_OBJ) $(NEWTARE_OBJ_DEP) $(PERL_IO_OBJ_DEP) $(PERL_LIB_OBJ_DEP) $(DLL_OBJ) .XDC $(PERLIMPLIB) $(EXT_MAIN_OBJ)
@echo======= Linking $@ at $(MAKEDIR)\$(BLDDIR) =======
!ifdef WATCOM
@$(NLM_LINK) @<<$(BLDDIR)\$*.link
@echo======= Finished building $(BUILT).
# Create the debug\release directory if not existing
-$(BLDDIR)\nul:
+$(BLDDIR)\nwnul:
@echo . . . . mkdir $(BLDDIR)
@mkdir $(BLDDIR)
char sNUL[MAX_DN_BYTES] = {'\0'};
strcpy(sNUL, NWDEFPERLROOT);
- strcat(sNUL, "\\nul");
+ strcat(sNUL, "\\nwnul");
if (access((const char *)sNUL, 0) != 0)
{
// The file, "nul" is not found and so create the file.
char sNUL[MAX_DN_BYTES] = {'\0'};
strcpy(sNUL, NWDEFPERLROOT);
- strcat(sNUL, "\\nul");
+ strcat(sNUL, "\\nwnul");
if (access((const char *)sNUL, 0) == 0)
{
// The file, "nul" is found and so delete it.
pmode = va_arg(ap, int);
va_end(ap);
- if (stricmp(path, "/dev/null")==0)
- path = "NUL";
+ if (stricmp(path, "/dev/nul")==0)
+ path = "NWNUL";
return open(path, flag, pmode);
}
# else
# ifdef NETWARE
# define PERL_SYS_INIT(c,v) Perl_nw5_init(c,v)
-# define BIT_BUCKET "nul"
+# define BIT_BUCKET "nwnul"
# else
# define PERL_SYS_INIT(c,v)
# define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
/*
* newSV did not upgrade to SVt_PV so the scalar is undefined.
* To make it defined with an empty length, upgrade it now...
+ * Don't upgrade to a PV if the original type contains more
+ * information than a scalar.
*/
- sv_upgrade(sv, SVt_PV);
+ if (SvTYPE(sv) <= SVt_PV) {
+ sv_upgrade(sv, SVt_PV);
+ }
SvGROW(sv, 1);
*SvEND(sv) = '\0'; /* Ensure it's null terminated anyway */
TRACEME(("ok (retrieve_scalar empty at 0x%"UVxf")", PTR2UV(sv)));
use Storable qw(dclone);
-print "1..9\n";
+print "1..10\n";
$a = 'toto';
$b = \$a;
print "not " unless $$cloned{''}[0] == \$$cloned{a};
print "ok 9\n";
+# [ID 20020221.007] SEGV in Storable with empty string scalar object
+package TestString;
+sub new {
+ my ($type, $string) = @_;
+ return bless(\$string, $type);
+}
+package main;
+my $empty_string_obj = TestString->new('');
+my $clone = dclone($empty_string_obj);
+# If still here after the dclone the fix (#17543) worked.
+print ref $clone eq ref $empty_string_obj &&
+ $$clone eq $$empty_string_obj &&
+ $$clone eq '' ? "ok 10\n" : "not ok 10\n";
+
undef $o; untie @lines;
open F, "< $file" or die "Couldn't open file $file: $!";
+ binmode F;
my $actual;
{ local $/;
$actual = <F>;
sub checkorder {
my $aref = shift;
my $status = ''; # so far, so good
- my $i;
+ my ($i, $disorder);
for ($i = 0; $i < $#$aref; ++$i) {
- next if ($aref->[$i] lt $aref->[$i+1]);
- $status = (substr($aref->[$i], 0, $RootWidth) eq
- substr($aref->[$i+1], 0, $RootWidth)) ?
- "Instability" : "Disorder";
- $status .= " at element $i between $aref->[$i] and $aref->[$i+1]";
- last;
+ # Equality shouldn't happen, but catch it in the contents check
+ next if ($aref->[$i] le $aref->[$i+1]);
+ $disorder = (substr($aref->[$i], 0, $RootWidth) eq
+ substr($aref->[$i+1], 0, $RootWidth)) ?
+ "Instability" : "Disorder";
+ # Keep checking if merely unstable... disorder is much worse.
+ $status =
+ "$disorder at element $i between $aref->[$i] and $aref->[$i+1]";
+ last unless ($disorder eq "Instability");
}
return $status;
}
$status = checkequal(\@sorted, $unsorted);
is($status, '', "contents ok for size $ts");
}
+ # P5P: The following test (#58) has been observed failing on
+ # a solaris 2.8 platform. Failure doesn't mean that sort is
+ # misbehaving, it is just exhibiting an exceedingly unlikely
+ # pattern of breaking ties. If you see no other failures,
+ # it should be perfectly safe to install.
if ($expect_unstable) {
ok($unstable_num > 0, 'Instability ok');
}
use sort 'stable';
@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
- # force use of quicksort (not portable outside Perl 5.8)
- use sort '_quicksort'; # note discouraging _
+ # force use of mergesort (not portable outside Perl 5.8)
+ use sort '_mergesort'; # note discouraging _
@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
- # similar to the previous example, but demand stability as well
- use sort qw( _mergesort stable );
+ # Similar to the previous example, but demand stability as well
+ # Because of the way quicksort is "stabilized", this combination
+ # is not threadsafe
+ use sort qw( _quicksort stable );
@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
If you're using strict, you I<must not> declare $a
projects / p5sagit/p5-mst-13.2.git / commitdiff