proto.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
#
# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
#
# So far there are tests for the following prototypes.
# none, () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@)
#
# 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';
}
use strict;
print "1..122\n";
my $i = 1;
my $c = shift;
print '#' x 25,"\n";
print '#' x 25,"\n";
print "not "
}
@_ = qw(a b c d);
my @array;
my %hash;
##
##
##
sub no_proto {
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
##
##
##
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
eval "no_args(1)";
print "not " unless $@;
printf "ok %d\n",$i++;
##
##
##
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
eval "one_args(1,2)";
print "not " unless $@;
printf "ok %d\n",$i++;
eval "one_args()";
print "not " unless $@;
printf "ok %d\n",$i++;
}
one_a_args(@_);
##
##
##
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
eval "over_one_args()";
print "not " unless $@;
printf "ok %d\n",$i++;
}
over_one_a_args(@_);
over_one_a_args(@_,1);
over_one_a_args(@_,1,2);
over_one_a_args(@_,@_);
##
##
##
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
eval "scalar_and_hash()";
print "not " unless $@;
printf "ok %d\n",$i++;
}
scalar_and_hash_a(@_);
scalar_and_hash_a(@_,1);
scalar_and_hash_a(@_,1,2);
scalar_and_hash_a(@_,@_);
##
##
##
scalar(@_)
}
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
printf "ok %d\n",$i++;
eval "one_or_two()";
print "not " unless $@;
printf "ok %d\n",$i++;
eval "one_or_two(1,2,3)";
print "not " unless $@;
printf "ok %d\n",$i++;
}
one_or_two_a(@_);
one_or_two_a(@_,1);
one_or_two_a(@_,@_);
##
##
##
&{$_[0]};
}
eval 'a_sub @array';
##
##
##
&{$_[0]};
}
eval 'a_subx @array';
##
##
##
}
print "\n";
##
##
##
my $sub = shift;
}
print "\n";
##
##
##
}
##
##
##
$_[0]->{'b'} = 2;
}
%hash = ( a => 1);
a_hash_ref %hash;
##
##
##
}
array_ref_plus @array, @more; }
print @array;
my $p;
print "ok ", $i++, "\n";
print "ok ", $i++, "\n";
print "ok ", $i++, "\n";
print "# CORE:Foo => ($p), \$@ => `$@'\nnot "
print "ok ", $i++, "\n";
# correctly note too-short parameter lists that don't end with '$',
# a possible regression.
print "ok ", $i++, "\n";
print "ok ", $i++, "\n";
sub X::foo3;
print "ok ", $i++, "\n";
print "ok ", $i++, "\n";
# test if the (*) prototype allows barewords, constants, scalar expressions,
# globs and globrefs (just as CORE::open() does), all under stricture
# test scalarref prototype
}
{
}
# test prototypes when they are evaled and there is a syntax error
#
eval $eval;
# The /Syntax error/ is seen on OS/390. It's /syntax error/ elsewhere
print "ok ", $i++, "\n";
}