124 lines
3.5 KiB
Perl
124 lines
3.5 KiB
Perl
#!./perl
|
|
|
|
BEGIN { require './test.pl'; }
|
|
|
|
plan( tests => 26 );
|
|
|
|
# simple error object.
|
|
{
|
|
my $err = error::create("my message"); my $line1 = __LINE__;
|
|
ok $err, "error object created";
|
|
is ref $err, "error";
|
|
is $err->{description}, "my message";
|
|
is $err->message, "my message at ../lib/error.t line $line1.\n", "message function";
|
|
}
|
|
|
|
# a bit more complex one, with stack trace.
|
|
{
|
|
my ($line1, $line2, $line3);
|
|
sub new_error { return error::create("my message"); } $line1 = __LINE__;
|
|
sub new_error2 { return new_error(); } $line2 = __LINE__;
|
|
$err = new_error2(); $line3 = __LINE__;
|
|
is( (scalar @{$err->{stack}}), 2);
|
|
is((join '**', @{$err->{stack}[0]}), "main**../lib/error.t**$line2**main::new_error**");
|
|
is((join '**', @{$err->{stack}[1]}), "main**../lib/error.t**$line3**main::new_error2**");
|
|
is $err->message, <<MSG ;
|
|
my message at ../lib/error.t line $line1.
|
|
main::new_error called at ../lib/error.t line $line2.
|
|
main::new_error2 called at ../lib/error.t line $line3.
|
|
MSG
|
|
}
|
|
|
|
# creating the error object using 'die' inside an 'eval'
|
|
{
|
|
my ($line1, $line2);
|
|
eval { $line1 = __LINE__;
|
|
$line2 = __LINE__; die "foobar";
|
|
};
|
|
is defined $@, 1, '$@ is set';
|
|
is ref $@, "error", '$@ is an error object';
|
|
is $@->{description}, "foobar";
|
|
is $@->message, <<MSG;
|
|
foobar at ../lib/error.t line $line2.
|
|
(eval) called at ../lib/error.t line $line1.
|
|
MSG
|
|
}
|
|
|
|
# creating the error object using 'die' inside an 'eval' in an 'eval'
|
|
{
|
|
my $err;
|
|
my ($line1, $line2);
|
|
eval { $line2 = __LINE__;
|
|
eval { die "my die"; }; $line1 = __LINE__;
|
|
$err = $@;
|
|
};
|
|
is defined $err, 1, '$@ is set';
|
|
is ref $err, "error", '$@ is error object';
|
|
is $err->message, <<MSG;
|
|
my die at ../lib/error.t line $line1.
|
|
(eval) called at ../lib/error.t line $line1.
|
|
(eval) called at ../lib/error.t line $line2.
|
|
MSG
|
|
}
|
|
|
|
# die without arguments, reuses $@
|
|
{
|
|
my ($line1, $line2);
|
|
eval { $line2 = __LINE__;
|
|
eval { die "reuse die"; }; $line1 = __LINE__;
|
|
die;
|
|
};
|
|
is ref $@, "error", '$@ is an error object';
|
|
is $@->message, <<MSG;
|
|
reuse die at ../lib/error.t line $line1.
|
|
(eval) called at ../lib/error.t line $line1.
|
|
(eval) called at ../lib/error.t line $line2.
|
|
MSG
|
|
}
|
|
|
|
# Internal Perl_croak routines also make error objects
|
|
{
|
|
my $line1;
|
|
eval { my $foo = "xx"; $$foo; }; $line1 = __LINE__;
|
|
is defined $@, 1, '$@ is set';
|
|
is ref $@, 'error', '$@ is an error object';
|
|
is $@->message, <<MSG;
|
|
Can't use string ("xx") as a SCALAR ref while "strict refs" in use at ../lib/error.t line $line1.
|
|
(eval) called at ../lib/error.t line $line1.
|
|
MSG
|
|
}
|
|
|
|
# Writing the standard message
|
|
{
|
|
fresh_perl_is("die 'foobar'",
|
|
'foobar at - line 1.');
|
|
}
|
|
|
|
# Compilation error
|
|
{
|
|
fresh_perl_is('BEGIN { die "foobar" }', <<MSG );
|
|
foobar at - line 1.
|
|
BEGIN failed--compilation aborted
|
|
MSG
|
|
}
|
|
|
|
# yyerror
|
|
{
|
|
eval 'undef foo';
|
|
is defined $@, 1, '$@ is set';
|
|
is ref $@, 'error', '$@ is error object';
|
|
is $@->message, <<MSG ;
|
|
Can't modify constant item in undef operator at (eval 9) line 2, at EOF
|
|
Bareword \"foo\" not allowed while "strict subs" in use at (eval 9) line 1, at EOF
|
|
at ../lib/error.t line 107.
|
|
MSG
|
|
}
|
|
|
|
# Compilation error with '#line X'
|
|
{
|
|
fresh_perl_is("use strict;\n\$x = 1;\n\$y = 1;\n", <<'MSG' );
|
|
Global symbol "$x" requires explicit package name at - line 2, near "$x "
|
|
Global symbol "$y" requires explicit package name at - line 3, near "$y "
|
|
Execution of - aborted due to compilation errors. at - line 3.
|
|
MSG
|
|
}
|