[patch: perl@8211]VMS: add -Duseperlio capacity to configure.com
[p5sagit/p5-mst-13.2.git] / t / op / misc.t
index 6ffc04c..0db36c9 100755 (executable)
@@ -4,7 +4,7 @@
 # separate executable and can't simply use eval.
 
 chdir 't' if -d 't';
-unshift @INC, "../lib";
+@INC = '../lib';
 $ENV{PERL5LIB} = "../lib";
 
 $|=1;
@@ -60,10 +60,11 @@ EXPECT
 a := b := c
 ########
 $cusp = ~0 ^ (~0 >> 1);
+use integer;
 $, = " ";
-print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
+print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n";
 EXPECT
-7 0 0 1 !
+7 0 0 8 !
 ########
 $foo=undef; $foo->go;
 EXPECT
@@ -345,7 +346,7 @@ print "you die joe!\n" unless "@x" eq 'x y z';
 /(?{"{"})/     # Check it outside of eval too
 EXPECT
 Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
-/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
+Sequence (?{...}) not terminated or not {}-balanced before HERE mark in regex m/(?{ << HERE "{"})/ at - line 1.
 ########
 /(?{"{"}})/    # Check it outside of eval too
 EXPECT
@@ -370,8 +371,8 @@ argv <e>
 # fdopen from a system descriptor to a system descriptor used to close
 # the former.
 open STDERR, '>&=STDOUT' or die $!;
-select STDOUT; $| = 1; print fileno STDOUT;
-select STDERR; $| = 1; print fileno STDERR;
+select STDOUT; $| = 1; print fileno STDOUT or die $!;
+select STDERR; $| = 1; print fileno STDERR or die $!;
 EXPECT
 1
 2
@@ -481,7 +482,7 @@ new1new22DESTROY2new33DESTROY31DESTROY1
 ########
 re();
 sub re {
-    my $re = join '', eval 'qr/(?p{ $obj->method })/';
+    my $re = join '', eval 'qr/(??{ $obj->method })/';
     $re;
 }
 EXPECT
@@ -507,3 +508,95 @@ else {
 }
 EXPECT
 Use of uninitialized value in numeric eq (==) at - line 4.
+########
+$x = sub {};
+foo();
+sub foo { eval { return }; }
+print "ok\n";
+EXPECT
+ok
+########
+my @l = qw(hello.* world);
+my $x;
+
+foreach $x (@l) {
+    print "before - $x\n";
+    $x = "\Q$x\E";
+    print "quotemeta - $x\n";
+    $x = "\u$x";
+    print "ucfirst - $x\n";
+    $x = "\l$x";
+    print "lcfirst - $x\n";
+    $x = "\U$x\E";
+    print "uc - $x\n";
+    $x = "\L$x\E";
+    print "lc - $x\n";
+}
+EXPECT
+before - hello.*
+quotemeta - hello\.\*
+ucfirst - Hello\.\*
+lcfirst - hello\.\*
+uc - HELLO\.\*
+lc - hello\.\*
+before - world
+quotemeta - world
+ucfirst - World
+lcfirst - world
+uc - WORLD
+lc - world
+########
+sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
+my $x = "foo";
+{ f } continue { print $x, "\n" }
+EXPECT
+foo
+########
+sub C () { 1 }
+sub M { $_[0] = 2; }
+eval "C";
+M(C);
+EXPECT
+Modification of a read-only value attempted at - line 2.
+########
+print qw(ab a\b a\\b);
+EXPECT
+aba\ba\b
+########
+# This test is here instead of pragma/locale.t because
+# the bug depends on in the internal state of the locale
+# settings and pragma/locale messes up that state pretty badly.
+# We need a "fresh run".
+use Config;
+my $have_setlocale = $Config{d_setlocale} eq 'define';
+eval {
+    require POSIX;
+};
+$have_setlocale = 0 if $@;
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
+exit(0) unless $have_setlocale;
+my @locales;
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a|")) {
+    while(<LOCALES>) {
+        chomp;
+        push(@locales, $_);
+    }
+    close(LOCALES);
+}
+exit(0) unless @locales;
+for (@locales) {
+    use POSIX qw(locale_h);
+    use locale;
+    setlocale(LC_NUMERIC, $_) or next;
+    my $s = sprintf "%g %g", 3.1, 3.1;
+    next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
+    print "$_ $s\n";
+}
+EXPECT
+########
+die qr(x)
+EXPECT
+(?-xism:x) at - line 1.
+########