Integrate mainline

p4raw-id: //depot/vmsperl@5311

2 files changed, 58 insertions, 7 deletions

diff --git a/t/lib/fields.t b/t/lib/fields.t
index 01f93892b0..310967fcbe 100755
--- a/t/lib/fields.t
+++ b/t/lib/fields.t
@@ -66,8 +66,7 @@ use fields qw(b1 d1 _b1 _d1);  # hide b1
 
 package main;
 
-sub fstr
-{
+sub fstr {
    my $h = shift;
    my @tmp;
    for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
@@ -90,7 +89,7 @@ my %expect = (
     'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
 );
 
-print "1..", int(keys %expect)+7, "\n";
+print "1..", int(keys %expect)+13, "\n";
 my $testno = 0;
 while (my($class, $exp) = each %expect) {
    no strict 'refs';
@@ -125,9 +124,25 @@ print "ok ", ++$testno, "\n";
 print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
 print "ok ", ++$testno, "\n";
 
+my $ph = fields::phash(a => 1, b => 2, c => 3);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1, 2, 3]);
+print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+print "ok ", ++$testno, "\n";
+
+$ph = fields::phash([qw/a b c/], [1]);
+print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
+print "ok ", ++$testno, "\n";
+
+eval '$ph = fields::phash("odd")';
+print "not " unless $@ && $@ =~ /^Odd number of/;
+print "ok ", ++$testno, "\n";
+
 #fields::_dump();
 
-# check if 
+# check if fields autovivify
 {
     package Foo;
     use fields qw(foo bar);
@@ -140,3 +155,17 @@ print "ok ", ++$testno, "\n";
     print $a->{foo}[1], "\n";
     print $a->{bar}->{A}, "\n";
 }
+
+# check if fields autovivify
+{
+    package Bar;
+    use fields qw(foo bar);
+    sub new { return fields::new($_[0]) }
+
+    package main;
+    my Bar $a = Bar::->new();
+    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+    $a->{bar} = { A => 'ok ' . ++$testno };
+    print $a->{foo}[1], "\n";
+    print $a->{bar}->{A}, "\n";
+}
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 76426787ca..6265ccef1f 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -34,7 +34,7 @@ eval {
 # and mingw32 uses said silly CRT
 $have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
 
-print "1..", ($have_setlocale ? 115 : 98), "\n";
+print "1..", ($have_setlocale ? 116 : 98), "\n";
 
 use vars qw(&LC_ALL);
 
@@ -388,6 +388,7 @@ my %Problem;
 my %Okay;
 my %Testing;
 my @Neoalpha;
+my %Neoalpha;
 
 sub tryneoalpha {
     my ($Locale, $i, $test) = @_;
@@ -451,6 +452,7 @@ foreach $Locale (@Locale) {
 	@Neoalpha = ();
 	for (keys %UPPER, keys %lower) {
 	    push(@Neoalpha, $_) if (/\W/);
+	    $Neoalpha{$_} = $_;
 	}
     }
 
@@ -642,11 +644,31 @@ foreach $Locale (@Locale) {
 		    lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
 		    lcA($x, $z) == 0 && lcB($x, $z) == 0);
     }
+
+    debug "# testing 116 with locale '$Locale'\n";
+    {
+	use locale;
+
+	my @f = ();
+	foreach my $x (keys %UPPER) {
+	    my $y = lc $x;
+	    next unless uc $y eq $x;
+	    push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+	}
+	foreach my $x (keys %lower) {
+	    my $y = uc $x;
+	    next unless lc $y eq $x;
+	    push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+	}
+	tryneoalpha($Locale, 116, @f == 0);
+	print "# testing 116 failed for locale '$Locale' for characters @f\n"
+            if @f;
+    }
 }
 
 # Recount the errors.
 
-foreach (99..115) {
+foreach (99..116) {
     if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
 	if ($_ == 102) {
 	    print "# The failure of test 102 is not necessarily fatal.\n";
@@ -662,7 +684,7 @@ foreach (99..115) {
 
 my $didwarn = 0;
 
-foreach (99..115) {
+foreach (99..116) {
     if ($Problem{$_}) {
 	my @f = sort keys %{ $Problem{$_} };
 	my $f = join(" ", @f);