This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
5.004_56: patch for `use Fatal' again
[perl5.git] / t / comp / proto.t
old mode 100644 (file)
new mode 100755 (executable)
index 056e622..2a4c9cc
@@ -7,23 +7,18 @@
 #
 # It is impossible to test every prototype that can be specified, but
 # we should test as many as we can.
+#
 
-use strict;
-
-my $i = 1;
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
 
-##
-## Something really weird is happening here. Try changing the order
-## of the next three lines, and try moving them to after the definition
-## of testing, some combinations cause the script to fail while
-## running tests on (&\@)
-##
+use strict;
 
-my %hash;
-my @array;
-@_ = qw(a b c d);
+print "1..80\n";
 
-print "1..74\n";
+my $i = 1;
 
 sub testing (&$) {
     my $p = prototype(shift);
@@ -38,6 +33,9 @@ sub testing (&$) {
     printf "ok %d\n",$i++;
 }
 
+@_ = qw(a b c d);
+my @array;
+my %hash;
 
 ##
 ##
@@ -364,16 +362,44 @@ printf "ok %d\n",$i++;
 ##
 ##
 
-testing \&an_array_ref, '\@';
+testing \&array_ref_plus, '\@@';
 
-sub an_array_ref (\@) {
+sub array_ref_plus (\@@) {
     print "# \@_ = (",join(",",@_),")\n";
-    print "not " unless ref($_[0]) && 1 == @{$_[0]};
+    print "not " unless @_ == 2 && ref($_[0]) && 1 == @{$_[0]} && $_[1] eq 'x';
     printf "ok %d\n",$i++;
     @{$_[0]} = (qw(ok)," ",$i++,"\n");
 }
 
 @array = ('a');
-an_array_ref @array;
+{ my @more = ('x');
+  array_ref_plus @array, @more; }
 print "not " unless @array == 4;
 print @array;
+
+my $p;
+print "not " if defined prototype('CORE::print');
+print "ok ", $i++, "\n";
+
+print "not " if defined prototype('CORE::system');
+print "ok ", $i++, "\n";
+
+print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$';
+print "ok ", $i++, "\n";
+
+print "# CORE:Foo => ($p), \$@ => `$@'\nnot " 
+    if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Cannot find an opnumber/;
+print "ok ", $i++, "\n";
+
+# correctly note too-short parameter lists that don't end with '$',
+#  a possible regression.
+
+sub foo1 ($\@);
+eval q{ foo1 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";
+
+sub foo2 ($\%);
+eval q{ foo2 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";