Commit | Line | Data |
66afce69 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
b24cb177 |
4 | use Test::Exception; |
a0e0a56a |
5 | use File::Path qw/rmtree make_path/; |
66afce69 |
6 | use Class::Unload; |
ffc705f3 |
7 | use File::Temp qw/tempfile tempdir/; |
8 | use IO::File; |
68d49e50 |
9 | use DBIx::Class::Schema::Loader (); |
66afce69 |
10 | use lib qw(t/lib); |
11 | use make_dbictest_db2; |
12 | |
13 | my $DUMP_DIR = './t/_common_dump'; |
14 | rmtree $DUMP_DIR; |
a0e0a56a |
15 | my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema'; |
66afce69 |
16 | |
66afce69 |
17 | # test dynamic schema in 0.04006 mode |
18 | { |
19 | my $res = run_loader(); |
a0e0a56a |
20 | my $warning = $res->{warnings}[0]; |
66afce69 |
21 | |
a0e0a56a |
22 | like $warning, qr/dynamic schema/i, |
66afce69 |
23 | 'dynamic schema in backcompat mode detected'; |
a0e0a56a |
24 | like $warning, qr/run in 0\.04006 mode/i, |
66afce69 |
25 | 'dynamic schema in 0.04006 mode warning'; |
a0e0a56a |
26 | like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/, |
27 | 'warning refers to upgrading doc'; |
28 | |
29 | run_v4_tests($res); |
30 | } |
66afce69 |
31 | |
a0e0a56a |
32 | # setting naming accessor on dynamic schema should disable warning (even when |
33 | # we're setting it to 'v4' .) |
34 | { |
35 | my $res = run_loader(naming => 'v4'); |
66afce69 |
36 | |
a0e0a56a |
37 | is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; |
f53dcdf0 |
38 | |
39 | run_v4_tests($res); |
a0e0a56a |
40 | } |
41 | |
42 | # test upgraded dynamic schema |
43 | { |
44 | my $res = run_loader(naming => 'current'); |
66afce69 |
45 | |
a0e0a56a |
46 | # to dump a schema for debugging... |
47 | # { |
48 | # mkdir '/tmp/HLAGH'; |
49 | # $schema->_loader->{dump_directory} = '/tmp/HLAGH'; |
50 | # $schema->_loader->_dump_to_dir(values %{ $res->{classes} }); |
51 | # } |
66afce69 |
52 | |
a0e0a56a |
53 | is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; |
66afce69 |
54 | |
a0e0a56a |
55 | run_v5_tests($res); |
56 | } |
57 | |
ffc705f3 |
58 | # test upgraded dynamic schema with external content loaded |
59 | { |
60 | my $temp_dir = tempdir; |
61 | push @INC, $temp_dir; |
62 | |
63 | my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; |
64 | make_path $external_result_dir; |
65 | |
b24cb177 |
66 | # make external content for Result that will be singularized |
ffc705f3 |
67 | IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); |
68 | package ${SCHEMA_CLASS}::Quuxs; |
69 | sub a_method { 'hlagh' } |
b24cb177 |
70 | |
71 | __PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs', |
72 | { 'foreign.baz_num' => 'self.baz_id' }); |
73 | |
74 | 1; |
75 | EOF |
76 | |
77 | # make external content for Result that will NOT be singularized |
78 | IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF"); |
79 | package ${SCHEMA_CLASS}::Bar; |
80 | |
81 | __PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos', |
82 | { 'foreign.fooid' => 'self.foo_id' }); |
83 | |
ffc705f3 |
84 | 1; |
85 | EOF |
86 | |
87 | my $res = run_loader(naming => 'current'); |
88 | my $schema = $res->{schema}; |
89 | |
90 | is scalar @{ $res->{warnings} }, 1, |
91 | 'correct nummber of warnings for upgraded dynamic schema with external ' . |
92 | 'content for unsingularized Result.'; |
93 | |
94 | my $warning = $res->{warnings}[0]; |
95 | like $warning, qr/Detected external content/i, |
96 | 'detected external content warning'; |
97 | |
b24cb177 |
98 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
ffc705f3 |
99 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
100 | 'dynamic Schema'; |
101 | |
b24cb177 |
102 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
103 | $res->{classes}{bazs} } |
104 | 'unsingularized class names in external content are translated'; |
105 | |
106 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
107 | $res->{classes}{foos} } |
108 | 'unsingularized class names in external content from unchanged Result class ' . |
109 | 'names are translated'; |
110 | |
ffc705f3 |
111 | run_v5_tests($res); |
112 | |
113 | rmtree $temp_dir; |
114 | pop @INC; |
115 | } |
116 | |
805dbe0a |
117 | # test upgraded dynamic schema with use_namespaces with external content loaded |
118 | { |
119 | my $temp_dir = tempdir; |
120 | push @INC, $temp_dir; |
121 | |
122 | my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; |
123 | make_path $external_result_dir; |
124 | |
125 | # make external content for Result that will be singularized |
126 | IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); |
127 | package ${SCHEMA_CLASS}::Quuxs; |
128 | sub a_method { 'hlagh' } |
129 | |
130 | __PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs', |
131 | { 'foreign.baz_num' => 'self.baz_id' }); |
132 | |
133 | 1; |
134 | EOF |
135 | |
136 | # make external content for Result that will NOT be singularized |
137 | IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF"); |
138 | package ${SCHEMA_CLASS}::Bar; |
139 | |
140 | __PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos', |
141 | { 'foreign.fooid' => 'self.foo_id' }); |
142 | |
143 | 1; |
144 | EOF |
145 | |
146 | my $res = run_loader(naming => 'current', use_namespaces => 1); |
147 | my $schema = $res->{schema}; |
148 | |
149 | is scalar @{ $res->{warnings} }, 2, |
150 | 'correct nummber of warnings for upgraded dynamic schema with external ' . |
151 | 'content for unsingularized Result with use_namespaces.'; |
152 | |
153 | my $warning = $res->{warnings}[0]; |
154 | like $warning, qr/Detected external content/i, |
155 | 'detected external content warning'; |
156 | |
157 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
158 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
159 | 'dynamic Schema'; |
160 | |
161 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
162 | $res->{classes}{bazs} } |
163 | 'unsingularized class names in external content are translated'; |
164 | |
165 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
166 | $res->{classes}{foos} } |
167 | 'unsingularized class names in external content from unchanged Result class ' . |
168 | 'names are translated'; |
169 | |
170 | run_v5_tests($res); |
171 | |
172 | rmtree $temp_dir; |
173 | pop @INC; |
174 | } |
175 | |
176 | |
30a4c064 |
177 | # test upgraded static schema with external content loaded |
178 | { |
179 | my $temp_dir = tempdir; |
180 | push @INC, $temp_dir; |
181 | |
182 | my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; |
183 | make_path $external_result_dir; |
184 | |
b24cb177 |
185 | # make external content for Result that will be singularized |
30a4c064 |
186 | IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); |
187 | package ${SCHEMA_CLASS}::Quuxs; |
188 | sub a_method { 'dongs' } |
b24cb177 |
189 | |
190 | __PACKAGE__->has_one('bazrel2', 'DBIXCSL_Test::Schema::Bazs', |
191 | { 'foreign.baz_num' => 'self.baz_id' }); |
192 | |
193 | 1; |
194 | EOF |
195 | |
196 | # make external content for Result that will NOT be singularized |
197 | IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF"); |
198 | package ${SCHEMA_CLASS}::Bar; |
199 | |
200 | __PACKAGE__->has_one('foorel2', 'DBIXCSL_Test::Schema::Foos', |
201 | { 'foreign.fooid' => 'self.foo_id' }); |
202 | |
30a4c064 |
203 | 1; |
204 | EOF |
205 | |
206 | write_v4_schema_pm(); |
207 | |
208 | my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current'); |
209 | my $schema = $res->{schema}; |
210 | |
211 | run_v5_tests($res); |
212 | |
b24cb177 |
213 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'dongs' } |
30a4c064 |
214 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
215 | 'static Schema'; |
216 | |
b24cb177 |
217 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2, |
218 | $res->{classes}{bazs} } |
219 | 'unsingularized class names in external content are translated'; |
220 | |
221 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel2, |
222 | $res->{classes}{foos} } |
223 | 'unsingularized class names in external content from unchanged Result class ' . |
224 | 'names are translated in static schema'; |
225 | |
30a4c064 |
226 | my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs}); |
227 | my $code = do { local ($/, @ARGV) = (undef, $file); <> }; |
228 | |
229 | like $code, qr/package ${SCHEMA_CLASS}::Quux;/, |
230 | 'package line translated correctly from external custom content in static dump'; |
231 | |
232 | like $code, qr/sub a_method { 'dongs' }/, |
233 | 'external custom content loaded into static dump correctly'; |
234 | |
235 | rmtree $temp_dir; |
236 | pop @INC; |
237 | } |
238 | |
b24cb177 |
239 | # test running against v4 schema without upgrade, twice, then upgrade |
a0e0a56a |
240 | { |
30a4c064 |
241 | write_v4_schema_pm(); |
a0e0a56a |
242 | my $res = run_loader(dump_directory => $DUMP_DIR); |
a1a91c42 |
243 | my $warning = $res->{warnings}[1]; |
a0e0a56a |
244 | |
245 | like $warning, qr/static schema/i, |
246 | 'static schema in backcompat mode detected'; |
247 | like $warning, qr/0.04006/, |
248 | 'correct version detected'; |
249 | like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/, |
250 | 'refers to upgrading doc'; |
251 | |
a1a91c42 |
252 | is scalar @{ $res->{warnings} }, 4, |
ffc705f3 |
253 | 'correct number of warnings for static schema in backcompat mode'; |
254 | |
a0e0a56a |
255 | run_v4_tests($res); |
256 | |
257 | # add some custom content to a Result that will be replaced |
258 | my $schema = $res->{schema}; |
259 | my $quuxs_pm = $schema->_loader |
260 | ->_get_dump_filename($res->{classes}{quuxs}); |
261 | { |
262 | local ($^I, @ARGV) = ('', $quuxs_pm); |
263 | while (<>) { |
264 | if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { |
265 | print; |
b24cb177 |
266 | print <<EOF; |
267 | sub a_method { 'mtfnpy' } |
268 | |
269 | __PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs', |
270 | { 'foreign.baz_num' => 'self.baz_id' }); |
271 | EOF |
a0e0a56a |
272 | } |
273 | else { |
274 | print; |
275 | } |
276 | } |
277 | } |
278 | |
b24cb177 |
279 | # Rerun the loader in backcompat mode to make sure it's still in backcompat |
280 | # mode. |
281 | $res = run_loader(dump_directory => $DUMP_DIR); |
282 | run_v4_tests($res); |
283 | |
a0e0a56a |
284 | # now upgrade the schema |
a1a91c42 |
285 | $res = run_loader( |
286 | dump_directory => $DUMP_DIR, |
287 | naming => 'current', |
288 | use_namespaces => 1 |
289 | ); |
a0e0a56a |
290 | $schema = $res->{schema}; |
291 | |
292 | like $res->{warnings}[0], qr/Dumping manual schema/i, |
293 | 'correct warnings on upgrading static schema (with "naming" set)'; |
294 | |
295 | like $res->{warnings}[1], qr/dump completed/i, |
296 | 'correct warnings on upgrading static schema (with "naming" set)'; |
297 | |
298 | is scalar @{ $res->{warnings} }, 2, |
f53dcdf0 |
299 | 'correct number of warnings on upgrading static schema (with "naming" set)' |
300 | or diag @{ $res->{warnings} }; |
a0e0a56a |
301 | |
302 | run_v5_tests($res); |
303 | |
a1a91c42 |
304 | (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Result") =~ s{::}{/}g; |
305 | my $result_count =()= glob "$result_dir/*"; |
306 | |
307 | is $result_count, 4, |
308 | 'un-singularized results were replaced during upgrade'; |
309 | |
310 | # check that custom content was preserved |
311 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } |
312 | 'custom content was carried over from un-singularized Result'; |
313 | |
314 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3, |
315 | $res->{classes}{bazs} } |
316 | 'unsingularized class names in custom content are translated'; |
317 | |
318 | my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs}); |
319 | my $code = do { local ($/, @ARGV) = (undef, $file); <> }; |
320 | |
321 | like $code, qr/sub a_method { 'mtfnpy' }/, |
322 | 'custom content from unsingularized Result loaded into static dump correctly'; |
323 | } |
324 | |
325 | # test running against v4 schema without upgrade, then upgrade with |
326 | # use_namespaces not explicitly set |
327 | { |
328 | write_v4_schema_pm(); |
329 | my $res = run_loader(dump_directory => $DUMP_DIR); |
330 | my $warning = $res->{warnings}[1]; |
331 | |
332 | like $warning, qr/static schema/i, |
333 | 'static schema in backcompat mode detected'; |
334 | like $warning, qr/0.04006/, |
335 | 'correct version detected'; |
336 | like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/, |
337 | 'refers to upgrading doc'; |
338 | |
339 | is scalar @{ $res->{warnings} }, 4, |
340 | 'correct number of warnings for static schema in backcompat mode'; |
341 | |
342 | run_v4_tests($res); |
343 | |
344 | # add some custom content to a Result that will be replaced |
345 | my $schema = $res->{schema}; |
346 | my $quuxs_pm = $schema->_loader |
347 | ->_get_dump_filename($res->{classes}{quuxs}); |
348 | { |
349 | local ($^I, @ARGV) = ('', $quuxs_pm); |
350 | while (<>) { |
351 | if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { |
352 | print; |
353 | print <<EOF; |
354 | sub a_method { 'mtfnpy' } |
355 | |
356 | __PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs', |
357 | { 'foreign.baz_num' => 'self.baz_id' }); |
358 | EOF |
359 | } |
360 | else { |
361 | print; |
362 | } |
363 | } |
364 | } |
365 | |
366 | # now upgrade the schema |
367 | $res = run_loader( |
368 | dump_directory => $DUMP_DIR, |
369 | naming => 'current' |
370 | ); |
371 | $schema = $res->{schema}; |
372 | |
373 | like $res->{warnings}[0], qr/load_classes/i, |
374 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
375 | 'use_namespaces not set)'; |
376 | |
377 | like $res->{warnings}[1], qr/Dumping manual schema/i, |
378 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
379 | 'use_namespaces not set)'; |
380 | |
381 | like $res->{warnings}[2], qr/dump completed/i, |
382 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
383 | 'use_namespaces not set)'; |
384 | |
385 | is scalar @{ $res->{warnings} }, 3, |
386 | 'correct number of warnings on upgrading static schema (with "naming" set)' |
387 | or diag @{ $res->{warnings} }; |
388 | |
389 | run_v5_tests($res); |
390 | |
a0e0a56a |
391 | (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g; |
392 | my $result_count =()= glob "$result_dir/*"; |
393 | |
394 | is $result_count, 4, |
395 | 'un-singularized results were replaced during upgrade'; |
396 | |
397 | # check that custom content was preserved |
b24cb177 |
398 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } |
a0e0a56a |
399 | 'custom content was carried over from un-singularized Result'; |
b24cb177 |
400 | |
401 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3, |
402 | $res->{classes}{bazs} } |
403 | 'unsingularized class names in custom content are translated'; |
404 | |
405 | my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs}); |
406 | my $code = do { local ($/, @ARGV) = (undef, $file); <> }; |
407 | |
408 | like $code, qr/sub a_method { 'mtfnpy' }/, |
409 | 'custom content from unsingularized Result loaded into static dump correctly'; |
410 | } |
411 | |
68d49e50 |
412 | # test upgrading a v4 schema, the check that the version string is correct |
413 | { |
414 | write_v4_schema_pm(); |
415 | run_loader(dump_directory => $DUMP_DIR); |
416 | my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current'); |
417 | my $schema = $res->{schema}; |
418 | |
419 | my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS); |
420 | my $code = do { local ($/, @ARGV) = (undef, $file); <> }; |
421 | |
422 | my ($dumped_ver) = |
423 | $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m; |
424 | |
425 | is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION, |
426 | 'correct version dumped after upgrade of v4 static schema'; |
427 | } |
428 | |
b24cb177 |
429 | # Test upgrading an already singular result with custom content that refers to |
430 | # old class names. |
431 | { |
432 | write_v4_schema_pm(); |
433 | my $res = run_loader(dump_directory => $DUMP_DIR); |
434 | my $schema = $res->{schema}; |
435 | run_v4_tests($res); |
436 | |
437 | # add some custom content to a Result that will be replaced |
438 | my $bar_pm = $schema->_loader |
439 | ->_get_dump_filename($res->{classes}{bar}); |
440 | { |
441 | local ($^I, @ARGV) = ('', $bar_pm); |
442 | while (<>) { |
443 | if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { |
444 | print; |
445 | print <<EOF; |
446 | sub a_method { 'lalala' } |
447 | |
448 | __PACKAGE__->has_one('foorel3', 'DBIXCSL_Test::Schema::Foos', |
449 | { 'foreign.fooid' => 'self.foo_id' }); |
450 | EOF |
451 | } |
452 | else { |
453 | print; |
454 | } |
455 | } |
456 | } |
457 | |
458 | # now upgrade the schema |
459 | $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current'); |
460 | $schema = $res->{schema}; |
461 | run_v5_tests($res); |
462 | |
463 | # check that custom content was preserved |
464 | lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'lalala' } |
465 | 'custom content was preserved from Result pre-upgrade'; |
466 | |
467 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel3, |
468 | $res->{classes}{foos} } |
469 | 'unsingularized class names in custom content from Result with unchanged ' . |
470 | 'name are translated'; |
471 | |
472 | my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar}); |
473 | my $code = do { local ($/, @ARGV) = (undef, $file); <> }; |
474 | |
475 | like $code, qr/sub a_method { 'lalala' }/, |
476 | 'custom content from Result with unchanged name loaded into static dump ' . |
477 | 'correctly'; |
66afce69 |
478 | } |
479 | |
480 | done_testing; |
481 | |
ffc705f3 |
482 | END { |
483 | rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; |
484 | } |
a0e0a56a |
485 | |
dbe9e0f7 |
486 | sub run_loader { |
487 | my %loader_opts = @_; |
488 | |
489 | eval { |
490 | foreach my $source_name ($SCHEMA_CLASS->clone->sources) { |
491 | Class::Unload->unload("${SCHEMA_CLASS}::${source_name}"); |
492 | } |
493 | |
494 | Class::Unload->unload($SCHEMA_CLASS); |
495 | }; |
496 | undef $@; |
497 | |
498 | my @connect_info = $make_dbictest_db2::dsn; |
499 | my @loader_warnings; |
500 | local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; |
501 | eval qq{ |
502 | package $SCHEMA_CLASS; |
503 | use base qw/DBIx::Class::Schema::Loader/; |
504 | |
505 | __PACKAGE__->loader_options(\%loader_opts); |
506 | __PACKAGE__->connection(\@connect_info); |
507 | }; |
508 | |
509 | ok(!$@, "Loader initialization") or diag $@; |
510 | |
511 | my $schema = $SCHEMA_CLASS->clone; |
512 | my (%monikers, %classes); |
513 | foreach my $source_name ($schema->sources) { |
514 | my $table_name = $schema->source($source_name)->from; |
515 | $monikers{$table_name} = $source_name; |
d073740e |
516 | $classes{$table_name} = $schema->source($source_name)->result_class; |
dbe9e0f7 |
517 | } |
518 | |
519 | return { |
520 | schema => $schema, |
521 | warnings => \@loader_warnings, |
522 | monikers => \%monikers, |
523 | classes => \%classes, |
524 | }; |
525 | } |
526 | |
30a4c064 |
527 | sub write_v4_schema_pm { |
528 | (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; |
529 | rmtree $schema_dir; |
530 | make_path $schema_dir; |
531 | my $schema_pm = "$schema_dir/Schema.pm"; |
532 | open my $fh, '>', $schema_pm or die $!; |
533 | print $fh <<'EOF'; |
534 | package DBIXCSL_Test::Schema; |
535 | |
536 | use strict; |
537 | use warnings; |
538 | |
539 | use base 'DBIx::Class::Schema'; |
540 | |
541 | __PACKAGE__->load_classes; |
542 | |
543 | |
544 | # Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-25 01:49:25 |
545 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:ibIJTbfM1ji4pyD/lgSEog |
546 | |
547 | |
548 | # You can replace this text with custom content, and it will be preserved on regeneration |
549 | 1; |
550 | EOF |
551 | } |
552 | |
dbe9e0f7 |
553 | sub run_v4_tests { |
554 | my $res = shift; |
555 | my $schema = $res->{schema}; |
556 | |
557 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ], |
558 | [qw/Foos Bar Bazs Quuxs/], |
559 | 'correct monikers in 0.04006 mode'; |
560 | |
561 | isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }), |
562 | $res->{classes}{bar}, |
563 | 'found a bar'); |
564 | |
565 | isa_ok eval { $bar->foo_id }, $res->{classes}{foos}, |
566 | 'correct rel name in 0.04006 mode'; |
567 | |
568 | ok my $baz = eval { $schema->resultset('Bazs')->find(1) }; |
569 | |
570 | isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet', |
571 | 'correct rel type and name for UNIQUE FK in 0.04006 mode'; |
572 | } |
573 | |
574 | sub run_v5_tests { |
575 | my $res = shift; |
576 | my $schema = $res->{schema}; |
577 | |
578 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ], |
579 | [qw/Foo Bar Baz Quux/], |
580 | 'correct monikers in current mode'; |
581 | |
582 | ok my $bar = eval { $schema->resultset('Bar')->find(1) }; |
583 | |
584 | isa_ok eval { $bar->foo }, $res->{classes}{foos}, |
585 | 'correct rel name in current mode'; |
586 | |
587 | ok my $baz = eval { $schema->resultset('Baz')->find(1) }; |
588 | |
589 | isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, |
590 | 'correct rel type and name for UNIQUE FK in current mode'; |
591 | } |