1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
3 # things will die if this is set
4 BEGIN { $ENV{DBIC_ASSERT_NO_ERRONEOUS_METAINSTANCE_USE} = 0 }
11 use DBICTest::Util 'capture_stderr';
14 my ($fn) = __FILE__ =~ /( [^\/\\]+ ) $/x;
17 my $art = DBICTest->init_schema->resultset("Artist")->find(1);
19 push @divergence_lines, __LINE__ + 1;
20 DBICTest::Schema::Artist->add_columns("Something_New");
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
28 push @divergence_lines, __LINE__ + 1;
29 DBICTest::Schema::Artist->result_source_instance->name("foo");
31 my $orig_class_rsrc_before_table_triggered_reinit = DBICTest::Schema::Artist->result_source_instance;
33 push @divergence_lines, __LINE__ + 1;
34 DBICTest::Schema::Artist->table("bar");
39 DBICTest::Schema::Artist->has_column( "Something_New" ),
40 'Added column visible'
44 (! DBICTest::Schema::Artist->has_column( "Something_New_2" ) ),
45 'Column added on children not visible'
49 'No StdErr output during rsrc augmentation'
52 my $err = capture_stderr {
54 ! $art->has_column($_),
55 "Column '$_' not visible on @{[ $art->table ]}"
56 ) for qw(Something_New Something_New_2);
59 # Tricky text - check it painstakingly as things may go off
61 my $expected_warning_1 = join '.+?', map { quotemeta $_ }
62 "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*",
64 "${orig_class_rsrc_before_table_triggered_reinit}->add_columns(...) at",
65 "$fn line $divergence_lines[0]",
67 "@{[ DBICTest::Schema->source('Artist') ]}->add_column(...) at",
68 "$fn line $divergence_lines[1]",
70 "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->has_column(...)",
75 qr/$expected_warning_1/s,
76 'Correct warning on diverged metadata'
79 my $expected_warning_2 = join '.+?', map { quotemeta $_ }
80 "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*",
82 "${orig_class_rsrc_before_table_triggered_reinit}->name(...) at",
83 "$fn line $divergence_lines[2]",
85 "${orig_class_rsrc_before_table_triggered_reinit}->table(...) at",
86 "$fn line $divergence_lines[3]",
88 "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->table(...)",
93 qr/$expected_warning_2/s,
94 'Correct warning on diverged metadata'