15 append_curried => [ append => '!' ],
17 prepend_curried => [ prepend => '-' ],
19 replace_curried => [ replace => qr/(.)$/, sub { uc $1 } ],
24 match_curried => [ match => qr/\D/ ],
27 substr_curried_1 => [ substr => (1) ],
28 substr_curried_2 => [ substr => ( 1, 3 ) ],
29 substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ],
37 my $class = Moose::Meta::Class->create(
39 superclasses => ['Moose::Object'],
42 $class->add_attribute(
49 clearer => '_clear_string',
54 return ( $class->name, \%handles );
59 run_tests(build_class);
60 run_tests( build_class( lazy => 1, default => q{} ) );
64 my ( $class, $handles ) = @_;
66 can_ok( $class, $_ ) for sort keys %{$handles};
69 my $obj = $class->new();
71 is( $obj->length, 0, 'length returns zero' );
74 is( $obj->length, 1, 'length returns 1 for new string' );
76 throws_ok { $obj->length(42) }
77 qr/Cannot call length with any arguments/,
78 'length throws an error when an argument is passed';
81 is( $obj->_string, 'b', 'a becomes b after inc' );
83 throws_ok { $obj->inc(42) }
84 qr/Cannot call inc with any arguments/,
85 'inc throws an error when an argument is passed';
88 is( $obj->_string, 'bfoo', 'appended to the string' );
90 throws_ok { $obj->append( 'foo', 2 ) }
91 qr/Cannot call append with more than 1 argument/,
92 'append throws an error when two arguments are passed';
95 is( $obj->_string, 'bfoo!', 'append_curried appended to the string' );
97 throws_ok { $obj->append_curried('foo') }
98 qr/Cannot call append with more than 1 argument/,
99 'append_curried throws an error when two arguments are passed';
101 $obj->_string("has nl$/");
103 is( $obj->_string, 'has nl', 'chomped string' );
107 $obj->_string, 'has nl',
108 'chomp is a no-op when string has no line ending'
111 throws_ok { $obj->chomp(42) }
112 qr/Cannot call chomp with any arguments/,
113 'chomp throws an error when an argument is passed';
116 is( $obj->_string, 'has n', 'chopped string' );
118 throws_ok { $obj->chop(42) }
119 qr/Cannot call chop with any arguments/,
120 'chop throws an error when an argument is passed';
123 $obj->prepend('bar');
124 is( $obj->_string, 'barx', 'prepended to string' );
126 $obj->prepend_curried;
127 is( $obj->_string, '-barx', 'prepend_curried prepended to string' );
129 $obj->replace( qr/([ao])/, sub { uc($1) } );
131 $obj->_string, '-bArx',
132 'substitution using coderef for replacement'
135 $obj->replace( qr/A/, 'X' );
137 $obj->_string, '-bXrx',
138 'substitution using string as replacement'
141 throws_ok { $obj->replace( {}, 'x' ) }
142 qr/The first argument passed to replace must be a string or regexp reference/,
143 'replace throws an error when the first argument is not a string or regexp';
145 throws_ok { $obj->replace( qr/x/, {} ) }
146 qr/The second argument passed to replace must be a string or code reference/,
147 'replace throws an error when the first argument is not a string or regexp';
149 $obj->_string('Moosex');
150 $obj->replace_curried;
151 is( $obj->_string, 'MooseX', 'capitalize last' );
153 $obj->_string('abcdef');
156 [ $obj->match(qr/([az]).*([fy])/) ], [ 'a', 'f' ],
157 'match -barx against /[aq]/ returns matches'
161 scalar $obj->match('b'),
162 'match with string as argument returns true'
165 throws_ok { $obj->match }
166 qr/Cannot call match without at least 1 argument/,
167 'match throws an error when no arguments are passed';
169 throws_ok { $obj->match( {} ) }
170 qr/The argument passed to match must be a string or regexp reference/,
171 'match throws an error when an invalid argument is passed';
173 $obj->_string('1234');
174 ok( !$obj->match_curried, 'match_curried returns false' );
176 $obj->_string('one two three four');
177 ok( $obj->match_curried, 'match curried returns true' );
180 is( $obj->_string, q{}, 'clear' );
182 throws_ok { $obj->clear(42) }
183 qr/Cannot call clear with any arguments/,
184 'clear throws an error when an argument is passed';
186 $obj->_string('some long string');
188 $obj->substr(1), 'ome long string',
189 'substr as getter with one argument'
192 $obj->_string('some long string');
194 $obj->substr( 1, 3 ), 'ome',
195 'substr as getter with two arguments'
198 $obj->substr( 1, 3, 'ong' );
201 $obj->_string, 'song long string',
202 'substr as setter with three arguments'
205 throws_ok { $obj->substr }
206 qr/Cannot call substr without at least 1 argument/,
207 'substr throws an error when no argumemts are passed';
209 throws_ok { $obj->substr( 1, 2, 3, 4 ) }
210 qr/Cannot call substr with more than 3 arguments/,
211 'substr throws an error when four argumemts are passed';
213 throws_ok { $obj->substr( {} ) }
214 qr/The first argument passed to substr must be an integer/,
215 'substr throws an error when first argument is not an integer';
217 throws_ok { $obj->substr( 1, {} ) }
218 qr/The second argument passed to substr must be a positive integer/,
219 'substr throws an error when second argument is not a positive integer';
221 throws_ok { $obj->substr( 1, 2, {} ) }
222 qr/The third argument passed to substr must be a string/,
223 'substr throws an error when third argument is not a string';
225 $obj->_string('some long string');
228 $obj->substr_curried_1, 'ome long string',
229 'substr_curried_1 returns expected value'
233 $obj->substr_curried_1(3), 'ome',
234 'substr_curried_1 with one argument returns expected value'
237 $obj->substr_curried_1( 3, 'ong' );
240 $obj->_string, 'song long string',
241 'substr_curried_1 as setter with two arguments'
244 $obj->_string('some long string');
247 $obj->substr_curried_2, 'ome',
248 'substr_curried_2 returns expected value'
251 $obj->substr_curried_2('ong');
254 $obj->_string, 'song long string',
255 'substr_curried_2 as setter with one arguments'
258 $obj->_string('some long string');
260 $obj->substr_curried_3;
263 $obj->_string, 'song long string',
264 'substr_curried_3 as setter'