From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 20 May 2009 13:17:11 +0000 (+0200)
Subject: Convert t/op/magic.t to use test.pl
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b2978f4e665fcbbc23bf7f986d2650556cfec504;p=p5sagit%2Fp5-mst-13.2.git

Convert t/op/magic.t to use test.pl
---

diff --git a/t/op/magic.t b/t/op/magic.t
index 28e0dcc..f8d0e24 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -5,38 +5,14 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
+    require './test.pl';
 }
 
 use warnings;
 use Config;
 
-my $test = 1;
-sub ok {
-    my($ok, $info, $todo) = @_;
 
-    # You have to do it this way or VMS will get confused.
-    printf "%s $test%s\n", $ok ? "ok" : "not ok",
-                           $todo ? " # TODO $todo" : '';
-
-    unless( $ok ) {
-        printf "# Failed test at line %d\n", (caller)[2];
-        print  "# $info\n" if defined $info;
-    }
-
-    $test++;
-    return $ok;
-}
-
-sub skip {
-    my($reason) = @_;
-
-    printf "ok $test # skipped%s\n", defined $reason ? ": $reason" : '';
-
-    $test++;
-    return 1;
-}
-
-print "1..59\n";
+plan (tests => 59);
 
 $Is_MSWin32  = $^O eq 'MSWin32';
 $Is_NetWare  = $^O eq 'NetWare';
@@ -58,21 +34,20 @@ $PERL = $ENV{PERL}
 eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
-if ($Is_MSWin32)  { ok `set FOO` =~ /^(?:FOO=)?hi there$/; }
+if ($Is_MSWin32)  { like `set FOO`, qr/^(?:FOO=)?hi there$/; }
 elsif ($Is_MacOS) { ok "1 # skipped", 1; }
-elsif ($Is_VMS)   { ok `write sys\$output f\$trnlnm("FOO")` eq "hi there\n"; }
-else              { ok `echo \$FOO` eq "hi there\n"; }
+elsif ($Is_VMS)   { is `write sys\$output f\$trnlnm("FOO")`, "hi there\n"; }
+else              { is `echo \$FOO`, "hi there\n"; }
 
 unlink 'ajslkdfpqjsjfk';
 $! = 0;
 open(FOO,'ajslkdfpqjsjfk');
-ok $!, $!;
+isnt($!, 0);
 close FOO; # just mention it, squelch used-only-once
 
-if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
-    skip('SIGINT not safe on this platform') for 1..5;
-}
-else {
+SKIP: {
+    skip('SIGINT not safe on this platform', 5)
+	if $Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS;
   # the next tests are done in a subprocess because sh spits out a
   # newline onto stderr when a child process kills itself with SIGINT.
   # We use a pipe rather than system() because the VMS command buffer
@@ -147,58 +122,56 @@ END
     $? >>= 8 if $^O eq 'VMS';
     print $? ? "not ok 7\n" : "ok 7\n";
 
-    $test += 5;
+    curr_test(curr_test() + 5);
 }
 
 # can we slice ENV?
 @val1 = @ENV{keys(%ENV)};
 @val2 = values(%ENV);
-ok join(':',@val1) eq join(':',@val2);
-ok @val1 > 1;
+is join(':',@val1), join(':',@val2);
+cmp_ok @val1, '>', 1;
 
 # regex vars
 'foobarbaz' =~ /b(a)r/;
-ok $` eq 'foo', $`;
-ok $& eq 'bar', $&;
-ok $' eq 'baz', $';
-ok $+ eq 'a', $+;
+is $`, 'foo';
+is $&, 'bar';
+is $', 'baz';
+is $+, 'a';
 
 # $"
 @a = qw(foo bar baz);
-ok "@a" eq "foo bar baz", "@a";
+is "@a", "foo bar baz";
 {
     local $" = ',';
-    ok "@a" eq "foo,bar,baz", "@a";
+    is "@a", "foo,bar,baz";
 }
 
 # $;
 %h = ();
 $h{'foo', 'bar'} = 1;
-ok((keys %h)[0] eq "foo\034bar", (keys %h)[0]);
+is((keys %h)[0], "foo\034bar");
 {
     local $; = 'x';
     %h = ();
     $h{'foo', 'bar'} = 1;
-    ok((keys %h)[0] eq 'fooxbar', (keys %h)[0]);
+    is((keys %h)[0], 'fooxbar');
 }
 
 # $?, $@, $$
-if ($Is_MacOS) {
-    skip('$? + system are broken on MacPerl') for 1..2;
-}
-else {
+SKIP:  {
+    skip('$? + system are broken on MacPerl', 2) if $Is_MacOS;
     system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(0)"];
-    ok $? == 0, $?;
+    is $?, 0;
     system qq[$PERL "-I../lib" -e "use vmsish qw(hushed); exit(1)"];
-    ok $? != 0, $?;
+    isnt $?, 0;
 }
 
 eval { die "foo\n" };
-ok $@ eq "foo\n", $@;
+is $@, "foo\n";
 
-ok $$ > 0, $$;
+cmp_ok($$, '>', 0);
 eval { $$++ };
-ok $@ =~ /^Modification of a read-only value attempted/;
+like ($@, qr/^Modification of a read-only value attempted/);
 
 # $^X and $0
 {
@@ -267,70 +240,88 @@ EOX
 EOH
     }
     $s1 = "\$^X is $perl, \$0 is $script\n";
-    ok open(SCRIPT, ">$script"), $!;
-    ok print(SCRIPT $headmaybe . <<EOB . $middlemaybe . <<'EOF' . $tailmaybe), $!;
+    ok open(SCRIPT, ">$script") or diag $!;
+    ok print(SCRIPT $headmaybe . <<EOB . $middlemaybe . <<'EOF' . $tailmaybe) or diag $!;
 #!$wd/perl
 EOB
 print "\$^X is $^X, \$0 is $0\n";
 EOF
-    ok close(SCRIPT), $!;
-    ok chmod(0755, $script), $!;
+    ok close(SCRIPT) or diag $!;
+    ok chmod(0755, $script) or diag $!;
     $_ = ($Is_MacOS || $Is_VMS) ? `$perl $script` : `$script`;
     s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
     s{./$script}{$script} if $Is_BeOS; # revert BeOS execvp() side-effect
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
     s{is perl}{is $perl}; # for systems where $^X is only a basename
     s{\\}{/}g;
-    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:");
+    if ($Is_MSWin32 || $Is_os2) {
+	is uc $_, uc $s1;
+    } else {
+	is $_, $s1;
+    }
     $_ = `$perl $script`;
     s/\.exe//i if $Is_Dos or $Is_os2 or $Is_Cygwin;
     s{./$perl}{$perl} if $Is_BeOS; # revert BeOS execvp() side-effect
     s{\\}{/}g;
-    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`");
-    ok unlink($script), $!;
+    if ($Is_MSWin32 || $Is_os2) {
+	is uc $_, uc $s1;
+    } else {
+	is $_, $s1;
+    }
+    ok unlink($script) or diag $!;
 }
 
 # $], $^O, $^T
-ok $] >= 5.00319, $];
+cmp_ok $], '>=', 5.00319;
 ok $^O;
-ok $^T > 850000000, $^T;
+cmp_ok $^T, '>', 850000000;
 
 # Test change 25062 is working
 my $orig_osname = $^O;
 {
 local $^I = '.bak';
-ok($^O eq $orig_osname, 'Assigning $^I does not clobber $^O');
+is $^O, $orig_osname, 'Assigning $^I does not clobber $^O';
 }
 $^O = $orig_osname;
 
-if ($Is_VMS || $Is_Dos || $Is_MacOS) {
-    skip("%ENV manipulations fail or aren't safe on $^O") for 1..4;
-}
-else {
-	if ($ENV{PERL_VALGRIND}) {
-	    skip("clearing \%ENV is not safe when running under valgrind");
-	} else {
+SKIP: {
+    skip("%ENV manipulations fail or aren't safe on $^O", 4)
+	if $Is_VMS || $Is_Dos || $Is_MacOS;
+
+ SKIP: {
+	skip("clearing \%ENV is not safe when running under valgrind")
+	    if $ENV{PERL_VALGRIND};
+
 	    $PATH = $ENV{PATH};
 	    $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
 	    $ENV{foo} = "bar";
 	    %ENV = ();
 	    $ENV{PATH} = $PATH;
 	    $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
-	    ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
-			    : (`echo \$foo` eq "\n") );
+	    if ($Is_MSWin32) {
+		is `set foo 2>NUL`, "";
+	    } else {
+		is `echo \$foo`, "\n";
+	    }
 	}
 
 	$ENV{__NoNeSuCh} = "foo";
 	$0 = "bar";
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
-       ok ($Is_MSWin32 ? (`set __NoNeSuCh` =~ /^(?:__NoNeSuCh=)?foo$/)
-			    : (`echo \$__NoNeSuCh` eq "foo\n") );
-	if ($^O =~ /^(linux|freebsd)$/ &&
-	    open CMDLINE, "/proc/$$/cmdline") {
+    	if ($Is_MSWin32) {
+	    like `set __NoNeSuCh`, qr/^(?:__NoNeSuCh=)?foo$/;
+	} else {
+	    is `echo \$__NoNeSuCh`, "foo\n";
+	}
+    SKIP: {
+	    skip("\$0 check only on Linux and FreeBSD", 2)
+		unless $^O =~ /^(linux|freebsd)$/
+		    && open CMDLINE, "/proc/$$/cmdline";
+
 	    chomp(my $line = scalar <CMDLINE>);
 	    my $me = (split /\0/, $line)[0];
-	    ok($me eq $0, 'altering $0 is effective (testing with /proc/)');
+	    is $me, $0, 'altering $0 is effective (testing with /proc/)';
 	    close CMDLINE;
             # perlbug #22811
             my $mydollarzero = sub {
@@ -358,8 +349,6 @@ else {
 	       # can get rid of the first one.
 	       || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/),
 		       'altering $0 is effective (testing with `ps`)');
-	} else {
-	    skip("\$0 check only on Linux and FreeBSD") for 0, 1;
 	}
 }
 
@@ -368,27 +357,26 @@ else {
     my $warn = '';
     local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; };
     $! = undef;
-    ok($ok, $warn, $Is_VMS ? "'\$!=undef' does throw a warning" : '');
+    local $TODO = $Is_VMS ? "'\$!=undef' does throw a warning" : '';
+    ok($ok, $warn);
 }
 
 # test case-insignificance of %ENV (these tests must be enabled only
 # when perl is compiled with -DENV_IS_CASELESS)
-if ($Is_MSWin32 || $Is_NetWare) {
+SKIP: {
+    skip('no caseless %ENV support', 4) unless $Is_MSWin32 || $Is_NetWare;
+
     %ENV = ();
     $ENV{'Foo'} = 'bar';
     $ENV{'fOo'} = 'baz';
-    ok (scalar(keys(%ENV)) == 1);
-    ok exists($ENV{'FOo'});
-    ok (delete($ENV{'foO'}) eq 'baz');
-    ok (scalar(keys(%ENV)) == 0);
-}
-else {
-    skip('no caseless %ENV support') for 1..4;
+    is scalar(keys(%ENV)), 1;
+    ok exists $ENV{'FOo'};
+    is delete $ENV{'foO'}, 'baz';
+    is scalar(keys(%ENV)), 0;
 }
 
-if ($Is_miniperl) {
-    skip ("miniperl can't rely on loading %Errno") for 1..2;
-} else {
+SKIP: {
+    skip ("miniperl can't rely on loading %Errno", 2) if $Is_miniperl;
    no warnings 'void';
 
 # Make sure Errno hasn't been prematurely autoloaded
@@ -403,9 +391,8 @@ if ($Is_miniperl) {
    }, $@;
 }
 
-if ($Is_miniperl) {
-    skip ("miniperl can't rely on loading %Errno");
-} else {
+SKIP:  {
+    skip ("miniperl can't rely on loading %Errno") if $Is_miniperl;
     # Make sure that Errno loading doesn't clobber $!
 
     undef %Errno::;
@@ -416,21 +403,21 @@ if ($Is_miniperl) {
     ok ${"!"}{ENOENT};
 }
 
-ok $^S == 0 && defined $^S;
-eval { ok $^S == 1 };
+is $^S, 0;
+eval { is $^S,1 };
 eval " BEGIN { ok ! defined \$^S } ";
-ok $^S == 0 && defined $^S;
+is $^S, 0;
 
-ok ${^TAINT} == 0;
+is ${^TAINT}, 0;
 eval { ${^TAINT} = 1 };
-ok ${^TAINT} == 0;
+is ${^TAINT}, 0;
 
 # 5.6.1 had a bug: @+ and @- were not properly interpolated
 # into double-quoted strings
 # 20020414 mjd-perl-patch+@plover.com
 "I like pie" =~ /(I) (like) (pie)/;
-ok "@-" eq  "0 0 2 7";
-ok "@+" eq "10 1 6 10";
+is "@-",  "0 0 2 7";
+is "@+", "10 1 6 10";
 
 # Tests for the magic get of $\
 {
@@ -459,29 +446,27 @@ ok "@+" eq "10 1 6 10";
 	return @+;
     };
     my @y = f();
-    ok( $x eq "@y", "return a magic array ($x) vs (@y)" );
+    is $x, "@y", "return a magic array ($x) vs (@y)";
 }
 
 # Test for bug [perl #36434]
-if (!$Is_VMS) {
+# Can not do this test on VMS, EPOC, and SYMBIAN according to comments
+# in mg.c/Perl_magic_clear_all_env()
+SKIP: {
+    skip('Can\'t make assignment to \%ENV on this system', 3) if $Is_VMS;
+
     local @ISA;
     local %ENV;
     # This used to be __PACKAGE__, but that causes recursive
     #  inheritance, which is detected earlier now and broke
     #  this test
     eval { push @ISA, __FILE__ };
-    ok( $@ eq '', 'Push a constant on a magic array');
+    is $@, '', 'Push a constant on a magic array';
     $@ and print "# $@";
     eval { %ENV = (PATH => __PACKAGE__) };
-    ok( $@ eq '', 'Assign a constant to a magic hash');
+    is $@, '', 'Assign a constant to a magic hash';
     $@ and print "# $@";
     eval { my %h = qw(A B); %ENV = (PATH => (keys %h)[0]) };
-    ok( $@ eq '', 'Assign a shared key to a magic hash');
+    is $@, '', 'Assign a shared key to a magic hash';
     $@ and print "# $@";
 }
-else {
-# Can not do this test on VMS, EPOC, and SYMBIAN according to comments
-# in mg.c/Perl_magic_clear_all_env()
-#
-    skip('Can\'t make assignment to \%ENV on this system') for 1..3;
-}