mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
ee58f5e18c
I got sick of reverse engineering run_multiple_progs() tests and runperl() arguments each time I needed to use them. There's some documentation in comments inline but it's pretty variable and less accessible than pod. Since (in theory anyway) we want test.pl to exercise as little of perl as possible, the POD doesn't belong in test.pl itself. So I've put this in t/test_pl.pod since it's not really end user documentation that would belong in pod/.
92 lines
1.8 KiB
Perl
92 lines
1.8 KiB
Perl
#!/usr/bin/env perl -w
|
|
|
|
# Examples from test_pl.pod
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
require './test.pl';
|
|
set_up_inc( '../lib' );
|
|
}
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
watchdog(10);
|
|
|
|
{
|
|
my $pi = 3.14159265;
|
|
within(sin($pi/6), 0.5, 0.0001, "sin(PI/6) is sane");
|
|
within(cos($pi/2), 0, 0.0001, "cos(PI/2) is sane");
|
|
}
|
|
|
|
{
|
|
my $x = \(1+1);
|
|
refcount_is($x, 1, "only one reference");
|
|
my $ref = $x;
|
|
refcount_is($x, 2, "two references");
|
|
}
|
|
{
|
|
object_ok(*STDERR{IO}, "IO::Handle", "check STDERR is IO");
|
|
}
|
|
{
|
|
use IO::File;
|
|
class_ok("IO::File", "IO::Handle", "Check IO::File is a class");
|
|
}
|
|
{
|
|
warnings_like(sub { my $x; $x+1 },
|
|
[ qr/^Use of uninitialized value \$x in addition/ ],
|
|
"undefined value in addition");
|
|
}
|
|
{
|
|
warning_is(sub {
|
|
#line 1 "fake.pl"
|
|
my $x; $x+1
|
|
}, "Use of uninitialized value \$x in addition (+) at fake.pl line 1.\n",
|
|
"exact warning check");
|
|
}
|
|
|
|
{
|
|
warning_like(sub { my $x; $x+1 },
|
|
qr/^Use of uninitialized value \$x in addition/,
|
|
"undefined value in addition");
|
|
}
|
|
|
|
{
|
|
fresh_perl_is(<<~'CODE', "Hello\n", {}, "test print");
|
|
print "Hello\n";
|
|
CODE
|
|
fresh_perl_like(<<~'CODE', qr/^Hello at/, {}, "test print like");
|
|
die "Hello";
|
|
CODE
|
|
}
|
|
|
|
{
|
|
run_multiple_progs('', \*DATA);
|
|
}
|
|
|
|
{
|
|
my $out = runperl(prog => "print qq(Hello\n)");
|
|
is($out, "Hello\n", "runperl");
|
|
}
|
|
{
|
|
my @warnings = capture_warnings(sub { my $x; $x+1 });
|
|
is(@warnings, 1, "captured one warning");
|
|
like($warnings[0], qr/^Use of uninitialized value \$x in addition/,
|
|
"check undefined value in addition warning");
|
|
}
|
|
watchdog(0);
|
|
|
|
done_testing;
|
|
|
|
__END__
|
|
# NAME first multi test
|
|
print "One\n";
|
|
EXPECT
|
|
One
|
|
########
|
|
# NAME second multi test
|
|
die "Two";
|
|
EXPECT
|
|
OPTIONS fatal
|
|
Two at - line 1.
|