Stack tests

[Alex Gough]

Some tests for stack operations, pushing and popping, except
for pmcs.  Suggest: t/op/stacks.t

Alex Gough
-- 
Hatred is the coward's revenge for being intimidated. 

#########
#! perl -w

# Tests for stack operations, currently push_*, push_*_c and pop_*
# where * != p.

# Assembler code is partially generated by subs at bottom of file

# Still to write: tests for (push|pop)_p(_c)?
#                 tests for warp, unwarp and set_warp

use Parrot::Test tests => 6;

output_is( <<"CODE", <<'OUTPUT', "push_i & pop_i" );
@{[ set_int_regs( sub { $_[0]} )]}
        push_i
@{[ set_int_regs( sub {-$_[0]} )]}
@{[ print_int_regs() ]}
        pop_i
@{[ print_int_regs() ]}
        end
CODE
0-1-2-3-4
-5-6-7-8-9
-10-11-12-13-14
-15-16-17-18-19
-20-21-22-23-24
-25-26-27-28-29
-30-31
01234
56789
1011121314
1516171819
2021222324
2526272829
3031
OUTPUT

SKIP: {skip("push_i_c not implemented",1);
output_is(<<"CODE", <<'OUTPUT', "push_i_c & pop_i");
@{[ set_int_regs( sub {$_[0]}) ]}
        push_i_c
@{[ print_int_regs() ]}
@{[ set_int_regs( sub {-$_[0]}) ]}
@{[ print_int_regs() ]}
        pop_i
@{[ print_int_regs() ]}
CODE
01234
56789
1011121314
1516171819
2021222324
2526272829
3031
0-1-2-3-4
-5-6-7-8-9
-10-11-12-13-14
-15-16-17-18-19
-20-21-22-23-24
-25-26-27-28-29
-30-31
01234
56789
1011121314
1516171819
2021222324
2526272829
3031
OUTPUT
}

output_is(<<"CODE", <<'OUTPUT', 'push_s & pop_s');
@{[ set_str_regs( sub {$_[0]%2} ) ]}
        push_s
@{[ set_str_regs( sub {($_[0]+1) %2} ) ]}
@{[ print_str_regs() ]}
        print "\\n"
        pop_s
@{[ print_str_regs() ]}
        print "\\n"
        end
CODE
10101010101010101010101010101010
01010101010101010101010101010101
OUTPUT

SKIP: {skip("push_s_c not implemented", 1);
output_is(<<"CODE", <<'OUTPUT', 'push_s_c & pop_s');
@{[ set_str_regs( sub {$_[0]%2} ) ]}
        push_s_c
@{[ print_str_regs() ]}
        print "\\n"
@{[ set_str_regs( sub {($_[0]+1) %2} ) ]}
@{[ print_str_regs() ]}
        print "\\n"
        pop_s
@{[ print_str_regs() ]}
        print "\\n"
        end
CODE
01010101010101010101010101010101
10101010101010101010101010101010
01010101010101010101010101010101
OUTPUT
}

output_is(<<"CODE", <<'OUTPUT', 'push_n & pop_n');
@{[ set_num_regs( sub { "1.0".$_ } ) ]}
        push_n
@{[ set_num_regs( sub { "-1.0".$_} ) ]}
@{[ clt_num_regs() ]}
        print "Seem to have negative Nx\\n"
        pop_n
@{[ cgt_num_regs() ]}
        print "Seem to have positive Nx after pop\\n"
        branch ALLOK
ERROR:  print "not ok\\n"
ALLOK:  end
CODE
Seem to have negative Nx
Seem to have positive Nx after pop
OUTPUT

SKIP: { skip("push_n_c not yet implemented",1);
output_is(<<"CODE", <<'OUTPUT', 'push_n_c & pop_n');
@{[ set_num_regs( sub { "1.0".$_ } ) ]}
        push_n_c
@{[ cgt_num_regs() ]}
        print "Seem to have positive Nx before push\\n"
@{[ set_num_regs( sub { "-1.0".$_} ) ]}
@{[ clt_num_regs() ]}
        print "Seem to have negative Nx\\n"
        pop_n
@{[ cgt_num_regs() ]}
        print "Seem to have positive Nx after pop\\n"
        branch ALLOK
ERROR:  print "not ok\\n"
ALLOK:  end
CODE
Seem to have positive Nx before push
Seem to have negative Nx
Seem to have positive Nx after pop
OUTPUT
}

# I'm lazy, and 32* as much code as needed isn't needed,
# if you follow...

# set integer registers to some value given by $code...
package main;
sub set_int_regs {
  my $code = shift;
  my $rt;
  for (0..31) {
    $rt .= "\tset I$_, ".&$code($_)."\n";
  }
  return $rt;
}
# print all integer registers, with newlines every five registers
sub print_int_regs {
  my ($rt, $foo);
  for (0..31) {
    $rt .= "\tprint I$_\n";
    $rt .= "\tprint \"\\n\"\n" unless ++$foo % 5;
  }
  $rt .= "\tprint \"\\n\"\n";
  return $rt;
}

# Set all string registers to values given by &$_[0](reg num)
sub set_str_regs {
  my $code = shift;
  my $rt;
  for (0..31) {
    $rt .= "\tset S$_, \"".&$code($_)."\"\n";
  }
  return $rt;
}
# print string registers, no additional prints
sub print_str_regs {
  my $rt;
  for (0..31) {
    $rt .= "\tprint S$_\n";
  }
  return $rt;
}

# Set "float" registers, &$_[0](reg num) should return string
sub set_num_regs {
  my $code = shift;
  my $rt;
  for (0..31) {
    $rt .= "\tset N$_, ".&$code($_[0])."\n";
  }
  return $rt;
}
# rather than printing all num regs, compare all ge 0
# if any are less, jump to ERROR
# sense of test may seem backwards, but isn't
sub cgt_num_regs {
  my $rt;
  for (0..31) {
    $rt .= "\tlt_nc_ic N$_, 0, ERROR\n";
  }
  return $rt;
}
# same, but this time lt 0
sub clt_num_regs {
  my $rt;
  for (0..31) {
    $rt .= "\tgt_nc_ic N$_, 0, ERROR\n";
  }
  return $rt;
}