From 930216fbd0b86c68dd565b7da9f90fdf0dc5fc80 Mon Sep 17 00:00:00 2001 From: =?utf8?q?J=C3=A9r=C3=B4me=20Quelin?= Date: Sat, 17 Jan 2009 13:36:39 +0100 Subject: [PATCH] moved lbi:storage accessor to get_storage() this matches the other accessors of lbi --- lib/Language/Befunge/Interpreter.pm | 20 ++++++++++++-------- lib/Language/Befunge/Ops.pm | 28 ++++++++++++++-------------- t/1-classes/interpreter.t | 28 ++++++++++++++-------------- t/2-ops/flow_repeat.t | 4 ++-- t/2-ops/str_fetch_char.t | 2 +- t/2-ops/str_store_char.t | 4 ++-- t/4-interpreter/trefunge.t | 4 ++-- t/4-interpreter/unefunge.t | 4 ++-- t/5-befunge/a-stdio.t | 2 +- 9 files changed, 50 insertions(+), 46 deletions(-) diff --git a/lib/Language/Befunge/Interpreter.pm b/lib/Language/Befunge/Interpreter.pm index 6f8329a..5890f43 100644 --- a/lib/Language/Befunge/Interpreter.pm +++ b/lib/Language/Befunge/Interpreter.pm @@ -24,6 +24,7 @@ use Class::XSAccessor get_file => 'file', get_params => 'params', get_retval => 'retval', + get_storage => 'storage', get_DEBUG => 'DEBUG', get_curip => 'curip', get_ips => 'ips', @@ -45,7 +46,6 @@ use Class::XSAccessor }, accessors => { input => 'input', - storage => 'storage', _wrapping => '_wrapping', }; @@ -191,7 +191,7 @@ sub new { sub move_ip { my ($self, $ip) = @_; - my $storage = $self->storage; + my $storage = $self->get_storage; my $orig = $ip->get_position; $self->_move_ip_once($ip); my $char; @@ -312,8 +312,8 @@ sub read_file { sub store_code { my ($self, $code) = @_; $self->debug( "Storing code\n" ); - $self->storage->clear; - $self->storage->store( $code ); + $self->get_storage->clear; + $self->get_storage->store( $code ); } @@ -379,8 +379,8 @@ sub process_ip { # Fetch values for this IP. my $v = $ip->get_position; - my $ord = $self->storage->get_value( $v ); - my $char = $self->storage->get_char( $v ); + my $ord = $self->get_storage->get_value( $v ); + my $char = $self->get_storage->get_char( $v ); # Cosmetics. $self->debug( "#".$ip->get_id.":$v: $char (ord=$ord) Stack=(@{$ip->get_toss})\n" ); @@ -453,7 +453,7 @@ sub _do_instruction { # sub _move_ip_once { my ($self, $ip) = @_; - my $storage = $self->storage; + my $storage = $self->get_storage; # fetch the current position of the ip. my $v = $ip->get_position; @@ -484,7 +484,7 @@ sub _move_ip_once { # sub _move_ip_till { my ($self, $ip, $re) = @_; - my $storage = $self->storage; + my $storage = $self->get_storage; my $orig = $ip->get_position; # moving as long as we did not reach the condition. @@ -568,6 +568,10 @@ the parameters of the script (an array reference) the current return value of the interpreter (an integer) +=item get_storage() + +the C object containing the playfield. + =back diff --git a/lib/Language/Befunge/Ops.pm b/lib/Language/Befunge/Ops.pm index aef4efd..f17f7b8 100644 --- a/lib/Language/Befunge/Ops.pm +++ b/lib/Language/Befunge/Ops.pm @@ -86,8 +86,8 @@ sub str_fetch_char { $lbi->_move_ip_once($lbi->get_curip); # .. then fetch value and push it. - my $ord = $lbi->storage->get_value( $ip->get_position ); - my $chr = $lbi->storage->get_char( $ip->get_position ); + my $ord = $lbi->get_storage->get_value( $ip->get_position ); + my $chr = $lbi->get_storage->get_char( $ip->get_position ); $ip->spush( $ord ); # Cosmetics. @@ -109,8 +109,8 @@ sub str_store_char { my $val = $ip->spop; # Storing value. - $lbi->storage->set_value( $ip->get_position, $val ); - my $chr = $lbi->storage->get_char( $ip->get_position ); + $lbi->get_storage->set_value( $ip->get_position, $val ); + my $chr = $lbi->get_storage->get_char( $ip->get_position ); # Cosmetics. $lbi->debug( "storing value $val (char='$chr')\n" ); @@ -471,7 +471,7 @@ sub flow_space { $lbi->_move_ip_till($ip, qr/ /); $lbi->move_ip($lbi->get_curip); - my $char = $lbi->storage->get_char($ip->get_position); + my $char = $lbi->get_storage->get_char($ip->get_position); $lbi->_do_instruction($char); } @@ -499,7 +499,7 @@ sub flow_comments { $lbi->_move_ip_once($ip); # till matching ';' $lbi->_move_ip_once($ip); # till just after matching ';' - my $char = $lbi->storage->get_char($ip->get_position); + my $char = $lbi->get_storage->get_char($ip->get_position); $lbi->_do_instruction($char); } @@ -542,7 +542,7 @@ sub flow_repeat { # fetch instruction to repeat $lbi->move_ip($lbi->get_curip); - my $char = $lbi->storage->get_char($ip->get_position); + my $char = $lbi->get_storage->get_char($ip->get_position); $char eq 'k' and return; # k cannot be itself repeated $kcounter == 0 and return; # nothing to repeat @@ -714,7 +714,7 @@ sub store_get { $v += $ip->get_storage; # Fetching char. - my $val = $lbi->storage->get_value( $v ); + my $val = $lbi->get_storage->get_value( $v ); $ip->spush( $val ); $lbi->debug( "fetching value at $v: pushing $val\n" ); @@ -734,7 +734,7 @@ sub store_put { # Fetching char. my $val = $ip->spop; - $lbi->storage->set_value( $v, $val ); + $lbi->get_storage->set_value( $v, $val ); $lbi->debug( "storing value $val at $v\n" ); } @@ -844,8 +844,8 @@ sub stdio_in_file { # Store the code and the result vector. my ($size) = $flag % 2 - ? ( $lbi->storage->store_binary( $lines, $vin ) ) - : ( $lbi->storage->store( $lines, $vin ) ); + ? ( $lbi->get_storage->store_binary( $lines, $vin ) ) + : ( $lbi->get_storage->store( $lines, $vin ) ); $ip->spush_vec( $size, $vin ); } @@ -863,7 +863,7 @@ sub stdio_out_file { my ($vin) = $ip->spop_vec; $vin += $ip->get_storage; my ($size) = $ip->spop_vec; - my $data = $lbi->storage->rectangle( $vin, $size ); + my $data = $lbi->get_storage->rectangle( $vin, $size ); # Cosmetics. my $vend = $vin + $size; @@ -910,7 +910,7 @@ sub stdio_sys_exec { sub sys_info { my ($lbi) = @_; my $ip = $lbi->get_curip; - my $storage = $lbi->storage; + my $storage = $lbi->get_storage; my $val = $ip->spop; my @infos = (); @@ -1143,7 +1143,7 @@ sub lib_unload { sub lib_run_instruction { my ($lbi) = @_; my $ip = $lbi->get_curip; - my $char = $lbi->storage->get_char( $ip->get_position ); + my $char = $lbi->get_storage->get_char( $ip->get_position ); # Maybe a library semantics. $lbi->debug( "library semantics\n" ); diff --git a/t/1-classes/interpreter.t b/t/1-classes/interpreter.t index b1c7861..0ce04af 100644 --- a/t/1-classes/interpreter.t +++ b/t/1-classes/interpreter.t @@ -26,38 +26,38 @@ my $interp = Language::Befunge::Interpreter->new(); isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 2, "default number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::2D::Sparse', "storage object"); -is($interp->storage->get_dims, 2, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::2D::Sparse', "storage object"); +is($interp->get_storage->get_dims, 2, "storage has same number of dimensions"); # templates $interp = Language::Befunge::Interpreter->new({ syntax => 'befunge98' }); isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 2, "default number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::2D::Sparse', "storage object"); -is($interp->storage->get_dims, 2, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::2D::Sparse', "storage object"); +is($interp->get_storage->get_dims, 2, "storage has same number of dimensions"); $interp = Language::Befunge::Interpreter->new({ syntax => 'unefunge98' }); isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 1, "correct number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); -is($interp->storage->get_dims, 1, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); +is($interp->get_storage->get_dims, 1, "storage has same number of dimensions"); $interp = Language::Befunge::Interpreter->new({ syntax => 'trefunge98' }); isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 3, "correct number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); -is($interp->storage->get_dims, 3, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); +is($interp->get_storage->get_dims, 3, "storage has same number of dimensions"); # by dims $interp = Language::Befunge::Interpreter->new({ dims => 5 }); isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 5, "correct number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); -is($interp->storage->get_dims, 5, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object"); +is($interp->get_storage->get_dims, 5, "storage has same number of dimensions"); # special storage requirement $interp = Language::Befunge::Interpreter->new({ @@ -66,21 +66,21 @@ $interp = Language::Befunge::Interpreter->new({ isa_ok($interp, "Language::Befunge::Interpreter"); is($interp->get_dimensions, 2, "correct number of dimensions"); is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs"); -isa_ok($interp->storage, 'Language::Befunge::Storage::Generic::Vec', "storage object"); -is($interp->storage->get_dims, 2, "storage has same number of dimensions"); +isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::Vec', "storage object"); +is($interp->get_storage->get_dims, 2, "storage has same number of dimensions"); # syntax combinations like "4funge98" are supported $interp = Language::Befunge::Interpreter->new({ syntax => '4funge98', storage => 'Language::Befunge::Storage::Generic::Vec' }); -is(ref($interp->storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); +is(ref($interp->get_storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); is($$interp{dimensions}, 4, 'dims inferred from syntax name'); ok(exists($$interp{ops}{m}), 'GenericFunge98 ops used'); $interp = Language::Befunge::Interpreter->new({ syntax => '4funge98', wrapping => 'Language::Befunge::Wrapping::LaheySpace' }); is(ref($interp->_wrapping), 'Language::Befunge::Wrapping::LaheySpace', 'wrapping specified'); -is(ref($interp->storage), 'Language::Befunge::Storage::Generic::AoA', 'default storage'); +is(ref($interp->get_storage), 'Language::Befunge::Storage::Generic::AoA', 'default storage'); $interp = Language::Befunge::Interpreter->new({ syntax => '4funge98', ops => 'Language::Befunge::Ops::Unefunge98' }); diff --git a/t/2-ops/flow_repeat.t b/t/2-ops/flow_repeat.t index 85c05b5..23738c5 100644 --- a/t/2-ops/flow_repeat.t +++ b/t/2-ops/flow_repeat.t @@ -49,7 +49,7 @@ $v = Language::Befunge::Vector->new(1,0); $ip->set_delta( $v ); $lbi->store_code( '789q' ); $v = Language::Befunge::Vector->new(1,0); -$lbi->storage->set_value( $v, 400 ); +$lbi->get_storage->set_value( $v, 400 ); $ip->spush( 3 ); Language::Befunge::Ops::flow_repeat( $lbi ); is( $ip->get_delta, '(-1,0)', 'flow_repeat repeats also instructions >256' ); @@ -61,7 +61,7 @@ $v = Language::Befunge::Vector->new(1,0); $ip->set_delta( $v ); $lbi->store_code( '789q' ); $v = Language::Befunge::Vector->new(1,0); -$lbi->storage->set_value( $v, -4 ); +$lbi->get_storage->set_value( $v, -4 ); $ip->spush( 3 ); Language::Befunge::Ops::flow_repeat( $lbi ); is( $ip->get_delta, '(-1,0)', 'flow_repeat repeats also negative instructions' ); diff --git a/t/2-ops/str_fetch_char.t b/t/2-ops/str_fetch_char.t index 4f3f703..4f7bb3b 100644 --- a/t/2-ops/str_fetch_char.t +++ b/t/2-ops/str_fetch_char.t @@ -27,7 +27,7 @@ $ip = Language::Befunge::IP->new; $v = Language::Befunge::Vector->new(1,0); $ip->set_delta( $v ); $lbi->set_curip( $ip ); -$lbi->storage->set_value( $v, ord('A') ); +$lbi->get_storage->set_value( $v, ord('A') ); Language::Befunge::Ops::str_fetch_char( $lbi ); is( $ip->get_position, '(1,0)', 'str_fetch_char moves ip' ); is( $ip->spop, 65, 'str_fetch_char pushes value on ip' ); diff --git a/t/2-ops/str_store_char.t b/t/2-ops/str_store_char.t index 4df255c..c605186 100644 --- a/t/2-ops/str_store_char.t +++ b/t/2-ops/str_store_char.t @@ -28,9 +28,9 @@ $v = Language::Befunge::Vector->new(1,0); $ip->set_delta( $v ); $ip->spush( ord('A') ); $lbi->set_curip( $ip ); -$lbi->storage->set_value( $v, ord('B') ); # to enlarge storage +$lbi->get_storage->set_value( $v, ord('B') ); # to enlarge storage Language::Befunge::Ops::str_store_char( $lbi ); is( $ip->get_position, '(1,0)', 'str_store_char moves ip' ); is( $ip->spop, 0, 'str_store_char pops value from ip' ); -is( $lbi->storage->get_value( $v ), ord('A'), +is( $lbi->get_storage->get_value( $v ), ord('A'), 'str_store_char oversrites next instruction from the char on the stack' ); diff --git a/t/4-interpreter/trefunge.t b/t/4-interpreter/trefunge.t index 0d39c3b..0496e52 100644 --- a/t/4-interpreter/trefunge.t +++ b/t/4-interpreter/trefunge.t @@ -58,7 +58,7 @@ BEGIN { $tests += 1 }; $tref = Language::Befunge->new({ syntax => 'trefunge98', storage => 'Language::Befunge::Storage::Generic::Vec' }); -is(ref($tref->storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); +is(ref($tref->get_storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); $tref = Language::Befunge->new({ syntax => 'trefunge98', wrapping => 'Language::Befunge::Wrapping::LaheySpace' }); @@ -129,7 +129,7 @@ BEGIN { $tests += 1 }; # rectangle() returns the original box again chomp $code; -is($tref->storage->rectangle(LBV->new(0,0,0), LBV->new(9,2,2)), $code, 'rectangle works'); +is($tref->get_storage->rectangle(LBV->new(0,0,0), LBV->new(9,2,2)), $code, 'rectangle works'); BEGIN { $tests += 1 }; BEGIN { plan tests => $tests }; diff --git a/t/4-interpreter/unefunge.t b/t/4-interpreter/unefunge.t index e3de678..fb4de93 100644 --- a/t/4-interpreter/unefunge.t +++ b/t/4-interpreter/unefunge.t @@ -58,7 +58,7 @@ BEGIN { $tests += 1 }; $unef = Language::Befunge->new({ syntax => 'unefunge98', storage => 'Language::Befunge::Storage::Generic::Vec' }); -is(ref($unef->storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); +is(ref($unef->get_storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified'); $unef = Language::Befunge->new({ syntax => 'unefunge98', wrapping => 'Language::Befunge::Wrapping::LaheySpace' }); @@ -123,7 +123,7 @@ is( $out, "1 2 " ); BEGIN { $tests += 1 }; # rectangle() just returns the original string again -is($unef->storage->rectangle(LBV->new(0), LBV->new(9)), '1#q.2^3.q', 'rectangle works'); +is($unef->get_storage->rectangle(LBV->new(0), LBV->new(9)), '1#q.2^3.q', 'rectangle works'); BEGIN { $tests += 1 }; BEGIN { plan tests => $tests }; diff --git a/t/5-befunge/a-stdio.t b/t/5-befunge/a-stdio.t index 92fd840..0da0a69 100644 --- a/t/5-befunge/a-stdio.t +++ b/t/5-befunge/a-stdio.t @@ -135,7 +135,7 @@ v qiv# "t/_resources/hello.bf"0 < END_OF_CODE $bef->run_code; $out = slurp; -is( $bef->storage->rectangle +is( $bef->get_storage->rectangle ( Language::Befunge::Vector->new( 6, 9), Language::Befunge::Vector->new( 71, 1) ), qq{v q ,,,,,,,,,,,,,"hello world!"a <\n> ^} ); -- 2.11.4.GIT