RT #75468: readline ignores <> overloading when arg is tied

[perl5.git] / t / op / tie.t

diff --git a/t/op/tie.t b/t/op/tie.t
index 281c0d9..6e52a6e 100644 (file)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -847,7 +847,7 @@ fetching... <=> 1
   map {
    my $op = $_;
    $_ => sub { print "$op"; 100 }
-  } qw< 0+ "" + ** * / % - neg int abs == < > <= >= != <=> >
+  } qw< 0+ "" + ** * / % - neg int abs == < > <= >= != <=> <> >
 }
 $o = bless [], overloaded;
 
@@ -872,6 +872,7 @@ $ghew=undef; $ghew<=1; print "\n";
 $ghew=undef; $ghew >=1; print "\n";
 $ghew=undef; $ghew != 1; print "\n";
 $ghew=undef; $ghew<=>1; print "\n";
+$ghew=undef; <$ghew>; print "\n";
 $ghew=\*shrext; *$ghew; print "\n";
 $ghew=\@spled; @$ghew; print "\n";
 $ghew=\%frit; %$ghew; print "\n";
@@ -893,7 +894,48 @@ fetching... <=
 fetching... >=
 fetching... !=
 fetching... <=>
+fetching... <>
 fetching... *{}
 fetching... @{}
 fetching... %{}
 fetching... ${}
+########
+# RT 51636: segmentation fault with array ties
+
+tie my @a, 'T';
+@a = (1);
+print "ok\n"; # if we got here we didn't crash
+
+package T;
+
+sub TIEARRAY { bless {} }
+sub STORE    { tie my @b, 'T' }
+sub CLEAR    { }
+sub EXTEND   { }
+
+EXPECT
+ok
+########
+# RT 8438: Tied scalars don't call FETCH when subref is dereferenced
+
+sub TIESCALAR { bless {} }
+
+my $fetch = 0;
+my $called = 0;
+sub FETCH { $fetch++; sub { $called++ } }
+
+tie my $f, 'main';
+$f->(1) for 1,2;
+print "fetch=$fetch\ncalled=$called\n";
+
+EXPECT
+fetch=2
+called=2
+########
+# tie mustn't attempt to call methods on bareword filehandles.
+sub IO::File::TIEARRAY {
+    die "Did not want to invoke IO::File::TIEARRAY";
+}
+fileno FOO; tie @a, "FOO"
+EXPECT
+Can't locate object method "TIEARRAY" via package "FOO" at - line 5.