Commit | Line | Data |
73f54e27 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
3 | # things will die if this is set |
4 | BEGIN { $ENV{DBIC_ASSERT_NO_ERRONEOUS_METAINSTANCE_USE} = 0 } |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use Test::More; |
10 | |
11 | use DBICTest::Util 'capture_stderr'; |
12 | use DBICTest; |
13 | |
14 | my ($fn) = __FILE__ =~ /( [^\/\\]+ ) $/x; |
15 | my @divergence_lines; |
16 | |
17 | my $art = DBICTest->init_schema->resultset("Artist")->find(1); |
18 | |
19 | push @divergence_lines, __LINE__ + 1; |
20 | DBICTest::Schema::Artist->add_columns("Something_New"); |
21 | |
22 | push @divergence_lines, __LINE__ + 1; |
23 | $_->add_column("Something_New_2") for grep |
24 | { $_ != $art->result_source } |
25 | DBICTest::Schema::Artist->result_source_instance->__derived_instances |
26 | ; |
27 | |
28 | push @divergence_lines, __LINE__ + 1; |
29 | DBICTest::Schema::Artist->result_source_instance->name("foo"); |
30 | |
31 | my $orig_class_rsrc_before_table_triggered_reinit = DBICTest::Schema::Artist->result_source_instance; |
32 | |
33 | push @divergence_lines, __LINE__ + 1; |
34 | DBICTest::Schema::Artist->table("bar"); |
35 | |
36 | is( |
37 | capture_stderr { |
38 | ok( |
39 | DBICTest::Schema::Artist->has_column( "Something_New" ), |
40 | 'Added column visible' |
41 | ); |
42 | |
43 | ok( |
44 | (! DBICTest::Schema::Artist->has_column( "Something_New_2" ) ), |
45 | 'Column added on children not visible' |
46 | ); |
47 | }, |
48 | '', |
49 | 'No StdErr output during rsrc augmentation' |
50 | ); |
51 | |
52 | my $err = capture_stderr { |
53 | ok( |
54 | ! $art->has_column($_), |
55 | "Column '$_' not visible on @{[ $art->table ]}" |
56 | ) for qw(Something_New Something_New_2); |
57 | }; |
58 | |
59 | # Tricky text - check it painstakingly as things may go off |
60 | # in very subtle ways |
61 | my $expected_warning_1 = join '.+?', map { quotemeta $_ } |
62 | "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*", |
63 | |
64 | "${orig_class_rsrc_before_table_triggered_reinit}->add_columns(...) at", |
65 | "$fn line $divergence_lines[0]", |
66 | |
67 | "@{[ DBICTest::Schema->source('Artist') ]}->add_column(...) at", |
68 | "$fn line $divergence_lines[1]", |
69 | |
70 | "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->has_column(...)", |
71 | ; |
72 | |
73 | like |
74 | $err, |
75 | qr/$expected_warning_1/s, |
76 | 'Correct warning on diverged metadata' |
77 | ; |
78 | |
79 | my $expected_warning_2 = join '.+?', map { quotemeta $_ } |
80 | "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*", |
81 | |
82 | "${orig_class_rsrc_before_table_triggered_reinit}->name(...) at", |
83 | "$fn line $divergence_lines[2]", |
84 | |
85 | "${orig_class_rsrc_before_table_triggered_reinit}->table(...) at", |
86 | "$fn line $divergence_lines[3]", |
87 | |
88 | "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->table(...)", |
89 | ; |
90 | |
91 | like |
92 | $err, |
93 | qr/$expected_warning_2/s, |
94 | 'Correct warning on diverged metadata' |
95 | ; |
96 | |
97 | done_testing; |