qw(
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access = []";
}
+sub _return_value { return q{} }
+
no Moose::Role;
1;
_maximum_arguments
_inline_check_arguments
_inline_optimized_set_new_value
+ _return_value
)
],
};
my ( $self, $slot_access ) = @_;
return
- "( do { my \@potential = \@{ $slot_access }; splice \@potential, \$_[0], 1; \\\@potential } )";
+ "( do { my \@potential = \@{ $slot_access }; \@return = splice \@potential, \$_[0], 1; \\\@potential } )";
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "splice \@{ $slot_access }, \$_[0], 1";
+ return "\@return = splice \@{ $slot_access }, \$_[0], 1";
+}
+
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return 'return $return[0];';
}
no Moose::Role;
_maximum_arguments
_new_members
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "splice \@{ $slot_access }, \$_[0], 0, \$_[1];";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return ${slot_access}->[ \$_[0] ];";
+}
+
no Moose::Role;
1;
use Moose::Role;
-with 'Moose::Meta::Method::Accessor::Native::Array::Writer' =>
- { -excludes => ['_inline_optimized_set_new_value'] };
+with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
+ -excludes => [
+ qw(
+ _inline_optimized_set_new_value
+ _return_value
+ )
+ ]
+};
sub _adds_members { 1 }
return "push \@{ $slot_access }, \@_";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return scalar \@{ $slot_access }";
+}
+
no Moose::Role;
1;
_inline_check_arguments
_new_members
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "${slot_access}->[ \$_[0] ] = \$_[1]";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return ${slot_access}->[ \$_[0] ];";
+}
+
no Moose::Role;
1;
qw(
_maximum_arguments
_inline_check_arguments
+ _return_value
)
]
};
"[ \$_[0] ? sort { \$_[0]->( \$a, \$b ) } \@{ $slot_access } : sort \@{ $slot_access} ]";
}
+sub _return_value { return q{} }
+
no Moose::Role;
1;
_inline_process_arguments
_inline_check_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
my ( $self, $slot_access ) = @_;
return "( do { my \@potential = \@{ $slot_access };"
- . 'defined $len ? ( splice @potential, $idx, $len, @_ ) : ( splice @potential, $idx ); \\@potential } )';
+ . '@return = defined $len ? ( splice @potential, $idx, $len, @_ ) : ( splice @potential, $idx ); \\@potential } )';
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "defined \$len ? ( splice \@{ $slot_access }, \$idx, \$len, \@_ ) : ( splice \@{ $slot_access }, \$idx )";
+ return "\@return = defined \$len ? ( splice \@{ $slot_access }, \$idx, \$len, \@_ ) : ( splice \@{ $slot_access }, \$idx )";
+}
+
+sub _return_value {
+ my ($self, $slot_access) = @_;
+
+ return 'return wantarray ? @return : $return[-1]';
}
no Moose::Role;
use Moose::Role;
-with 'Moose::Meta::Method::Accessor::Native::Array::Writer' =>
- { -excludes => ['_inline_optimized_set_new_value'] };
+with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
+ -excludes => [
+ qw(
+ _inline_optimized_set_new_value
+ _return_value
+ )
+ ]
+};
sub _adds_members { 1 }
return "unshift \@{ $slot_access }, \@_";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return scalar \@{ $slot_access }";
+}
+
no Moose::Role;
1;
_inline_optimized_set_new_value
)
]
-};
+ };
sub _maximum_arguments { 0 }
_minimum_arguments
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access -= defined \$_[0] ? \$_[0] : 1";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return $slot_access;";
+}
+
no Moose::Role;
1;
_minimum_arguments
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access += defined \$_[0] ? \$_[0] : 1";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return $slot_access;";
+}
+
no Moose::Role;
1;
qw(
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access = \$attr->default(\$self)";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return $slot_access;";
+}
+
no Moose::Role;
1;
_minimum_arguments
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access = \$_[0];";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return $slot_access;";
+}
+
no Moose::Role;
1;
qw(
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
return "$slot_access = {}";
}
+sub _return_value { return q{} }
+
no Moose::Role;
1;
use Moose::Role;
-with 'Moose::Meta::Method::Accessor::Native::Hash::Writer' =>
- { -excludes => ['_inline_optimized_set_new_value'] };
+with 'Moose::Meta::Method::Accessor::Native::Hash::Writer' => {
+ -excludes => [
+ qw(
+ _inline_optimized_set_new_value
+ _return_value
+ )
+ ],
+};
sub _adds_members { 0 }
sub _potential_value {
my ( $self, $slot_access ) = @_;
- return "( do { my \%potential = %{ $slot_access }; delete \@potential{\@_}; \\\%potential; } )";
+ return "( do { my \%potential = %{ $slot_access }; \@return = delete \@potential{\@_}; \\\%potential; } )";
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "delete \@{ $slot_access }{\@_}";
+ return "\@return = delete \@{ $slot_access }{\@_}";
+}
+
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return 'return wantarray ? @return : $return[-1];';
}
no Moose::Role;
_inline_process_arguments
_inline_check_arguments
_inline_optimized_set_new_value
+ _return_value
)
],
};
return "\@{ $slot_access }{ \@_[ \@keys_idx] } = \@_[ \@values_idx ]";
}
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return "return wantarray ? \@{ $slot_access }{ \@_[ \@keys_idx ] } : ${slot_access}->{ \$_[ \$keys_idx[0] ] };";
+}
+
no Moose::Role;
1;
_inline_optimized_set_new_value
)
]
-};
+ };
sub _maximum_arguments {0}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
sub _maximum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments {1}
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments { 1 }
qw(
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
-sub _maximum_arguments { 0 }
+sub _maximum_arguments {0}
sub _potential_value {
my ( $self, $slot_access ) = @_;
- return "( do { my \$val = $slot_access; chomp \$val; \$val } )";
+ return "( do { my \$val = $slot_access; \@return = chomp \$val; \$val } )";
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "chomp $slot_access";
+ return "\@return = chomp $slot_access";
+}
+
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return '$return[0]';
}
no Moose::Role;
qw(
_maximum_arguments
_inline_optimized_set_new_value
+ _return_value
)
]
};
sub _potential_value {
my ( $self, $slot_access ) = @_;
- return "( do { my \$val = $slot_access; chop \$val; \$val } )";
+ return "( do { my \$val = $slot_access; \@return = chop \$val; \$val } )";
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "chop $slot_access";
+ return "\@return = chop $slot_access";
+}
+
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return '$return[0]';
}
no Moose::Role;
_inline_optimized_set_new_value
)
]
-};
+ };
sub _maximum_arguments { 0 }
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments { 1 }
_inline_optimized_set_new_value
)
]
-};
+ };
sub _minimum_arguments { 1 }
my ( $self, $slot_access ) = @_;
return
- "( do { my \$potential = $slot_access; substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
+ "( do { my \$potential = $slot_access; \@return = substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
}
sub _inline_optimized_set_new_value {
my ( $self, $inv, $new, $slot_access ) = @_;
- return "substr $slot_access, \$offset, \$length, \$replacement";
+ return "\@return = substr $slot_access, \$offset, \$length, \$replacement";
}
sub _return_value {
my ( $self, $slot_access, $for_writer ) = @_;
- return q{} if $for_writer;
+ return '$return[0]' if $for_writer;
return "substr $slot_access, \$offset, \$length";
}
my $potential_value = $self->_potential_value($slot_access);
+ if ( $self->_return_value($slot_access) ) {
+ # some writers will save the return value in this variable when they
+ # generate the potential value.
+ $code .= "\n" . 'my @return;';
+ }
+
$code .= "\n" . $self->_inline_copy_native_value( \$potential_value );
$code .= "\n"
. $self->_inline_tc_code(
return $self->_inline_store(@_);
}
-sub _return_value { return q{} }
+sub _return_value {
+ my ( $self, $slot_access ) = @_;
+
+ return $slot_access;
+}
no Moose::Role;
lives_ok { $obj->push() } 'call to push without arguments lives';
- lives_ok { $obj->unshift( 101, 22 ) }
+ lives_and {
+ is( $obj->unshift( 101, 22 ), 8,
+ 'unshift returns size of the new array' );
+ }
'unshifted two values and lived';
is_deeply(
qr/Cannot call get with more than 1 argument/,
'throws an error when get_curried is called with an argument';
- lives_ok { $obj->set( 1, 100 ) } 'set value at index 1 lives';
+ lives_and {
+ is( $obj->set( 1, 100 ), 100, 'set returns new value' );
+ }
+ 'set value at index 1 lives';
is( $obj->get(1), 100, 'get value at index 1 returns new value' );
+
throws_ok { $obj->set( 1, 99, 42 ) }
qr/Cannot call set with more than 2 arguments/,
'throws an error when set is called with three arguments';
'accessor with one argument returns value at index 1'
);
- lives_ok { $obj->accessor( 1 => 97 ) } 'accessor as writer lives';
+ lives_and {
+ is( $obj->accessor( 1 => 97 ), 97, 'accessor returns new value' );
+ }
+ 'accessor as writer lives';
is(
$obj->get(1), 97,
'throws an error when is_empty is called with an argument';
$obj->clear;
- $obj->push( 1, 5, 10, 42 );
+ is(
+ $obj->push( 1, 5, 10, 42 ), 4,
+ 'pushed 4 elements, got number of elements in the array back'
+ );
- lives_ok { $obj->delete(2) } 'delete lives';
+ lives_and {
+ is( $obj->delete(2), 10, 'delete returns deleted value' );
+ }
+ 'delete lives';
is_deeply(
$obj->_values, [ 1, 5, 42 ],
qr/Cannot call insert with more than 2 arguments/,
'throws an error when insert is called with three arguments';
- lives_ok { $obj->splice( 1, 0, 2, 3 ) } 'splice lives';
+ lives_and {
+ is_deeply(
+ [ $obj->splice( 1, 0, 2, 3 ) ],
+ [],
+ 'return value of splice is empty list when not removing elements'
+ );
+ }
+ 'splice lives';
is_deeply(
$obj->_values, [ 1, 2, 3, 21, 42 ],
'splice added the specified elements'
);
- lives_ok { $obj->splice( 1, 1, 99 ) } 'splice lives';
+ lives_and {
+ is_deeply(
+ [ $obj->splice( 1, 2, 99 ) ],
+ [ 2, 3 ],
+ 'splice returns list of removed values'
+ );
+ }
+ 'splice lives';
is_deeply(
- $obj->_values, [ 1, 99, 3, 21, 42 ],
+ $obj->_values, [ 1, 99, 21, 42 ],
'splice added the specified elements'
);
'splice_curried_1 lives';
is_deeply(
- $obj->_values, [ 1, 101, 21, 42 ],
+ $obj->_values, [ 1, 101, 42 ],
'splice added the specified elements'
);
lives_ok { $obj->splice_curried_2(102) } 'splice_curried_2 lives';
is_deeply(
- $obj->_values, [ 1, 102, 42 ],
+ $obj->_values, [ 1, 102 ],
'splice added the specified elements'
);
'splice added the specified elements'
);
+ is_deeply(
+ scalar $obj->splice( 1, 2 ),
+ 4,
+ 'splice in scalar context returns last element removed'
+ );
+
+ is_deeply(
+ scalar $obj->splice( 1, 0, 42 ),
+ undef,
+ 'splice in scalar context returns undef when no elements are removed'
+ );
+
$obj->_values( [ 3, 9, 5, 22, 11 ] );
is_deeply(
with_immutable {
my $obj = $class->new;
- $obj->illuminate;
+ ok( $obj->illuminate, 'set returns true' );
ok( $obj->is_lit, 'set is_lit to 1 using ->illuminate' );
ok( !$obj->is_dark, 'check if is_dark does the right thing' );
qr/Cannot call set with any arguments/,
'set throws an error when an argument is passed';
- $obj->darken;
+ ok( !$obj->darken, 'unset returns false' );
ok( !$obj->is_lit, 'set is_lit to 0 using ->darken' );
ok( $obj->is_dark, 'check if is_dark does the right thing' );
qr/Cannot call unset with any arguments/,
'unset throws an error when an argument is passed';
- $obj->flip_switch;
+ ok( $obj->flip_switch, 'toggle returns new value' );
ok( $obj->is_lit, 'toggle is_lit back to 1 using ->flip_switch' );
ok( !$obj->is_dark, 'check if is_dark does the right thing' );
is( $obj->counter, 0, '... got the default value' );
- $obj->inc_counter;
+ is( $obj->inc_counter, 1, 'inc returns new value' );
is( $obj->counter, 1, '... got the incremented value' );
- $obj->inc_counter;
+ is( $obj->inc_counter, 2, 'inc returns new value' );
is( $obj->counter, 2, '... got the incremented value (again)' );
throws_ok { $obj->inc_counter( 1, 2 ) }
qr/Cannot call inc with more than 1 argument/,
'inc throws an error when two arguments are passed';
- $obj->dec_counter;
+ is( $obj->dec_counter, 1, 'dec returns new value' );
is( $obj->counter, 1, '... got the decremented value' );
throws_ok { $obj->dec_counter( 1, 2 ) }
qr/Cannot call dec with more than 1 argument/,
'dec throws an error when two arguments are passed';
- $obj->reset_counter;
+ is( $obj->reset_counter, 0, 'reset returns new value' );
is( $obj->counter, 0, '... got the original value' );
throws_ok { $obj->reset_counter(2) }
qr/Cannot call reset with any arguments/,
'reset throws an error when an argument is passed';
- $obj->set_counter(5);
+ is( $obj->set_counter(5), 5, 'set returns new value' );
is( $obj->counter, 5, '... set the value' );
throws_ok { $obj->set_counter( 1, 2 ) }
is_deeply( $obj->options, {}, '... no options yet' );
ok( !$obj->has_option('foo'), '... we have no foo option' );
- lives_ok {
- $obj->set_option( foo => 'bar' );
+ lives_and {
+ is(
+ $obj->set_option( foo => 'bar' ),
+ 'bar',
+ 'set return single new value in scalar context'
+ );
}
'... set the option okay';
[qw(bar baz blah flop)], "get multiple options at once"
);
- lives_ok {
- $obj->delete_option('bar');
+ lives_and {
+ is( scalar $obj->delete_option('bar'), 'baz',
+ 'delete returns deleted value' );
}
'... deleted the option okay';
lives_ok {
- $obj->delete_option( 'oink', 'xxy' );
+ is_deeply(
+ [ $obj->delete_option( 'oink', 'xxy' ) ],
+ [ 'blah', 'flop' ],
+ 'delete returns all deleted values in list context'
+ );
}
'... deleted multiple option okay';
}
'... bad constructor params';
- $obj->set_option( oink => "blah", xxy => "flop" );
+ is_deeply(
+ [ $obj->set_option( oink => "blah", xxy => "flop" ) ],
+ [ 'blah', 'flop' ],
+ 'set returns newly set values in order of keys provided'
+ );
+
my @key_value = sort { $a->[0] cmp $b->[0] } $obj->key_value;
is_deeply(
\@key_value,
is( $obj->integer, 5, 'Default to five' );
- $obj->add(10);
+ is( $obj->add(10), 15, 'add returns new value' );
is( $obj->integer, 15, 'Add ten for fithteen' );
qr/Cannot call add with more than 1 argument/,
'add throws an error when 2 arguments are passed';
- $obj->sub(3);
+ is( $obj->sub(3), 12, 'sub returns new value' );
is( $obj->integer, 12, 'Subtract three for 12' );
qr/Cannot call sub with more than 1 argument/,
'sub throws an error when 2 arguments are passed';
- $obj->set(10);
+ is( $obj->set(10), 10, 'set returns new value' );
is( $obj->integer, 10, 'Set to ten' );
qr/Cannot call set with more than 1 argument/,
'set throws an error when 2 arguments are passed';
- $obj->div(2);
+ is( $obj->div(2), 5, 'div returns new value' );
is( $obj->integer, 5, 'divide by 2' );
qr/Cannot call div with more than 1 argument/,
'div throws an error when 2 arguments are passed';
- $obj->mul(2);
+ is( $obj->mul(2), 10, 'mul returns new value' );
is( $obj->integer, 10, 'multiplied by 2' );
qr/Cannot call mul with more than 1 argument/,
'mul throws an error when 2 arguments are passed';
- $obj->mod(2);
+ is( $obj->mod(2), 0, 'mod returns new value' );
is( $obj->integer, 0, 'Mod by 2' );
$obj->set(-1);
- $obj->abs;
+ is( $obj->abs, 1, 'abs returns new value' );
throws_ok { $obj->abs(10) }
qr/Cannot call abs with any arguments/,
qr/Cannot call length with any arguments/,
'length throws an error when an argument is passed';
- $obj->inc;
+ is( $obj->inc, 'b', 'inc returns new value' );
is( $obj->_string, 'b', 'a becomes b after inc' );
throws_ok { $obj->inc(42) }
qr/Cannot call inc with any arguments/,
'inc throws an error when an argument is passed';
- $obj->append('foo');
+ is( $obj->append('foo'), 'bfoo', 'append returns new value' );
is( $obj->_string, 'bfoo', 'appended to the string' );
throws_ok { $obj->append( 'foo', 2 ) }
'append_curried throws an error when two arguments are passed';
$obj->_string("has nl$/");
- $obj->chomp;
+ is( $obj->chomp, 1, 'chomp returns number of characters removed' );
is( $obj->_string, 'has nl', 'chomped string' );
- $obj->chomp;
+ is( $obj->chomp, 0, 'chomp returns number of characters removed' );
is(
$obj->_string, 'has nl',
'chomp is a no-op when string has no line ending'
qr/Cannot call chomp with any arguments/,
'chomp throws an error when an argument is passed';
- $obj->chop;
+ is( $obj->chop, 'l', 'chop returns character removed' );
is( $obj->_string, 'has n', 'chopped string' );
throws_ok { $obj->chop(42) }
'chop throws an error when an argument is passed';
$obj->_string('x');
- $obj->prepend('bar');
+ is( $obj->prepend('bar'), 'barx', 'prepend returns new value' );
is( $obj->_string, 'barx', 'prepended to string' );
$obj->prepend_curried;
is( $obj->_string, '-barx', 'prepend_curried prepended to string' );
- $obj->replace( qr/([ao])/, sub { uc($1) } );
+ is(
+ $obj->replace( qr/([ao])/, sub { uc($1) } ),
+ '-bArx',
+ 'replace returns new value'
+ );
+
is(
$obj->_string, '-bArx',
'substitution using coderef for replacement'
'substr as getter with two arguments'
);
- $obj->substr( 1, 3, 'ong' );
+ is(
+ $obj->substr( 1, 3, 'ong' ),
+ 'ome',
+ 'substr as setter returns replaced string'
+ );
is(
$obj->_string, 'song long string',
projects / gitmo/Moose.git / commitdiff