t/03ip.t

   1 #!perl
   2 #
   3 # This file is part of Language::Befunge.
   4 # Copyright (c) 2001-2007 Jerome Quelin, all rights reserved.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the same terms as Perl itself.
   8 #
   9 #
  10
  11 #----------------------------------#
  12 #          The IP module.          #
  13 #----------------------------------#
  14
  15 use strict;
  16 use Test::More;
  17 use Language::Befunge::IP;
  18
  19 my $tests;
  20 BEGIN { $tests = 0 };
  21
  22 # Constructor.
  23 my $ip = Language::Befunge::IP->new;
  24 is( ref($ip), "Language::Befunge::IP");
  25 BEGIN { $tests += 1 };
  26
  27 # Unique ids.
  28 is( $ip->get_id, 0 );
  29 $ip = Language::Befunge::IP->new;
  30 is( $ip->get_id, 1 );
  31 $ip = Language::Befunge::IP->new;
  32 is( $ip->get_id, 2 );
  33 is( Language::Befunge::IP::_get_new_id, 3 );
  34 BEGIN { $tests += 4 };
  35
  36 # Test accessors.
  37 $ip->get_position->set_component(0,36);
  38 is( $ip->get_position->get_component(0), 36 );
  39 $ip->get_position->set_component(1,27);
  40 is( $ip->get_position->get_component(1), 27 );
  41 $ip->set_position(Language::Befunge::Vector->new(2, 4, 6));
  42 is( $ip->get_position->get_component(0), 4 );
  43 is( $ip->get_position->get_component(1), 6 );
  44 $ip->get_delta->set_component(0,15);
  45 is( $ip->get_delta->get_component(0), 15 );
  46 $ip->get_delta->set_component(1,-4);
  47 is( $ip->get_delta->get_component(1), -4 );
  48 $ip->get_storage->set_component(0, -5 );
  49 is( $ip->get_storage->get_component(0), -5 );
  50 $ip->get_storage->set_component(0, 16 );
  51 is( $ip->get_storage->get_component(0), 16 );
  52 $ip->set_string_mode( 1 );
  53 is( $ip->get_string_mode, 1 );
  54 $ip->set_end( 1 );
  55 is( $ip->get_end, 1 );
  56 $ip->set_input( "gnirts" );
  57 is( $ip->get_input, "gnirts" );
  58 $ip->set_data({}); # meaningless, only to test accessors
  59 $ip->set_libs([]); # meaningless, only to test accessors
  60 $ip->set_ss([]);   # meaningless, only to test accessors
  61 BEGIN { $tests += 11 };
  62
  63 # Test stack operations.
  64 is( $ip->spop, 0, "empty stack returns a 0" );
  65 is( $ip->spop_gnirts, "", "empty stack returns empty gnirts" );
  66 is( $ip->svalue(5), 0); # empty stack should return a 0.
  67 $ip->spush( 45 );
  68 is( $ip->spop, 45);
  69 $ip->spush( 65, 32, 78, 14, 0, 103, 110, 105, 114, 116, 83 );
  70 is( $ip->svalue(2),  116 );
  71 is( $ip->svalue(-2), 116 );
  72 is( $ip->svalue(1),  83 );
  73 is( $ip->svalue(-1), 83 );
  74 is( $ip->scount, 11 );
  75 is( $ip->spop_gnirts, "String" );
  76 is( $ip->scount, 4 );
  77 $ip->spush_vec(Language::Befunge::Vector->new(2, 4, 5));
  78 is( $ip->scount, 6);
  79 is( $ip->spop, 5 );
  80 is( $ip->spop, 4 );
  81 $ip->spush(18, 74);
  82 my ($x, $y) = $ip->spop_vec->get_all_components();
  83 is( $x, 18 );
  84 is( $y, 74 );
  85 ($x, $y) = $ip->spop_mult(2);
  86 is( $x, 78 );
  87 is( $y, 14 );
  88 $ip->spush_args( "foo", 7, "bar" );
  89 is( $ip->scount, 11 );
  90 is( $ip->spop, 98 );
  91 is( $ip->spop, 97 );
  92 is( $ip->spop, 114 );
  93 is( $ip->spop, 0 );
  94 is( $ip->spop, 7 );
  95 is( $ip->spop_gnirts, "foo" );
  96 $ip->sclear;
  97 is( $ip->scount, 0 );
  98 BEGIN { $tests += 26 };
  99
 100 # Test stack stack.
 101 # The following table gives the line number where the
 102 # corresponding test is done.
 103 #
 104 # create = $ip->ss_create
 105 # remove = $ip->ss_remove
 106 # transfer = $ip->ss_transfer
 107 #
 108 # enough means there's enough values in the start stack to perform the
 109 # action. not enough means there's not enough values in the start
 110 # stack to perform the action (filled with zeroes).
 111 #
 112 #                   enough   not enough
 113 # create   (<0)      106         X
 114 # create   (=0)      136         X
 115 # create   (>0)       96        141
 116 # remove   (<0)      121         X
 117 # remove   (=0)      156         X
 118 # remove   (>0)      164        127
 119 # transfer (<0)      161        110
 120 # transfer (=0)      153         X
 121 # transfer (>0)      102        146
 122 $ip->sclear;
 123 $ip->spush( 11, 12, 13, 14, 15, 16, 17, 18, 19 );
 124 is( $ip->scount, 9 );             # toss = (11,12,13,14,15,16,17,18,19)
 125 is( $ip->ss_count, 0 );
 126 $ip->ss_create( 2 );              # create new toss, filled with values (enough).
 127 is( $ip->scount, 2 );             # toss = (18,19)
 128 is( $ip->soss_count, 7 );         # soss = (11,12,13,14,15,16,17)
 129 is( $ip->ss_count, 1 );
 130 is( $ip->spop, 19 );              # toss = (18)
 131 is( $ip->soss_pop, 17 );          # soss = (11,12,13,14,15,16)
 132 $ip->ss_transfer( 2 );            # move elems from soss to toss (enough).
 133 is( $ip->scount, 3 );             # toss = (18,16,15)
 134 is( $ip->soss_count, 4 );         # soss = (11,12,13,14)
 135 is( $ip->spop, 15 );              # toss = (18,16)
 136 $ip->ss_create( -3 );             # create new toss, filled with zeroes.
 137 is( $ip->scount, 3 );             # toss = (0,0,0)
 138 is( $ip->soss_count, 2 );         # soss = (18,16)
 139 is( $ip->ss_count, 2 );
 140 is( join("",$ip->ss_sizes), "324" );
 141 is( $ip->spop, 0 );               # toss = (0,0)
 142 $ip->ss_transfer( -10 );          # move elems from toss to soss (not enough).
 143 is( $ip->scount, 0 );             # toss = ()
 144 is( $ip->soss_count, 12 );        # soss = (18,17,0,0,0,0,0,0,0,0,0,0)
 145 $ip->soss_push( 15 );             # soss = (18,17,0,0,0,0,0,0,0,0,0,0,15)
 146 is( $ip->soss_pop, 15 );          # soss = (18,17,0,0,0,0,0,0,0,0,0,0)
 147 $ip->soss_clear;                  # soss = ()
 148 is( $ip->soss_pop, 0, "soss_pop returns a 0 on empty soss" );
 149 is( $ip->soss_count, 0 );
 150 $ip->spush( 16, 17 );             # toss = (16, 17)
 151 $ip->soss_push( 13, 14, 15, 16 ); # soss = (13,14,15,16)
 152 $ip->ss_remove( -1 );             # destroy toss, remove elems.
 153 is( $ip->ss_count, 1 );
 154 is( $ip->scount, 3 );             # toss = (13,14,15)
 155 is( $ip->spop, 15 );              # toss = (13,14)
 156 is( $ip->spop, 14 );              # toss = (13)
 157 $ip->spush( 14, 15 );
 158 $ip->ss_remove( 5 );              # destroy toss, push values (not enough).
 159 is( $ip->ss_count, 0 );
 160 is( $ip->scount, 9 );             # toss = (11,12,13,14,0,0,13,14,15)
 161 is( $ip->spop, 15 );              # toss = (11,12,13,14,0,0,13,14)
 162 is( $ip->spop, 14 );              # toss = (11,12,13,14,0,0,13)
 163 is( $ip->spop, 13 );              # toss = (11,12,13,14,0,0)
 164 is( $ip->spop, 0 );               # toss = (11,12,13,14,0)
 165 is( $ip->spop, 0 );               # toss = (11,12,13,14)
 166 is( $ip->spop, 14 );              # toss = (11,12,13)
 167 $ip->ss_create( 0 );              # create new toss, no values filled.
 168 is( $ip->scount, 0 );             # toss = ()
 169 is( $ip->soss_count, 3 );         # soss = (11,12,13)
 170 is( $ip->ss_count, 1 );
 171 $ip->spush( 78 );                 # toss = (78)
 172 $ip->ss_create( 3 );              # create new toss, filled with values (not enough).
 173 is( $ip->scount, 3 );             # toss = (0,0,78)
 174 is( $ip->soss_count, 0 );         # soss = ()
 175 is( $ip->ss_count, 2 );
 176 $ip->soss_push( 45 );             # soss = (45)
 177 $ip->ss_transfer( 3 );            # move elems from soss to toss (not enough).
 178 is( $ip->scount, 6 );             # toss = (0,0,78,45,0,0)
 179 is( $ip->soss_count, 0 );         # soss = ()
 180 is( $ip->spop, 0 );               # toss = (0,0,78,45,0)
 181 is( $ip->spop, 0 );               # toss = (0,0,78,45)
 182 is( $ip->spop, 45 );              # toss = (0,0,78)
 183 $ip->soss_push( 12 );             # soss = (12)
 184 $ip->ss_transfer( 0 );            # move 0 elems.
 185 is( $ip->scount, 3 );
 186 is( $ip->soss_count, 1 );
 187 $ip->ss_remove( 0 );              # destroy toss, no values moved.
 188 is( $ip->scount, 1 );             # toss = (12)
 189 is( $ip->soss_count, 3 );         # soss = (11,12,13)
 190 is( $ip->ss_count, 1 );
 191 $ip->spush( 18 );                 # toss = (12,18)
 192 $ip->ss_transfer( -1 );           # move elems from toss to soss (enough).
 193 is( $ip->scount, 1 );             # toss = (12)
 194 is( $ip->soss_count, 4 );         # soss = (11,12,13,18)
 195 $ip->ss_remove( 1 );              # destroy toss, values filled (enough).
 196 is( $ip->scount, 5 );             # toss = (11,12,13,18,12)
 197 is( $ip->ss_count, 0 );
 198 is( $ip->spop, 12 );              # toss = (11,12,13,18)
 199 is( $ip->spop, 18 );              # toss = (11,12,13)
 200 is( $ip->spop, 13 );              # toss = (11,12)
 201 is( $ip->spop, 12 );              # toss = (11)
 202 $ip->ss_create( 0 );              # toss = () soss = (11)
 203 $ip->ss_remove( -3 );             # destroy toss, remove elems
 204 is( $ip->scount, 0, "ss_remove can clear completely the soss-to-be-toss" );
 205 BEGIN { $tests += 57 };
 206
 207 # Test cardinal directions.
 208 $ip->dir_go_east();
 209 is( $ip->get_delta->get_component(0), 1 );
 210 is( $ip->get_delta->get_component(1), 0 );
 211 $ip->dir_go_west();
 212 is( $ip->get_delta->get_component(0), -1 );
 213 is( $ip->get_delta->get_component(1), 0 );
 214 $ip->dir_go_north();
 215 is( $ip->get_delta->get_component(0), 0 );
 216 is( $ip->get_delta->get_component(1), -1 );
 217 $ip->dir_go_south();
 218 is( $ip->get_delta->get_component(0), 0 );
 219 is( $ip->get_delta->get_component(1), 1 );
 220 BEGIN { $tests += 8 };
 221
 222 # Test random direction.
 223 $ip->dir_go_away();
 224 is( abs($ip->get_delta->get_component(0) + $ip->get_delta->get_component(1)), 1);
 225 BEGIN { $tests += 1 };
 226
 227 # Test turn left.
 228 $ip->dir_go_east();
 229 $ip->dir_turn_left();
 230 is( $ip->get_delta->get_component(0), 0);
 231 is( $ip->get_delta->get_component(1), -1);
 232 $ip->dir_turn_left();
 233 is( $ip->get_delta->get_component(0), -1);
 234 is( $ip->get_delta->get_component(1), 0);
 235 $ip->dir_turn_left();
 236 is( $ip->get_delta->get_component(0), 0);
 237 is( $ip->get_delta->get_component(1), 1);
 238 $ip->dir_turn_left();
 239 is( $ip->get_delta->get_component(0), 1);
 240 is( $ip->get_delta->get_component(1), 0);
 241 BEGIN { $tests += 8 };
 242 $ip->set_delta(Language::Befunge::Vector->new(2,3,2));
 243 $ip->dir_turn_left();
 244 is( $ip->get_delta->get_component(0), 2);
 245 is( $ip->get_delta->get_component(1), -3);
 246 $ip->dir_turn_left();
 247 is( $ip->get_delta->get_component(0), -3);
 248 is( $ip->get_delta->get_component(1), -2);
 249 $ip->dir_turn_left();
 250 is( $ip->get_delta->get_component(0), -2);
 251 is( $ip->get_delta->get_component(1), 3);
 252 $ip->dir_turn_left();
 253 is( $ip->get_delta->get_component(0), 3);
 254 is( $ip->get_delta->get_component(1), 2);
 255 BEGIN { $tests += 8 };
 256
 257 # Test turn right.
 258 $ip->dir_go_east();
 259 $ip->dir_turn_right();
 260 is( $ip->get_delta->get_component(0), 0);
 261 is( $ip->get_delta->get_component(1), 1);
 262 $ip->dir_turn_right();
 263 is( $ip->get_delta->get_component(0), -1);
 264 is( $ip->get_delta->get_component(1), 0);
 265 $ip->dir_turn_right();
 266 is( $ip->get_delta->get_component(0), 0);
 267 is( $ip->get_delta->get_component(1), -1);
 268 $ip->dir_turn_right();
 269 is( $ip->get_delta->get_component(0), 1);
 270 is( $ip->get_delta->get_component(1), 0);
 271 BEGIN { $tests += 8 };
 272 $ip->set_delta(Language::Befunge::Vector->new(2,3,2));
 273 $ip->dir_turn_right();
 274 is( $ip->get_delta->get_component(0), -2);
 275 is( $ip->get_delta->get_component(1), 3);
 276 $ip->dir_turn_right();
 277 is( $ip->get_delta->get_component(0), -3);
 278 is( $ip->get_delta->get_component(1), -2);
 279 $ip->dir_turn_right();
 280 is( $ip->get_delta->get_component(0), 2);
 281 is( $ip->get_delta->get_component(1), -3);
 282 $ip->dir_turn_right();
 283 is( $ip->get_delta->get_component(0), 3);
 284 is( $ip->get_delta->get_component(1), 2);
 285 BEGIN { $tests += 8 };
 286
 287 # Test reverse.
 288 $ip->dir_go_east();
 289 $ip->dir_reverse();
 290 is( $ip->get_delta->get_component(0), -1 );
 291 is( $ip->get_delta->get_component(1), 0 );
 292 $ip->dir_reverse();
 293 is( $ip->get_delta->get_component(0), 1 );
 294 is( $ip->get_delta->get_component(1), 0 );
 295 $ip->set_delta(Language::Befunge::Vector->new(2, 2, -3));
 296 $ip->dir_reverse();
 297 is( $ip->get_delta->get_component(0), -2 );
 298 is( $ip->get_delta->get_component(1), 3 );
 299 $ip->dir_reverse();
 300 is( $ip->get_delta->get_component(0), 2 );
 301 is( $ip->get_delta->get_component(1), -3 );
 302 BEGIN { $tests += 8 };
 303
 304 # Test cloning.
 305 $ip = Language::Befunge::IP->new;
 306 $ip->spush( 1, 5, 6 );
 307 my $clone = $ip->clone;
 308 is( $ip->get_id != $clone->get_id, 1 );
 309 is( $ip->spop, 6 );
 310 is( $clone->spop, 6 );
 311 is( $clone->spop, 5 );
 312 BEGIN { $tests += 4 };
 313
 314 # extension data.
 315 $ip->extdata( "HELO", "foobar" );
 316 is( $ip->extdata("HELO"), "foobar", "restore previously saved data" );
 317 BEGIN { $tests += 1 };
 318
 319
 320 BEGIN { plan tests => $tests };
 321
 322