xref: /openbsd-src/gnu/usr.bin/perl/t/op/filetest_stack_ok.t (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b)
1898184e3Ssthen#!./perl
2898184e3Ssthen
3898184e3Ssthen# On platforms that don't support all of the filetest operators the code
4898184e3Ssthen# that faked the results of missing tests used to leave the test's
5898184e3Ssthen# argument on the stack.
6898184e3Ssthen
7898184e3SsthenBEGIN {
8898184e3Ssthen    chdir 't' if -d 't';
9898184e3Ssthen    require './test.pl';
10*5759b3d2Safresh1    set_up_inc('../lib');
11898184e3Ssthen}
12898184e3Ssthen
13898184e3Ssthenmy @ops = split //, 'rwxoRWXOezsfdlpSbctugkTMBAC';
14898184e3Ssthen
15*5759b3d2Safresh1plan( tests => @ops * 5 + 1 );
16898184e3Ssthen
17898184e3Ssthenpackage o { use overload '-X' => sub { 1 } }
18898184e3Ssthenmy $o = bless [], 'o';
19898184e3Ssthen
20898184e3Ssthenfor my $op (@ops) {
21898184e3Ssthen    ok( 1 == @{ [ eval "-$op 'TEST'" ] }, "-$op returns single value" );
22898184e3Ssthen    ok( 1 == @{ [ eval "-$op *TEST" ] }, "-$op *gv returns single value" );
23898184e3Ssthen
24898184e3Ssthen    my $count = 0;
25898184e3Ssthen    my $t;
26898184e3Ssthen    for my $m ("a", "b") {
27898184e3Ssthen	if ($count == 0) {
28898184e3Ssthen	    $t = eval "-$op _" ? 0 : "foo";
29898184e3Ssthen	}
30898184e3Ssthen	elsif ($count == 1) {
31898184e3Ssthen	    is($m, "b", "-$op did not remove too many values from the stack");
32898184e3Ssthen	}
33898184e3Ssthen	$count++;
34898184e3Ssthen    }
35898184e3Ssthen
36898184e3Ssthen    $count = 0;
37898184e3Ssthen    for my $m ("c", "d") {
38898184e3Ssthen	if ($count == 0) {
39898184e3Ssthen	    $t = eval "-$op -e \$^X" ? 0 : "bar";
40898184e3Ssthen	}
41898184e3Ssthen	elsif ($count == 1) {
42898184e3Ssthen	    is($m, "d", "-$op -e \$^X did not remove too many values from the stack");
43898184e3Ssthen	}
44898184e3Ssthen	$count++;
45898184e3Ssthen    }
46898184e3Ssthen
47898184e3Ssthen    my @foo = eval "-$op \$o";
48898184e3Ssthen    is @foo, 1, "-$op \$overld did not leave \$overld on the stack";
49898184e3Ssthen}
50*5759b3d2Safresh1
51*5759b3d2Safresh1{
52*5759b3d2Safresh1    # [perl #129347] cope with stacked filetests where PL_op->op_next is null
53*5759b3d2Safresh1    () = sort { -d -d } \*TEST0, \*TEST1;
54*5759b3d2Safresh1    ok 1, "survived stacked filetests with null op_next";
55*5759b3d2Safresh1}
56