tie $a, 'main';
print $a;
EXPECT
-Tied variable freed while still in use at - line 6.
########
# [20020716.007] - nested FETCHES
FETCH
FETCH
joinBOBBINSthingsBOBBINSup
+########
+
+# test SCALAR method
+package TieScalar;
+
+sub TIEHASH {
+ my $pkg = shift;
+ bless { } => $pkg;
+}
+
+sub STORE {
+ $_[0]->{$_[1]} = $_[2];
+}
+
+sub FETCH {
+ $_[0]->{$_[1]}
+}
+
+sub CLEAR {
+ %{ $_[0] } = ();
+}
+
+sub SCALAR {
+ print "SCALAR\n";
+ return 0 if ! keys %{$_[0]};
+ sprintf "%i/%i", scalar keys %{$_[0]}, scalar keys %{$_[0]};
+}
+
+package main;
+tie my %h => "TieScalar";
+$h{key1} = "val1";
+$h{key2} = "val2";
+print scalar %h, "\n";
+%h = ();
+print scalar %h, "\n";
+EXPECT
+SCALAR
+2/2
+SCALAR
+0
+########
+
+# test scalar on tied hash when no SCALAR method has been given
+package TieScalar;
+
+sub TIEHASH {
+ my $pkg = shift;
+ bless { } => $pkg;
+}
+sub STORE {
+ $_[0]->{$_[1]} = $_[2];
+}
+sub FETCH {
+ $_[0]->{$_[1]}
+}
+sub CLEAR {
+ %{ $_[0] } = ();
+}
+sub FIRSTKEY {
+ my $a = keys %{ $_[0] };
+ print "FIRSTKEY\n";
+ each %{ $_[0] };
+}
+
+package main;
+tie my %h => "TieScalar";
+
+if (!%h) {
+ print "empty\n";
+} else {
+ print "not empty\n";
+}
+
+$h{key1} = "val1";
+print "not empty\n" if %h;
+print "not empty\n" if %h;
+print "-->\n";
+my ($k,$v) = each %h;
+print "<--\n";
+print "not empty\n" if %h;
+%h = ();
+print "empty\n" if ! %h;
+EXPECT
+FIRSTKEY
+empty
+FIRSTKEY
+not empty
+FIRSTKEY
+not empty
+-->
+FIRSTKEY
+<--
+not empty
+FIRSTKEY
+empty
+########
+sub TIESCALAR { bless {} }
+sub FETCH { my $x = 3.3; 1 if 0+$x; $x }
+tie $h, "main";
+print $h,"\n";
+EXPECT
+3.3
+########
+sub TIESCALAR { bless {} }
+sub FETCH { shift()->{i} ++ }
+tie $h, "main";
+print $h.$h;
+EXPECT
+01
+########
+sub TIESCALAR { my $foo = $_[1]; bless \$foo, $_[0] }
+sub FETCH { ${$_[0]} }
+tie my $x, "main", 2;
+tie my $y, "main", 8;
+print $x | $y;
+EXPECT
+10
+########
+# Bug 36267
+sub TIEHASH { bless {}, $_[0] }
+sub STORE { $_[0]->{$_[1]} = $_[2] }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY { each %{$_[0]} }
+sub DELETE { delete $_[0]->{$_[1]} }
+sub CLEAR { %{$_[0]} = () }
+$h{b}=1;
+delete $h{b};
+print scalar keys %h, "\n";
+tie %h, 'main';
+$i{a}=1;
+%h = %i;
+untie %h;
+print scalar keys %h, "\n";
+EXPECT
+0
+0