7 use Moose::Util::TypeConstraints;
16 append_curried => [ append => '!' ],
18 prepend_curried => [ prepend => '-' ],
20 replace_curried => [ replace => qr/(.)$/, sub { uc $1 } ],
25 match_curried => [ match => qr/\D/ ],
28 substr_curried_1 => [ substr => (1) ],
29 substr_curried_2 => [ substr => ( 1, 3 ) ],
30 substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ],
38 my $class = Moose::Meta::Class->create(
40 superclasses => ['Moose::Object'],
43 $class->add_attribute(
50 clearer => '_clear_string',
55 return ( $class->name, \%handles );
60 run_tests(build_class);
61 run_tests( build_class( lazy => 1, default => q{} ) );
62 run_tests( build_class( trigger => sub { } ) );
64 # Will force the inlining code to check the entire hashref when it is modified.
65 subtype 'MyStr', as 'Str', where { 1 };
67 run_tests( build_class( isa => 'MyStr' ) );
69 coerce 'MyStr', from 'Str', via { $_ };
71 run_tests( build_class( isa => 'MyStr', coerce => 1 ) );
75 my ( $class, $handles ) = @_;
77 can_ok( $class, $_ ) for sort keys %{$handles};
80 my $obj = $class->new();
82 is( $obj->length, 0, 'length returns zero' );
85 is( $obj->length, 1, 'length returns 1 for new string' );
87 throws_ok { $obj->length(42) }
88 qr/Cannot call length with any arguments/,
89 'length throws an error when an argument is passed';
92 is( $obj->_string, 'b', 'a becomes b after inc' );
94 throws_ok { $obj->inc(42) }
95 qr/Cannot call inc with any arguments/,
96 'inc throws an error when an argument is passed';
99 is( $obj->_string, 'bfoo', 'appended to the string' );
101 throws_ok { $obj->append( 'foo', 2 ) }
102 qr/Cannot call append with more than 1 argument/,
103 'append throws an error when two arguments are passed';
105 $obj->append_curried;
106 is( $obj->_string, 'bfoo!', 'append_curried appended to the string' );
108 throws_ok { $obj->append_curried('foo') }
109 qr/Cannot call append with more than 1 argument/,
110 'append_curried throws an error when two arguments are passed';
112 $obj->_string("has nl$/");
114 is( $obj->_string, 'has nl', 'chomped string' );
118 $obj->_string, 'has nl',
119 'chomp is a no-op when string has no line ending'
122 throws_ok { $obj->chomp(42) }
123 qr/Cannot call chomp with any arguments/,
124 'chomp throws an error when an argument is passed';
127 is( $obj->_string, 'has n', 'chopped string' );
129 throws_ok { $obj->chop(42) }
130 qr/Cannot call chop with any arguments/,
131 'chop throws an error when an argument is passed';
134 $obj->prepend('bar');
135 is( $obj->_string, 'barx', 'prepended to string' );
137 $obj->prepend_curried;
138 is( $obj->_string, '-barx', 'prepend_curried prepended to string' );
140 $obj->replace( qr/([ao])/, sub { uc($1) } );
142 $obj->_string, '-bArx',
143 'substitution using coderef for replacement'
146 $obj->replace( qr/A/, 'X' );
148 $obj->_string, '-bXrx',
149 'substitution using string as replacement'
152 throws_ok { $obj->replace( {}, 'x' ) }
153 qr/The first argument passed to replace must be a string or regexp reference/,
154 'replace throws an error when the first argument is not a string or regexp';
156 throws_ok { $obj->replace( qr/x/, {} ) }
157 qr/The second argument passed to replace must be a string or code reference/,
158 'replace throws an error when the first argument is not a string or regexp';
160 $obj->_string('Moosex');
161 $obj->replace_curried;
162 is( $obj->_string, 'MooseX', 'capitalize last' );
164 $obj->_string('abcdef');
167 [ $obj->match(qr/([az]).*([fy])/) ], [ 'a', 'f' ],
168 'match -barx against /[aq]/ returns matches'
172 scalar $obj->match('b'),
173 'match with string as argument returns true'
176 throws_ok { $obj->match }
177 qr/Cannot call match without at least 1 argument/,
178 'match throws an error when no arguments are passed';
180 throws_ok { $obj->match( {} ) }
181 qr/The argument passed to match must be a string or regexp reference/,
182 'match throws an error when an invalid argument is passed';
184 $obj->_string('1234');
185 ok( !$obj->match_curried, 'match_curried returns false' );
187 $obj->_string('one two three four');
188 ok( $obj->match_curried, 'match curried returns true' );
191 is( $obj->_string, q{}, 'clear' );
193 throws_ok { $obj->clear(42) }
194 qr/Cannot call clear with any arguments/,
195 'clear throws an error when an argument is passed';
197 $obj->_string('some long string');
199 $obj->substr(1), 'ome long string',
200 'substr as getter with one argument'
203 $obj->_string('some long string');
205 $obj->substr( 1, 3 ), 'ome',
206 'substr as getter with two arguments'
209 $obj->substr( 1, 3, 'ong' );
212 $obj->_string, 'song long string',
213 'substr as setter with three arguments'
216 throws_ok { $obj->substr }
217 qr/Cannot call substr without at least 1 argument/,
218 'substr throws an error when no argumemts are passed';
220 throws_ok { $obj->substr( 1, 2, 3, 4 ) }
221 qr/Cannot call substr with more than 3 arguments/,
222 'substr throws an error when four argumemts are passed';
224 throws_ok { $obj->substr( {} ) }
225 qr/The first argument passed to substr must be an integer/,
226 'substr throws an error when first argument is not an integer';
228 throws_ok { $obj->substr( 1, {} ) }
229 qr/The second argument passed to substr must be a positive integer/,
230 'substr throws an error when second argument is not a positive integer';
232 throws_ok { $obj->substr( 1, 2, {} ) }
233 qr/The third argument passed to substr must be a string/,
234 'substr throws an error when third argument is not a string';
236 $obj->_string('some long string');
239 $obj->substr_curried_1, 'ome long string',
240 'substr_curried_1 returns expected value'
244 $obj->substr_curried_1(3), 'ome',
245 'substr_curried_1 with one argument returns expected value'
248 $obj->substr_curried_1( 3, 'ong' );
251 $obj->_string, 'song long string',
252 'substr_curried_1 as setter with two arguments'
255 $obj->_string('some long string');
258 $obj->substr_curried_2, 'ome',
259 'substr_curried_2 returns expected value'
262 $obj->substr_curried_2('ong');
265 $obj->_string, 'song long string',
266 'substr_curried_2 as setter with one arguments'
269 $obj->_string('some long string');
271 $obj->substr_curried_3;
274 $obj->_string, 'song long string',
275 'substr_curried_3 as setter'
278 if ( $class->meta->get_attribute('_string')->is_lazy ) {
279 my $obj = $class->new;
284 $obj->_string, 'foo',
285 'append with lazy default'