1#!/usr/bin/perl 2use strict; 3use warnings; 4use Test::Simple tests => 15; 5BEGIN {unshift @INC, '../lib'} 6use Lvalue ':all'; 7 8print "Lvalue $Lvalue::VERSION\n"; 9 10{no warnings 'redefine'; 11 my $ok = \&ok; 12 *ok = sub ($;$) {push @_, shift; goto &$ok} 13} 14 15{package Integer; 16 our $VERSION = '0.101'; 17 sub new {bless {value => $_[1] ? int $_[1] : 0}} 18 sub value { 19 my $self = shift; 20 @_ ? $$self{value} = int shift 21 : $$self{value}; 22 } 23} 24 25my $int = Lvalue->wrap( Integer->new(3.14) ); 26 27ok 'constructor' 28=> (ref $int) =~ /^Lvalue::Loader(?:::_\d)?$/; 29 30ok 'getter' 31=> $int->value == 3; 32 33ok 'setter lvalue' 34=> ($int->value = 234.5434) == 234 35&& $int->value == 234; 36 37ok 'can' 38=> $int->can('value'); 39 40ok 'isa' 41=> $int->isa('Integer'); 42 43ok 'DOES' 44=> eval {$int->DOES('Integer')} 45|| $@ =~ /^no method 'DOES' on 'Integer.+?lvalue.t/; 46 47ok 'VERSION' 48=> $int->VERSION eq '0.101'; 49 50$_ /= 6.23 for $int->value; 51 52ok 'alias' 53=> $int->value == 37; 54 55ok 'setter method' 56=> $int->value(2.71) == 2 57&& $int->value == 2; 58 59ok 'no method call' 60=> !eval {$int->nomethod(3)} 61&& $@ =~ /^no method 'nomethod' on 'Integer.+?lvalue.t/; 62 63ok 'no method tied' 64=> !eval {$int->nomethod = 3} 65&& $@ =~ /^no method 'nomethod' on 'Integer.+?lvalue.t/; 66 67$int = Lvalue->unwrap( $int ); 68 69ok 'unwrap' 70=> ref $int eq 'Integer' 71&& ! eval {$int->value = 5}; 72 73eval q{ 74 package Integer; 75 use overload fallback => 1, 76 '""' => sub {"int($_[0]{value})"}, 77 '0+' => sub {$_[0]{value}}, 78 '&{}' => sub { 79 my $self = shift; 80 sub {"code deref overload: $$self{value}"} 81 }; 82}; 83 84my $norm = Integer->new(1.234); 85 86ok 'pre Lvalue' 87=> ! eval {$norm->value = 5} 88&& "$norm" eq 'int(1)' 89&& $norm == 1 90&& eval {$norm->() eq 'code deref overload: 1'}; 91 92lvalue $norm; 93 94ok 'post void wrap' 95=> eval {$norm->value = 10; $norm->value == 10} 96&& "$norm" eq 'int(10)' 97&& $norm == 10 98&& eval {$norm->() eq 'code deref overload: 10'}; 99 100unwrap $norm; 101 102ok 'post void unwrap' 103=> ! eval {$norm->value = 5} 104&& $norm->value(6.4892) == 6 105&& $norm == 6 106&& "$norm" eq 'int(6)' 107&& eval {$norm->() eq 'code deref overload: 6'}; 108 109{package NonSTD; 110 sub new {bless {val => 0}} 111 sub set_val {$_[0]{val} = $_[1]} 112 sub get_val {$_[0]{val}} 113} 114