File Coverage

blib/lib/OOP/Perlish/Class/Accessor/UnitTests/ScalarRef.pm
Criterion Covered Total %
statement 32 32 100.0
branch 2 4 50.0
condition n/a
subroutine 10 10 100.0
pod 0 3 0.0
total 44 49 89.8


line stmt bran cond sub pod time code
1             {
2             package OOP::Perlish::Class::Accessor::UnitTests::ScalarRef;
3 1     1   516 use OOP::Perlish::Class::Accessor::UnitTests::Scalar;
  1         3  
  1         29  
4 1     1   6 use base qw(OOP::Perlish::Class::Accessor::UnitTests::Scalar);
  1         1  
  1         81  
5 1     1   5 use OOP::Perlish::Class::Accessor;
  1         1  
  1         4  
6 1     1   5 use Test::More;
  1         1  
  1         5  
7 1     1   239 use Data::Dumper;
  1         2  
  1         118  
8              
9             sub setup : Test(setup)
10             {
11 8     8 0 3089 my ($self) = @_;
12 8         86 $self->{accessor} = OOP::Perlish::Class::Accessor->new( type => 'SCALARREF', name => 'test', self => bless({}, __PACKAGE__) );
13 1     1   12 }
  1         2  
  1         10  
14              
15             sub get_value
16             {
17 9     9 0 19 my ($self) = @_;
18 9 50       35 return ${ $self->{accessor}->value() } if(ref($self->{accessor}->value()) eq 'SCALAR');
  9         31  
19             }
20              
21             sub cannot_mutate_reference : Test(1)
22             {
23 1     1 0 147 my ($self) = @_;
24              
25 1         5 $self->{accessor}->value('quux');
26 1         2 ${ $self->{accessor}->value() } = 'bar';
  1         4  
27 1 50       4 is( ${ $self->{accessor}->value() }, 'quux', 'cannot mutate instance reference' ) || diag(Dumper($self->{accessor}->value()));
  1         6  
28 1     1   375 }
  1         2  
  1         4  
29             }
30             1;
31             =head1 NAME
32              
33             =head1 VERSION
34              
35             =head1 SYNOPSIS
36              
37             =head1 METHODS
38              
39             =head1 AUTHOR
40              
41             Jamie Beverly, C<< >>
42              
43             =head1 BUGS
44              
45             Please report any bugs or feature requests to C,
46             or through
47             the web interface at
48             L. I will be
49             notified, and then you'll
50             automatically be notified of progress on your bug as I make changes.
51              
52             =head1 SUPPORT
53              
54             You can find documentation for this module with the perldoc command.
55              
56             perldoc OOP::Perlish::Class
57              
58              
59             You can also look for information at:
60              
61             =over 4
62              
63             =item * RT: CPAN's request tracker
64              
65             L
66              
67             =item * AnnoCPAN: Annotated CPAN documentation
68              
69             L
70              
71             =item * CPAN Ratings
72              
73             L
74              
75             =item * Search CPAN
76              
77             L
78              
79             =back
80              
81              
82             =head1 ACKNOWLEDGEMENTS
83              
84             =head1 COPYRIGHT & LICENSE
85              
86             Copyright 2009 Jamie Beverly
87              
88             This program is free software; you can redistribute it and/or modify it
89             under the terms of either: the GNU General Public License as published
90             by the Free Software Foundation; or the Artistic License.
91              
92             See http://dev.perl.org/licenses/ for more information.
93              
94             =cut