File Coverage

blib/lib/Mason/t/Interp.pm
Criterion Covered Total %
statement 110 110 100.0
branch 2 2 100.0
condition n/a
subroutine 28 28 100.0
pod 0 9 0.0
total 140 149 93.9


line stmt bran cond sub pod time code
1             package Mason::t::Interp;
2             $Mason::t::Interp::VERSION = '2.24';
3 1     1   735 use Test::Class::Most parent => 'Mason::Test::Class';
  1         27814  
  1         7  
4 1     1   586 use Capture::Tiny qw(capture);
  1         3286  
  1         63  
5              
6 1     1   5 { package MyInterp; use Moose; extends 'Mason::Interp'; __PACKAGE__->meta->make_immutable() }
  1         2  
  1         6  
7             $MyInterp::VERSION = '2.24';
8             sub test_base_interp_class : Tests {
9 1     1 0 2379 my $self = shift;
10 1         9 my $interp = $self->create_interp( base_interp_class => 'MyInterp' );
11 1         7 is( ref($interp), 'MyInterp' );
12 1     1   5260 }
  1         1  
  1         9  
13              
14             sub test_find_paths : Tests {
15 1     1 0 208 my $self = shift;
16 1         7 my $r1 = $self->temp_dir . "/r1";
17 1         2 my $r2 = $self->temp_dir . "/r2";
18 1         6 my $interp = $self->create_interp( comp_root => [ $r1, $r2 ] );
19 1         11 my @files =
20             ( "$r1/foo.mc", "$r1/foo/bar.mc", "$r2/foo/baz.mc", "$r1/foo/blarg.mc", "$r2/foo/blarg.mc" );
21 1         4 foreach my $file (@files) {
22 5         22 $self->mkpath_and_write_file( $file, " " );
23             }
24             cmp_set(
25 1         6 [ $interp->all_paths("/") ],
26             [qw(/foo.mc /foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
27             "all_paths(/)"
28             );
29 1         5312 cmp_set(
30             [ $interp->all_paths() ],
31             [qw(/foo.mc /foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
32             "all_paths(/)"
33             );
34 1         1685 cmp_set(
35             [ $interp->all_paths("/foo") ],
36             [qw(/foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
37             "all_paths(/foo)"
38             );
39 1         1127 cmp_set( [ $interp->all_paths("/bar") ], [], "all_paths(/bar)" );
40              
41 1         513 cmp_set(
42             [ $interp->glob_paths("/foo/ba*.mc") ],
43             [qw(/foo/bar.mc /foo/baz.mc)],
44             "glob_paths(/foo/ba*.mc)"
45             );
46 1         779 cmp_set( [ $interp->glob_paths("/foo/bl*.mc") ],
47             [qw(/foo/blarg.mc)], "glob_paths(/foo/bl*.mc)" );
48 1         648 cmp_set( [ $interp->glob_paths("/foo/d*") ], [], "glob_paths(/foo/d*)" );
49 1     1   522 }
  1         3  
  1         4  
50              
51             sub test_component_class_prefix : Tests {
52 1     1 0 1051 my $self = shift;
53              
54             my $check_prefix = sub {
55 3     3   5 my $interp = shift;
56 3         96 my $regex = "^" . $interp->component_class_prefix . "::";
57 3         44 like( $interp->load('/foo.mc'), qr/$regex/, "prefix at beginning of path" );
58 1         3 };
59              
60 1         6 $self->add_comp( path => '/foo.mc', src => 'foo' );
61              
62 2         9 my @interp =
63 1         7 map { $self->create_interp() } ( 0 .. 1 );
64 1         29 ok( $interp[0]->component_class_prefix ne $interp[1]->component_class_prefix,
65             "different prefixes" );
66 1         445 ok( $interp[0]->load('/foo.mc') ne $interp[1]->load('/foo.mc'), "different classnames" );
67              
68 1         745 $check_prefix->( $interp[0] );
69 1         336 $check_prefix->( $interp[1] );
70              
71 1         445 $interp[2] = $self->create_interp( component_class_prefix => 'Blah' );
72 1         32 is( $interp[2]->component_class_prefix, 'Blah', 'specified prefix' );
73 1         453 $check_prefix->( $interp[2] );
74 1     1   353 }
  1         2  
  1         4  
75              
76             sub test_no_data_dir : Tests {
77 1     1 0 231 my $self = shift;
78 1         8 my $interp = Mason->new( comp_root => $self->comp_root );
79 1         24 ok( -d $interp->data_dir );
80 1     1   221 }
  1         1  
  1         4  
81              
82             sub test_bad_param : Tests {
83 1     1 0 1024 my $self = shift;
84 1     1   10 throws_ok { $self->create_interp( foo => 5 ) } qr/Found unknown attribute/;
  1         67  
85 1     1   233 }
  1         2  
  1         4  
86              
87             sub test_comp_exists : Tests {
88 1     1 0 790 my $self = shift;
89              
90 1         12 $self->add_comp( path => '/comp_exists/one.mc', src => 'hi' );
91 1         136 my $interp = $self->interp;
92 1         27 ok( $interp->comp_exists('/comp_exists/one.mc') );
93 1         387 ok( !$interp->comp_exists('/comp_exists/two.mc') );
94 1     1   363 throws_ok { $interp->comp_exists('one.mc') } qr/not an absolute/;
  1         71  
95 1     1   273 }
  1         2  
  1         3  
96              
97             sub test_out_method : Tests {
98 1     1 0 732 my $self = shift;
99              
100 1         11 $self->add_comp( path => '/out_method/hi.mc', src => 'hi' );
101              
102 1         2 my $buffer = '';
103             my $try = sub {
104 5     5   12 my ( $out_method, $expect_result, $expect_buffer, $expect_stdout, $desc ) = @_;
105 5         6 my ( $result, $stdout );
106 5 100       18 my @params = ( $out_method ? ( { out_method => $out_method } ) : () );
107             ($stdout) = capture {
108 5         4094 $result = $self->interp->run( @params, '/out_method/hi' );
109 5         109 };
110 5         3253 is( $stdout, $expect_stdout, "stdout - $desc" );
111 5         2315 is( $buffer, $expect_buffer, "buffer - $desc" );
112 5         1833 is( $result->output, $expect_result, "result->output - $desc" );
113 1         7 };
114              
115 1         3 $try->( undef, 'hi', '', '', 'undef' );
116 1     1   7 $try->( sub { print $_[0] }, '', '', 'hi', 'sub print' );
  1         45  
117 1     1   8 $try->( sub { $buffer .= uc( $_[0] ) }, '', 'HI', '', 'sub buffer .=' );
  1         4  
118 1         6 $try->( \$buffer, '', 'HIhi', '', '\$buffer' );
119              
120 1         2 $buffer = '';
121 1     1   14 $self->setup_interp( out_method => sub { print scalar( reverse( $_[0] ) ) } );
  1         57  
122 1         25 $try->( undef, '', '', 'ih', 'print reverse' );
123 1     1   404 }
  1         1  
  1         3  
124              
125             sub test_no_source_line_numbers : Tests {
126 1     1 0 262 my $self = shift;
127              
128 1         24 $self->test_parse( src => "hi\n<%init>my \$d = 0</%init>", expect => [qr/\#line/] );
129 1         423 $self->setup_interp( no_source_line_numbers => 1 );
130 1         24 $self->test_parse( src => "hi\n<%init>my \$d = 0</%init>", expect => [qr/^(?!(?s:.*)\#line)/] );
131 1     1   247 }
  1         2  
  1         3  
132              
133             sub test_class_header : Tests {
134 1     1 0 148 my $self = shift;
135              
136 1         7 $self->setup_interp( class_header => '# header' );
137 1         23 $self->test_parse( src => "hi", expect => [qr/\# header/] );
138 1     1   222 }
  1         2  
  1         3  
139              
140             1;