This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS-APItest/t/call.t: make loops more flexible
authorDavid Mitchell <davem@iabyn.com>
Wed, 10 Jun 2015 15:20:00 +0000 (16:20 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 19 Jun 2015 07:44:18 +0000 (08:44 +0100)
There's a loop which tests eval_pv, eval_sv, call_sv with various
types of argument. Currently the argument is determined by an integer
in a loop (0..3) with various values derived on an ad-hoc basis
from that index. Instead put all the data into an array of arrays
and iterate over that instead.

Similarly for the function names (eval_pv et al), loop over the names
rather than over 0..2.

This should make no functional change to what is tested, but makes the
test code clearer and more expandable.

ext/XS-APItest/t/call.t

index 9ab633d..bc78be1 100644 (file)
@@ -213,35 +213,43 @@ is($@, "its_dead_jim\n", "eval { eval_pv('d()', 1) } - \$@");
 
 sub f99 { 99 };
 
+my @bodies = (
+    # [ code, is_fn_name, expect_success, has_inner_die, expected_err ]
 
-for my $fn_type (0..2) { #   0:eval_pv   1:eval_sv   2:call_sv
+    # ok
+    [ 'f99',                         1, 1, 0, qr/^$/,           ],
+    # compile-time err
+    [ '$x=',                         0, 0, 0, qr/syntax error/, ],
+    # compile-time exception
+    [ 'BEGIN { die "die in BEGIN"}', 0, 0, 1, qr/die in BEGIN/, ],
+    # run-time exception
+    [ 'd',                           1, 0, 0, qr/its_dead_jim/, ],
+);
+
+
+for my $fn_type (qw(eval_pv eval_sv call_sv)) {
 
     my $warn_msg;
     local $SIG{__WARN__} = sub { $warn_msg .= $_[0] };
 
-    for my $code_type (0..3) {
+    for my $body (@bodies) {
+        my ($code, $is_fn_name, $expect_success,
+                $has_inner_die, $expected_err_qr)  = @$body;
 
        # call_sv can only handle function names, not code snippets
-       next if $fn_type == 2 and ($code_type == 1 or $code_type == 2);
-
-       my $code = (
-           'f99',                          # ok
-           '$x=',                          # compile-time err
-           'BEGIN { die "die in BEGIN"}',  # compile-time exception
-           'd',                            # run-time exception
-       )[$code_type];
+       next if $fn_type eq 'call_sv' and !$is_fn_name;
 
        for my $keep (0, G_KEEPERR) {
            my $keep_desc = $keep ? 'G_KEEPERR' : '0';
 
            my $desc;
-           my $expect = ($code_type == 0) ? 1 : 0;
+           my $expect = $expect_success;
 
            undef $warn_msg;
            $@ = 'pre-err';
 
            my @ret;
-           if ($fn_type == 0) { # eval_pv
+           if ($fn_type eq 'eval_pv') {
                # eval_pv returns its result rather than a 'succeed' boolean
                $expect = $expect ? '99' : undef;
 
@@ -258,21 +266,21 @@ for my $fn_type (0..2) { #   0:eval_pv   1:eval_sv   2:call_sv
                    @ret = eval_pv($code, 0);
                }
            }
-           elsif ($fn_type == 1) { # eval_sv
+           elsif ($fn_type eq 'eval_sv') {
                $desc = "eval_sv('$code', G_ARRAY|$keep_desc)";
                @ret = eval_sv($code, G_ARRAY|$keep);
            }
-           elsif ($fn_type == 2) { # call_sv
+           elsif ($fn_type eq 'call_sv') {
                $desc = "call_sv('$code', G_EVAL|G_ARRAY|$keep_desc)";
                @ret = call_sv($code, G_EVAL|G_ARRAY|$keep);
            }
-           is(scalar @ret, ($code_type == 0 && $fn_type != 0) ? 2 : 1,
+           is(scalar @ret, ($expect_success && $fn_type ne 'eval_pv') ? 2 : 1,
                            "$desc - number of returned args");
            is($ret[-1], $expect, "$desc - return value");
 
-           if ($keep && $fn_type != 0) {
+           if ($keep && $fn_type  ne 'eval_pv') {
                # G_KEEPERR doesn't propagate into inner evals, requires etc
-               unless ($keep && $code_type == 2) {
+               unless ($keep && $has_inner_die) {
                    is($@, 'pre-err', "$desc - \$@ unmodified");
                }
                $@ = $warn_msg;
@@ -281,14 +289,7 @@ for my $fn_type (0..2) { #   0:eval_pv   1:eval_sv   2:call_sv
                is($warn_msg, undef, "$desc - __WARN__ not called");
                unlike($@, qr/pre-err/, "$desc - \$@ modified");
            }
-           like($@,
-               (
-                   qr/^$/,
-                   qr/syntax error/,
-                   qr/die in BEGIN/,
-                   qr/its_dead_jim/,
-               )[$code_type],
-               "$desc - the correct error message");
+           like($@, $expected_err_qr, "$desc - the correct error message");
        }
     }
 }