t/04lahey-generic.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 LaheySpace module (N-dimensional generic).          #
  13 #------------------------------------------------------------------#
  14
  15 use strict;
  16 use Test::More;
  17 use Language::Befunge::IP;
  18 use Language::Befunge::LaheySpace::Generic;
  19 BEGIN { use_ok ('Test::Exception') };
  20 my $test_exception_loaded = defined($Test::Exception::VERSION);
  21
  22 my $tests;
  23 my $ip = Language::Befunge::IP->new(4);
  24 my $zerovec = Language::Befunge::Vector->new_zeroes(4);
  25 my ($w,$h,$href);
  26 BEGIN { $tests = 0 };
  27
  28
  29 # constructor.
  30 my $ls = Language::Befunge::LaheySpace::Generic->new(4);
  31 isa_ok( $ls, "Language::Befunge::LaheySpace::Generic");
  32 BEGIN { $tests += 1 };
  33
  34
  35 # clear method.
  36 $ls->clear;
  37 ok( $ls->{min} == $zerovec, "clear resets min" );
  38 ok( $ls->{max} == $zerovec, "clear resets max" );
  39 BEGIN { $tests += 2; }
  40
  41
  42 # _enlarge/_enlarge methods.
  43 $ls->clear;
  44 $ls->_enlarge(Language::Befunge::Vector->new(4, -2, -3, 0, 0)); # _enlarge
  45 is( $ls->{min}->get_component(0), -2, "_enlarge sets min[x]" );
  46 is( $ls->{min}->get_component(1), -3, "_enlarge sets min[y]" );
  47 is( $ls->{min}->get_component(2),  0, "_enlarge(0) doesn't change zmin" );
  48 is( $ls->{min}->get_component(3),  0, "_enlarge(0) doesn't change 4min" );
  49 $ls->_enlarge(Language::Befunge::Vector->new(4, -1, -1, 0, 0)); # can't shrink
  50 is( $ls->{min}->get_component(0), -2, "_enlarge can't shrink min[x]" );
  51 is( $ls->{min}->get_component(1), -3, "_enlarge can't shrink min[y]" );
  52 $ls->_enlarge(Language::Befunge::Vector->new(4, 4, 5, 0, 0));   # _enlarge
  53 is( $ls->{max}->get_component(0), 4, "_enlarge sets max[x]" );
  54 is( $ls->{max}->get_component(1), 5, "_enlarge sets max[y]" );
  55 $ls->_enlarge(Language::Befunge::Vector->new(4, 2, 3, 0, 0));   # can't shrink
  56 is( $ls->{max}->get_component(0), 4, "_enlarge can't shrink max[x]" );
  57 is( $ls->{max}->get_component(1), 5, "_enlarge can't shrink max[y]" );
  58 BEGIN{ $tests += 10; }
  59
  60
  61 # enlarge torus.
  62 $ls->clear;
  63 $ls->_enlarge(Language::Befunge::Vector->new(4, 0, 3, 0, 0) );
  64 is( $ls->{min}->get_component(0), 0, "_enlarge_y >0 does not grow min[x]" );
  65 is( $ls->{min}->get_component(1), 0, "_enlarge_y >0 does not grow min[y]" );
  66 is( $ls->{max}->get_component(0), 0, "_enlarge_y >0 does not grow max[x]" );
  67 is( $ls->{max}->get_component(1), 3, "_enlarge_y >0 does grow max[y]" );
  68 $ls->_enlarge(Language::Befunge::Vector->new(4, 2, 0, 0, 0) );
  69 is( $ls->{min}->get_component(0), 0, "_enlarge_x >0 does not grow min[x]" );
  70 is( $ls->{min}->get_component(1), 0, "_enlarge_x >0 does not grow min[y]" );
  71 is( $ls->{max}->get_component(0), 2, "_enlarge_x >0 does grow max[x]" );
  72 is( $ls->{max}->get_component(1), 3, "_enlarge_x >0 does not grow max[y]" );
  73 $ls->_enlarge(Language::Befunge::Vector->new(4, 0, -5, 0, 0) );
  74 is( $ls->{min}->get_component(0), 0,  "_enlarge_y <0 does not grow min[x]" );
  75 is( $ls->{min}->get_component(1), -5, "_enlarge_y <0 does grow min[y]" );
  76 is( $ls->{max}->get_component(0), 2,  "_enlarge_y <0 does not grow max[x]" );
  77 is( $ls->{max}->get_component(1), 3,  "_enlarge_y <0 does not grow max[y]" );
  78 $ls->_enlarge(Language::Befunge::Vector->new(4, -4, 0, 0, 0) );
  79 is( $ls->{min}->get_component(0), -4, "_enlarge_x <0 does grow min[x]" );
  80 is( $ls->{min}->get_component(1), -5, "_enlarge_x <0 does not grow min[y]" );
  81 is( $ls->{max}->get_component(0), 2,  "_enlarge_x <0 does not grow max[x]" );
  82 is( $ls->{max}->get_component(1), 3,  "_enlarge_x <0 does not grow max[y]" );
  83 BEGIN { $tests += 16; }
  84
  85
  86 # get/set value.
  87 $ls->clear;
  88 $ls->set_value(Language::Befunge::Vector->new(4, 10, 5, 0, 0), 65 );
  89 is( $ls->{max}->get_component(0), 10, "set_value grows max[x] if needed" );
  90 is( $ls->{max}->get_component(1), 5,  "set_value grows max[y] if needed" );
  91 is( $ls->get_value(Language::Befunge::Vector->new(4,  10, 5, 0, 0)), 65, "get_value returns correct value" );
  92 $ls->set_value(Language::Befunge::Vector->new(4,  -10, -5, 0, 0), 65 );
  93 is( $ls->{min}->get_component(0), -10, "set_value grows min[x] if needed" );
  94 is( $ls->{min}->get_component(1), -5,  "set_value grows min[y] if needed" );
  95 is( $ls->get_value(Language::Befunge::Vector->new(4,  -10, -5, 0, 0)), 65, "get_value returns correct value" );
  96
  97 is( $ls->get_value(Language::Befunge::Vector->new(4,  1, 1, 0, 0)),    32, "get_value defaults to space" );
  98 is( $ls->get_value(Language::Befunge::Vector->new(4,  20, 20, 0, 0)),  32, "get_value out of bounds defaults to space" );
  99 is( $ls->get_value(Language::Befunge::Vector->new(4,  -20, -20, 0, 0)),32, "get_value out of bounds defaults to space" );
 100
 101 $ls->clear;
 102 $ls->_enlarge(Language::Befunge::Vector->new(4, 0, 3, 0, 0) ); # corner cases, should not happen - but anyway.
 103 is( $ls->get_value(Language::Befunge::Vector->new(4,  -4, 0, 0, 0)), 32, "get_value defaults to space" );
 104 is( $ls->get_value(Language::Befunge::Vector->new(4,   4, 0, 0, 0)), 32, "get_value defaults to space" );
 105 BEGIN { $tests += 11; }
 106
 107
 108 # input checking: make sure get_char() returns ASCII.
 109 $ls->set_value(Language::Befunge::Vector->new(4, 0, 0, 0, 0), -1);
 110 $ls->set_value(Language::Befunge::Vector->new(4, 1, 0, 0, 0),  0);
 111 $ls->set_value(Language::Befunge::Vector->new(4, 0, 2, 0, 0),255);
 112 $ls->set_value(Language::Befunge::Vector->new(4, 0, 0, 3, 0),256);
 113 is( $ls->get_value(Language::Befunge::Vector->new(4, 0, 0, 0, 0)), -1, "set_value works");
 114 is( $ls->get_value(Language::Befunge::Vector->new(4, 1, 0, 0, 0)),  0, "set_value works");
 115 is( $ls->get_value(Language::Befunge::Vector->new(4, 0, 2, 0, 0)),255, "set_value works");
 116 is( $ls->get_value(Language::Befunge::Vector->new(4, 0, 0, 3, 0)),256, "set_value works");
 117 is( $ls->get_char(Language::Befunge::Vector->new(4, 0, 0, 0, 0)), sprintf("<np-0x%x>", -1), "get_char always returns ascii" );
 118 is( $ls->get_char(Language::Befunge::Vector->new(4, 1, 0, 0, 0)), chr(0),       "get_chars always returns ascii" );
 119 is( $ls->get_char(Language::Befunge::Vector->new(4, 0, 2, 0, 0)), chr(0xff),    "get_chars always returns ascii" );
 120 is( $ls->get_char(Language::Befunge::Vector->new(4, 0, 0, 3, 0)), '<np-0x100>', "get_chars always returns ascii" );
 121 BEGIN { $tests += 8 };
 122
 123
 124 # multi-dimensional store method.
 125 $ls->clear;
 126 $ls->store( <<"EOF" );
 127 aaa
 128 bbb
 129 ccc
 130 \fddd
 131 eee
 132 fff
 133 \fggg
 134 hhh
 135 iii
 136 \0jjj
 137 kkk
 138 lll
 139 \fmmm
 140 nnn
 141 ooo
 142 \fppp
 143 qqq
 144 rrr
 145 \0sss
 146 ttt
 147 uuu
 148 \fvvv
 149 www
 150 xxx
 151 \fyyy
 152 zzz
 153 AAA
 154 EOF
 155 is( $$ls{nd}, 4, "LS::Generic has right number of dimensions");
 156 is( $ls->get_char(Language::Befunge::Vector->new(4,  0, 0, 0, 0)), 'a', "store begins at 0" );
 157 is( $ls->get_char(Language::Befunge::Vector->new(4,  1, 1, 1, 1)), 'n', "store handles multidim properly" );
 158 is( $ls->get_char(Language::Befunge::Vector->new(4,  2, 2, 2, 2)), 'A', "store still handles multidim properly" );
 159 BEGIN { $tests += 4; }
 160
 161
 162 # store method.
 163 $ls->clear;
 164 $ls->store( <<'EOF' );
 165 Foo bar baz
 166 camel llama buffy
 167 EOF
 168 #   5432101234567890123456789012345678
 169 #  2
 170 #  1
 171 #  0     Foo bar baz
 172 #  1     camel llama buffy
 173 #  2
 174 #  3
 175 #  4
 176 is( $ls->{min}->get_component(0), 0,  "store does not grow min[x] if not needed" );
 177 is( $ls->{min}->get_component(1), 0,  "store does not grow max[y] if not needed" );
 178 is( $ls->{max}->get_component(0), 16, "store grows max[x] if needed" );
 179 is( $ls->{max}->get_component(1), 1,  "store grows max[y] if needed" );
 180 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0)), 70, "store stores everything" );
 181 is( $ls->get_value(Language::Befunge::Vector->new(4, 12, 0, 0, 0)), 32, "store defaults to space" );
 182 is( $ls->get_value(Language::Befunge::Vector->new(4,  1, 5, 0, 0)), 32, "store does not store outside of its bounds" );
 183 BEGIN { $tests += 7; }
 184 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, 4, 1, 0, 0) );
 185 Foo bar baz
 186 camel llama buffy
 187 EOF
 188 #   5432101234567890123456789012345678
 189 #  2
 190 #  1
 191 #  0     Foo bar baz
 192 #  1     cameFoo bar baz
 193 #  2         camel llama buffy
 194 #  3
 195 #  4
 196 is( $ls->{min}->get_component(0), 0,  "store does not grow min[x] if not needed" );
 197 is( $ls->{min}->get_component(1), 0,  "store does not grow min[y] if not needed" );
 198 is( $ls->{max}->get_component(0), 20, "store grows max[x] if needed" );
 199 is( $ls->{max}->get_component(1), 2,  "store grows max[y] if needed" );
 200 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0)),  70,  "store respects specified origin" ); # old values.
 201 is( $ls->get_value(Language::Befunge::Vector->new(4,  4, 1, 0, 0)),  70,  "store overwrites if needed" );
 202 is( $ls->get_value(Language::Befunge::Vector->new(4,  20, 2, 0, 0)), 121, "store stores everything" ); # last value.
 203 BEGIN { $tests += 7; }
 204 ($w, $h) = $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ))->get_all_components;
 205 Foo bar baz
 206 camel llama buffy
 207 EOF
 208 #   5432101234567890123456789012345678
 209 #  2
 210 #  1   Foo bar baz
 211 #  0   camel llama buffy
 212 #  1     cameFoo bar baz
 213 #  2         camel llama buffy
 214 #  3
 215 #  4
 216 is( $w, 17, "store returns correct inserted width" );
 217 is( $h, 2,  "store returns correct inserted height" );
 218 is( $ls->{min}->get_component(0), -2, "store grows min[x] if needed" );
 219 is( $ls->{min}->get_component(1), -1, "store grows min[y] if needed" );
 220 is( $ls->{max}->get_component(0), 20, "store does not grow max[x] if not needed" );
 221 is( $ls->{max}->get_component(1), 2,  "store does not grow max[y] if not needed" );
 222 is( $ls->get_value(Language::Befunge::Vector->new(4,  -2, -1, 0, 0)), 70,  "store stores value in negative indices" );
 223 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0 )),  109, "store overwrites if needed" );
 224 is( $ls->get_value(Language::Befunge::Vector->new(4,  4, 1, 0, 0 )),  70,  "store does not overwrite outside its rectangle" );
 225 BEGIN { $tests += 9; }
 226 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, 0, 0, 0 ));
 227 Foo bar baz
 228 camel llama buffy
 229 EOF
 230 #   5432101234567890123456789012345678
 231 #  2
 232 #  1   Foo bar baz
 233 #  0   Foo bar baz
 234 #  1   camel llama buffy
 235 #  2         camel llama buffy
 236 #  3
 237 #  4
 238 is( $ls->{min}->get_component(0), -2, "store does not grow min[x] if not needed" );
 239 is( $ls->{min}->get_component(1), -1, "store does not grow min[y] if not needed" );
 240 is( $ls->{max}->get_component(0), 20, "store does not grow max[x] if not needed" );
 241 is( $ls->{max}->get_component(1), 2,  "store does not grow max[y] if not needed" );
 242 is( $ls->get_value(Language::Befunge::Vector->new(4,  -2, 0, 0, 0)), 70,  "store overwrites if needed" );
 243 is( $ls->get_value(Language::Befunge::Vector->new(4,  12, 0, 0, 0 )), 32, "store overwrites with spaces if needed" );
 244 BEGIN { $tests += 6; }
 245
 246
 247 # rectangle.
 248 is( $ls->rectangle(Language::Befunge::Vector->new(4, -3, 4, 0, 0),Language::Befunge::Vector->new(4, 1,1, 0, 0)), " \n\f\0", "rectangle returns lines ending with \\n" );
 249 is( $ls->rectangle(Language::Befunge::Vector->new(4, -2,-1, 0, 0),Language::Befunge::Vector->new(4, 3,2, 0, 0)), "Foo\nFoo\n\f\0", "rectangle works with multiple lines" );
 250 is( $ls->rectangle(Language::Befunge::Vector->new(4, 19,-2, 0, 0),Language::Befunge::Vector->new(4, 2,6, 0, 0)), "  \n  \n  \n  \nfy\n  \n\f\0", "rectangle works accross origin" );
 251 BEGIN { $tests += 3; }
 252
 253
 254 # store_binary method
 255 $ls->clear;
 256 my $size = $ls->store_binary( <<'EOF' );
 257 abcde
 258  fghij
 259 EOF
 260 #   5432101234567890123456789012345678901234
 261 #  2
 262 #  1
 263 #  0     abcde@ fghij
 264 #  1
 265 #  2
 266 is( $ls->{min}->get_component(0), 0,  "store_binary does not grow min[x]" );
 267 is( $ls->{min}->get_component(1), 0,  "store_binary does not grow min[y]" );
 268 is( $ls->{max}->get_component(0), 12, "store_binary grows max[x] as needed" );
 269 is( $ls->{max}->get_component(1), 0,  "store_binary does not grow max[y]" );
 270 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0)),  97, "store_binary stores everything" );
 271 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 35,0, 0)), 32,  "store_binary does not store outside of its bounds" );
 272 is( $ls->get_value(Language::Befunge::Vector->new(4,  4, 0, 0, 0)), 101, "store_binary stores binary" );
 273 is( $ls->get_value(Language::Befunge::Vector->new(4,  5, 0, 0, 0)), 10,  "store_binary stores binary" );
 274 is( $ls->get_value(Language::Befunge::Vector->new(4,  6, 0, 0, 0)), 32,  "store_binary stores binary" );
 275 is( $ls->get_value(Language::Befunge::Vector->new(4,  7, 0, 0, 0)), 102, "store_binary stores binary" );
 276 is( $size->get_component(0), 13, "store_binary flattens input" );
 277 is( $size->get_component(1), 1,  "store_binary flattens input" );
 278 BEGIN { $tests += 12; }
 279 $ls->store_binary( <<'EOF', Language::Befunge::Vector->new(4, 4, 1, 0, 0 ));
 280 klmno
 281   pqrst
 282 EOF
 283 #   5432101234567890123456789012345678901234
 284 #  2
 285 #  1
 286 #  0     abcde@ fghij
 287 #  1         klmno@  pqrst
 288 #  2
 289 is( $ls->{min}->get_component(0), 0,  "store_binary does not grow min[x] if not needed" );
 290 is( $ls->{min}->get_component(1), 0,  "store_binary does not grow min[y] if not needed" );
 291 is( $ls->{max}->get_component(0), 17, "store_binary grows max[x] if needed" );
 292 is( $ls->{max}->get_component(1), 1,  "store_binary grows max[y] if needed" );
 293 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0)), 97, "store_binary respects specified origin" ); # old values.
 294 is( $ls->get_value(Language::Befunge::Vector->new(4,  4, 1, 0, 0)), 107,"store_binary stores everything" );
 295 BEGIN { $tests += 6; }
 296 $ls->store_binary( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ));
 297 Foo bar baz
 298 camel llama buffy
 299 EOF
 300 #   5432101234567890123456789012345678901234
 301 #  2
 302 #  1    Foo bar baz@camel llama buffy
 303 #  0     abcde@ fghij
 304 #  1         klmno@ pqrst
 305 #  2
 306 is( $ls->{min}->get_component(0), -2, "store_binary grows min[x] if needed" );
 307 is( $ls->{min}->get_component(1), -1, "store_binary grows min[y] if needed" );
 308 is( $ls->{max}->get_component(0), 27, "store_binary does not grow max[x] if not needed" );
 309 is( $ls->{max}->get_component(1), 1,  "store_binary does not grow max[y] if not needed" );
 310 is( $ls->get_value(Language::Befunge::Vector->new(4,  -2, -1, 0, 0)), 70,  "store_binary stores value in negative indices" );
 311 BEGIN { $tests += 5; }
 312 $ls->store_binary( <<'EOF', Language::Befunge::Vector->new(4, 0, 2, 0, 0 ));
 313 Foo bar baz
 314 camel llama buffy
 315 EOF
 316 #   5432101234567890123456789012345678901234
 317 #  2
 318 #  1    Foo bar baz@camel llama buffy
 319 #  0     abFoo bar baz@camel llama buffy
 320 #  1         klmno@ pqrst
 321 #  2
 322 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 0, 0, 0)), 97, "store_binary doesn't overwrite stuff to the left on the same line" );
 323 is( $ls->get_value(Language::Befunge::Vector->new(4,  0, 2, 0, 0)), 70, "store_binary overwrites if needed" );
 324 BEGIN { $tests += 2; }
 325
 326
 327 # move ip.
 328 $ls->clear;   # "positive" playfield.
 329 $ls->_enlarge(Language::Befunge::Vector->new(4, 5, 10, 1, 2));
 330 $ip->set_position(Language::Befunge::Vector->new(4,  4, 3, 0, 0 ));
 331 $ip->get_delta->set_component(0, 1);
 332 $ip->get_delta->set_component(1, 0);
 333 $ls->move_ip_forward( $ip );
 334 is( $ip->get_position->get_component(0), 5, "move_ip_forward respects dx" );
 335 $ls->move_ip_forward( $ip );
 336 is( $ip->get_position->get_component(0), 0, "move_ip_forward wraps max[x]" );
 337 $ip->set_position(Language::Befunge::Vector->new(4,  4, 3, 0, 0 ));
 338 $ip->get_delta->set_component(0, 7);
 339 $ip->get_delta->set_component(1, 0);
 340 $ls->move_ip_forward( $ip );
 341 is( $ip->get_position->get_component(0), 4, "move_ip_forward deals with delta overflowing torus width" );
 342 $ls->move_ip_forward( $ip ); # wrap max[x] harder
 343 is( $ip->get_position->get_component(0), 4, "move_ip_forward deals with delta overflowing torus width" );
 344 $ip->set_position(Language::Befunge::Vector->new(4,  0, 4, 0, 0 ));
 345 $ip->get_delta->set_component(0, -1);
 346 $ip->get_delta->set_component(1, 0);
 347 $ls->move_ip_forward( $ip );
 348 is( $ip->get_position->get_component(0), 5, "move_ip_forward wraps min[x]" );
 349
 350 $ip->set_position(Language::Befunge::Vector->new(4,  2, 9, 0, 0 ));
 351 $ip->get_delta->set_component(0, 0);
 352 $ip->get_delta->set_component(1, 1);
 353 $ls->move_ip_forward( $ip );
 354 is( $ip->get_position->get_component(1), 10, "move_ip_forward respects dy" );
 355 $ls->move_ip_forward( $ip );
 356 is( $ip->get_position->get_component(1), 0,  "move_ip_forward wraps max[y]" );
 357 $ip->set_position(Language::Befunge::Vector->new(4,  2, 9, 0, 0 ));
 358 $ip->get_delta->set_component(0, 0);
 359 $ip->get_delta->set_component(1, 12);               # apply delta that overflows torus height
 360 $ls->move_ip_forward( $ip );
 361 is( $ip->get_position->get_component(1), 9, "move_ip_forward deals with delta overflowing torus heigth" );
 362 $ls->move_ip_forward( $ip ); # wrap max[y] harder
 363 is( $ip->get_position->get_component(1), 9, "move_ip_forward deals with delta overflowing torus heigth" );
 364 $ip->set_position(Language::Befunge::Vector->new(4,  1, 0, 0, 0 ));
 365 $ip->get_delta->set_component(0, 0);
 366 $ip->get_delta->set_component(1, -1);
 367 $ls->move_ip_forward( $ip );
 368 is( $ip->get_position->get_component(1), 10, "move_ip_forward wraps min[y]" );
 369 BEGIN { $tests += 10 }
 370
 371 $ls->clear;   # "negative" playfield.
 372 $ls->_enlarge(Language::Befunge::Vector->new(4, -1, -3, -5, -2));
 373 $ls->_enlarge(Language::Befunge::Vector->new(4,  5, 10,  5,  2));
 374 $ip->set_position(Language::Befunge::Vector->new(4,  4, 3, 0, 0 ));
 375 $ip->get_delta->set_component(0, 1);
 376 $ip->get_delta->set_component(1, 0);
 377 $ls->move_ip_forward( $ip );
 378 is( $ip->get_position->get_component(0), 5, "move_ip_forward respects dx" );
 379 $ls->move_ip_forward( $ip );
 380 is( $ip->get_position->get_component(0), -1, "move_ip_forward wraps max[x]" );
 381 $ip->set_position(Language::Befunge::Vector->new(4,  -1, 4, 0, 0 ));
 382 $ip->get_delta->set_component(0, -1);
 383 $ip->get_delta->set_component(1, 0);
 384 $ls->move_ip_forward( $ip );
 385 is( $ip->get_position->get_component(0), 5, "move_ip_forward wraps min[x]" );
 386 $ip->set_position(Language::Befunge::Vector->new(4,  2, 9, 0, 0 ));
 387 $ip->get_delta->set_component(0, 0);
 388 $ip->get_delta->set_component(1, 1);
 389 $ls->move_ip_forward( $ip );
 390 is( $ip->get_position->get_component(1), 10, "move_ip_forward respects dy" );
 391 $ls->move_ip_forward( $ip );
 392 is( $ip->get_position->get_component(1), -3, "move_ip_forward wraps max[y]" );
 393 $ip->set_position(Language::Befunge::Vector->new(4,  1, -3, 0, 0 ));
 394 $ip->get_delta->set_component(0, 0);
 395 $ip->get_delta->set_component(1, -1);
 396 $ls->move_ip_forward( $ip );
 397 is( $ip->get_position->get_component(1), 10, "move_ip_forward wraps min[y]" );
 398 BEGIN { $tests += 6; }
 399
 400 $ls->clear;   # diagonals.
 401 $ls->_enlarge(Language::Befunge::Vector->new(4, -1, -2, 0, 0));
 402 $ls->_enlarge(Language::Befunge::Vector->new(4,  6,  5, 0, 0));
 403 $ip->set_position(Language::Befunge::Vector->new(4, 0, 0, 0, 0));
 404 $ip->get_delta->set_component(0,-2);
 405 $ip->get_delta->set_component(1,-3);
 406 $ls->move_ip_forward( $ip );
 407 is( $ip->get_position->get_component(0), 2, "move_ip_forward deals with diagonals" );
 408 is( $ip->get_position->get_component(1), 3, "move_ip_forward deals with diagonals" );
 409 BEGIN { $tests += 2; }
 410
 411
 412 # label lookup
 413 # four directions.
 414 $ls->clear;
 415 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ));
 416       3
 417       ;
 418       z
 419       a
 420       b
 421       :
 422 2;rab:;:foo;1
 423       :
 424       b
 425       l
 426       a
 427       h
 428       ;
 429       4
 430 EOF
 431 $href = $ls->labels_lookup;
 432 isa_ok( $href, "HASH" );
 433 is( scalar(keys(%$href)), 4, "labels_lookup finds everything" );
 434 is( $href->{foo}[0]->get_component(0), 10,  "labels_lookup finds left-right" );
 435 is( $href->{foo}[0]->get_component(1), 5,   "labels_lookup finds left-right" );
 436 is( $href->{foo}[1]->get_component(0), 1,   "labels_lookup deals with left-right" );
 437 is( $href->{foo}[1]->get_component(1), 0,   "labels_lookup deals with left-right" );
 438 is( $href->{bar}[0]->get_component(0), -2,  "labels_lookup finds right-left" );
 439 is( $href->{bar}[0]->get_component(1), 5,   "labels_lookup finds right-left" );
 440 is( $href->{bar}[1]->get_component(0), -1,  "labels_lookup deals with right-left" );
 441 is( $href->{bar}[1]->get_component(1), 0,   "labels_lookup deals with right-left" );
 442 is( $href->{baz}[0]->get_component(0), 4,   "labels_lookup finds bottom-top" );
 443 is( $href->{baz}[0]->get_component(1), -1,  "labels_lookup finds bottom-top" );
 444 is( $href->{baz}[1]->get_component(0), 0,   "labels_lookup deals with bottom-top" );
 445 is( $href->{baz}[1]->get_component(1), -1,  "labels_lookup deals with bottom-top" );
 446 is( $href->{blah}[0]->get_component(0), 4,  "labels_lookup finds top-bottom" );
 447 is( $href->{blah}[0]->get_component(1), 12, "labels_lookup finds top-bottom" );
 448 is( $href->{blah}[1]->get_component(0), 0,  "labels_lookup deals with top-bottom" );
 449 is( $href->{blah}[1]->get_component(1), 1,  "labels_lookup deals with top-bottom" );
 450 BEGIN { $tests += 18};
 451
 452 # wrapping...
 453 $ls->clear;
 454 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ));
 455 ;1      z  ;   ;:foo
 456 rab:;   a  4      2;
 457         b
 458         :  ;
 459         ;  :
 460            b
 461            l
 462         3  a
 463         ;  h
 464 EOF
 465 $href = $ls->labels_lookup;
 466 is( scalar(keys(%$href)), 4, "labels_lookup finds everything, even wrapping" );
 467 is( $href->{foo}[0]->get_component(0), -1, "labels_lookup finds left-right" );
 468 is( $href->{foo}[0]->get_component(1), -1, "labels_lookup finds left-right" );
 469 is( $href->{foo}[1]->get_component(0), 1,  "labels_lookup deals with left-right" );
 470 is( $href->{foo}[1]->get_component(1), 0,  "labels_lookup deals with left-right" );
 471 is( $href->{bar}[0]->get_component(0), 16, "labels_lookup finds right-left" );
 472 is( $href->{bar}[0]->get_component(1), 0,  "labels_lookup finds right-left" );
 473 is( $href->{bar}[1]->get_component(0), -1, "labels_lookup deals with right-left" );
 474 is( $href->{bar}[1]->get_component(1), 0,  "labels_lookup deals with right-left" );
 475 is( $href->{baz}[0]->get_component(0), 6,  "labels_lookup finds bottom-top" );
 476 is( $href->{baz}[0]->get_component(1), 6,  "labels_lookup finds bottom-top" );
 477 is( $href->{baz}[1]->get_component(0), 0,  "labels_lookup deals with bottom-top" );
 478 is( $href->{baz}[1]->get_component(1), -1, "labels_lookup deals with bottom-top" );
 479 is( $href->{blah}[0]->get_component(0), 9, "labels_lookup finds top-bottom" );
 480 is( $href->{blah}[0]->get_component(1), 0, "labels_lookup finds top-bottom" );
 481 is( $href->{blah}[1]->get_component(0), 0, "labels_lookup deals with top-bottom" );
 482 is( $href->{blah}[1]->get_component(1), 1, "labels_lookup deals with top-bottom" );
 483 BEGIN { $tests += 17 };
 484
 485 # garbage...
 486 $ls->clear;
 487 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ));
 488    ;:foo is foo;1
 489      ;not a label;
 490 EOF
 491 $href = $ls->labels_lookup;
 492 is( scalar(keys(%$href)), 1, "labels_lookup does not looks-alike non-labels" );
 493 is( $href->{foo}[0]->get_component(0), 14, "labels_lookup discards comments" );
 494 is( $href->{foo}[0]->get_component(1), -1, "labels_lookup discards comments" );
 495 is( $href->{foo}[1]->get_component(0), 1,  "labels_lookup discards comments" );
 496 is( $href->{foo}[1]->get_component(1), 0,  "labels_lookup discards comments" );
 497 BEGIN { $tests += 5 };
 498
 499 # double define...
 500 $ls->clear;
 501 $ls->store( <<'EOF', Language::Befunge::Vector->new(4, -2, -1, 0, 0 ));
 502    ;:foo is foo;1
 503    2;another oof:;
 504 EOF
 505 eval { $href = $ls->labels_lookup; };
 506 like( $@, qr/^Help! I found two labels 'foo' in the funge space/,
 507       "labels_lookup chokes on double-defined labels" );
 508 BEGIN { $tests += 1 };
 509
 510
 511
 512 BEGIN { plan tests => $tests };