#
# $Id: carp.pl,v 0.2 2000/11/06 19:30:33 ram Exp $
#
# Copyright (c) 1999, Raphael Manfredi
#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
#
# HISTORY
# $Log: carp.pl,v $
# Revision 0.2 2000/11/06 19:30:33 ram
# Baseline for second Alpha release.
#
# $EndLog$
#
print "1..11\n";
require 't/code.pl';
sub ok;
my $FILE = "t/carp.pl";
package OTHER;
use Log::Agent;
use Carp qw(carp cluck);
sub make { bless {}, shift }
sub intern {
my $i = $_[1];
logcarp "OTHER${i}::intern";
}
sub extern {
my $i = $_[1];
logxcarp 1, "OTHER${i}::extern";
}
package ROOT;
use Log::Agent;
sub make {
my $self = bless {}, shift;
$self->{other} = OTHER->make;
return $self;
}
sub f {
logcarp "ROOT::f";
}
sub g {
logcarp "ROOT::g";
}
sub h {
my $self = shift;
my $o = $self->{other};
$main::intern1 = __LINE__ + 1;
$o->intern(1);
$o->extern(1);
}
sub k {
my $o = OTHER->make;
$main::intern2 = __LINE__ + 1;
$o->intern(2);
$o->extern(2);
}
package SUBCLASS;
use Log::Agent;
@ISA = qw(ROOT);
sub g {
logcarp "SUBCLASS::g";
}
package main;
use Carp qw(carp cluck);
sub intern {
logcarp "main::intern";
}
sub extern {
logxcarp 1, "main::extern";
}
sub wrap {
$intern = __LINE__ + 1;
intern;
extern;
}
my $r = ROOT->make;
my $s = SUBCLASS->make;
my $file = "t/file.err";
my $base = __LINE__ + 1; # First call below
$r->f;
$s->f;
$r->g;
$s->g;
ok 1, 1 == contains($file, sprintf "ROOT::f at $FILE line %d", $base+0);
ok 2, 2 == contains($file, sprintf "ROOT::f at $FILE line %d", $base+1);
ok 3, 3 == contains($file, sprintf "ROOT::g at $FILE line %d", $base+2);
ok 4, contains($file, sprintf "SUBCLASS::g at $FILE line %d", $base+3);
# Empty file
open(FILE, ">$file");
close FILE;
$base = __LINE__ + 1; # First call below
$s->h;
ok 5, contains($file, "OTHER1::intern at $FILE line $intern1");
ok 6, contains($file, "OTHER1::extern at $FILE line $base");
$base = __LINE__ + 1; # First call below
ROOT::g();
ok 7, contains($file, "ROOT::g at $FILE line $base");
$base = __LINE__ + 1; # First call below
ROOT::k();
ok 8, contains($file, "OTHER2::intern at $FILE line $intern2");
ok 9, contains($file, "OTHER2::extern at $FILE line $base");
#
# This test would not work without the kludge fixing Carp's output
# in Log::Agent::Driver::carpmess.
#
$base = __LINE__ + 1; # First call below
wrap;
ok 10, contains($file, "main::intern at $FILE line $intern");
ok 11, contains($file, "main::extern at $FILE line $base");
unlink 't/file.out', 't/file.err';