1*0Sstevel@tonic-gate#!./perl -w 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate $| = 1; 5*0Sstevel@tonic-gate chdir 't' if -d 't'; 6*0Sstevel@tonic-gate @INC = '../lib'; 7*0Sstevel@tonic-gate} 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gateprint "1..18\n"; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gatemy $t = 1; 12*0Sstevel@tonic-gatetie my $c => 'Tie::Monitor'; 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gatesub ok { 15*0Sstevel@tonic-gate my($ok, $got, $exp, $rexp, $wexp) = @_; 16*0Sstevel@tonic-gate my($rgot, $wgot) = (tied $c)->init(0); 17*0Sstevel@tonic-gate print $ok ? "ok $t\n" : "# expected $exp, got $got\nnot ok $t\n"; 18*0Sstevel@tonic-gate ++$t; 19*0Sstevel@tonic-gate if ($rexp == $rgot && $wexp == $wgot) { 20*0Sstevel@tonic-gate print "ok $t\n"; 21*0Sstevel@tonic-gate } else { 22*0Sstevel@tonic-gate print "# read $rgot expecting $rexp\n" if $rgot != $rexp; 23*0Sstevel@tonic-gate print "# wrote $wgot expecting $wexp\n" if $wgot != $wexp; 24*0Sstevel@tonic-gate print "not ok $t\n"; 25*0Sstevel@tonic-gate } 26*0Sstevel@tonic-gate ++$t; 27*0Sstevel@tonic-gate} 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gatesub ok_undef { ok(!defined($_[0]), shift, "undef", @_) } 30*0Sstevel@tonic-gatesub ok_numeric { ok($_[0] == $_[1], @_) } 31*0Sstevel@tonic-gatesub ok_string { ok($_[0] eq $_[1], @_) } 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gatemy($r, $s); 34*0Sstevel@tonic-gate# the thing itself 35*0Sstevel@tonic-gateok_numeric($r = $c + 0, 0, 1, 0); 36*0Sstevel@tonic-gateok_string($r = "$c", '0', 1, 0); 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate# concat 39*0Sstevel@tonic-gateok_string($c . 'x', '0x', 1, 0); 40*0Sstevel@tonic-gateok_string('x' . $c, 'x0', 1, 0); 41*0Sstevel@tonic-gate$s = $c . $c; 42*0Sstevel@tonic-gateok_string($s, '00', 2, 0); 43*0Sstevel@tonic-gate$r = 'x'; 44*0Sstevel@tonic-gate$s = $c = $r . 'y'; 45*0Sstevel@tonic-gateok_string($s, 'xy', 1, 1); 46*0Sstevel@tonic-gate$s = $c = $c . 'x'; 47*0Sstevel@tonic-gateok_string($s, '0x', 2, 1); 48*0Sstevel@tonic-gate$s = $c = 'x' . $c; 49*0Sstevel@tonic-gateok_string($s, 'x0', 2, 1); 50*0Sstevel@tonic-gate$s = $c = $c . $c; 51*0Sstevel@tonic-gateok_string($s, '00', 3, 1); 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate# adapted from Tie::Counter by Abigail 54*0Sstevel@tonic-gatepackage Tie::Monitor; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gatesub TIESCALAR { 57*0Sstevel@tonic-gate my($class, $value) = @_; 58*0Sstevel@tonic-gate bless { 59*0Sstevel@tonic-gate read => 0, 60*0Sstevel@tonic-gate write => 0, 61*0Sstevel@tonic-gate values => [ 0 ], 62*0Sstevel@tonic-gate }; 63*0Sstevel@tonic-gate} 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gatesub FETCH { 66*0Sstevel@tonic-gate my $self = shift; 67*0Sstevel@tonic-gate ++$self->{read}; 68*0Sstevel@tonic-gate $self->{values}[$#{ $self->{values} }]; 69*0Sstevel@tonic-gate} 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gatesub STORE { 72*0Sstevel@tonic-gate my($self, $value) = @_; 73*0Sstevel@tonic-gate ++$self->{write}; 74*0Sstevel@tonic-gate push @{ $self->{values} }, $value; 75*0Sstevel@tonic-gate} 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gatesub init { 78*0Sstevel@tonic-gate my $self = shift; 79*0Sstevel@tonic-gate my @results = ($self->{read}, $self->{write}); 80*0Sstevel@tonic-gate $self->{read} = $self->{write} = 0; 81*0Sstevel@tonic-gate $self->{values} = [ 0 ]; 82*0Sstevel@tonic-gate @results; 83*0Sstevel@tonic-gate} 84