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
index 0d3de96..2a4c9cc 100755 (executable)
@@ -7,10 +7,16 @@
 #
 # It is impossible to test every prototype that can be specified, but
 # we should test as many as we can.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
 
 use strict;
 
-print "1..74\n";
+print "1..80\n";
 
 my $i = 1;
 
@@ -356,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";