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