From 3fa17e3fe56d4d905804c431b7d481cde59af509 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 18 Nov 2010 13:50:28 +0000
Subject: [PATCH] Test that lack of prototype on a sub's definition overrides
 any on its stub.

This is the current behaviour for Perl_newATTRSUB(), and it turns out that we
have no test for it.
---
 t/comp/proto.t | 42 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 41 insertions(+), 1 deletion(-)

diff --git a/t/comp/proto.t b/t/comp/proto.t
index e38ba11..b5c8cf2 100644
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
 # strict
 use strict;
 
-print "1..168\n";
+print "1..172\n";
 
 my $i = 1;
 
@@ -701,3 +701,43 @@ print "ok ", $i++, "\n";
 print "not "
  unless eval 'sub uniproto9 (;+) {} uniproto9 $_, 1' or warn $@;
 print "ok ", $i++, "\n";
+
+{
+  # Lack of prototype on a subroutine definition should override any prototype
+  # on the declaration.
+  sub z_zwap (&);
+
+  local $SIG{__WARN__} = sub {
+    my $thiswarn = join "",@_;
+    if ($thiswarn =~ /^Prototype mismatch: sub main::z_zwap/) {
+      print 'ok ', $i++, "\n";
+    } else {
+      print 'not ok ', $i++, "\n";
+      print STDERR $thiswarn;
+    }
+  };
+
+  eval q{sub z_zwap {return @_}};
+
+  if ($@) {
+    print "not ok ", $i++, "# $@";
+  } else {
+    print "ok ", $i++, "\n";
+  }
+
+
+  my @a = (6,4,2);
+  my @got  = eval q{z_zwap(@a)};
+
+  if ($@) {
+    print "not ok ", $i++, " # $@";
+  } else {
+    print "ok ", $i++, "\n";
+  }
+
+  if ("@got" eq "@a") {
+    print "ok ", $i++, "\n";
+  } else {
+    print "not ok ", $i++, " # >@got<\n";
+  }
+}
-- 
2.7.4