Document Carp's global variables + provide tests

From: "Jos I. Boumans" <kane@dwim.org>
Message-Id: <ADC6DEC6-EF8B-11D8-8425-000A95EF62E2@dwim.org>
(tests a bit reworked)

p4raw-id: //depot/perl@23221

2 files changed, 181 insertions, 22 deletions

diff --git a/lib/Carp.pm b/lib/Carp.pm
index 22f7daf941..86f0d921ee 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -39,6 +39,10 @@ croak or shortmess which report the error as being from where
 your module was called.  There is no guarantee that that is where
 the error was, but it is a good educated guess.
 
+You can also alter the way the output and logic of C<Carp> works, by
+changing some global variables in the C<Carp> namespace. See the
+section on C<GLOBAL VARIABLES> below.
+
 Here is a more complete description of how shortmess works.  What
 it does is search the call-stack for a function call stack where
 it hasn't been told that there shouldn't be an error.  If every
@@ -51,7 +55,7 @@ a call shouldn't generate errors work as follows:
 
 =item 1.
 
-Any call from a package to itself is safe. 
+Any call from a package to itself is safe.
 
 =item 2.
 
@@ -95,11 +99,8 @@ This feature is enabled by 'importing' the non-existent symbol
 or by including the string C<MCarp=verbose> in the PERL5OPT
 environment variable.
 
-=head1 BUGS
-
-The Carp routines don't handle exception objects currently.
-If called with a first argument that is a reference, they simply
-call die() or warn(), as appropriate.
+Alternately, you can set the global variable C<$Carp::Verbose> to true.
+See the C<GLOBAL VARIABLES> section below.
 
 =cut
 
@@ -118,16 +119,76 @@ call die() or warn(), as appropriate.
 # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
 # text and function arguments should be formatted when printed.
 
+# Comments added by Jos I. Boumans <kane@dwim.org> 11-Aug-2004
+# I can not get %CarpInternal or %Internal to work as advertised,
+# therefor leaving it out of the below documentation.
+# $CarpLevel may be decprecated according to the last comment, but
+# after 6 years, it's still around and in heavy use ;)
+
+=pod
+
+=head1 GLOBAL VARIABLES
+
+=head2 $Carp::CarpLevel
+
+This variable determines how many call frames are to be skipped when
+reporting where an error occurred on a call to one of C<Carp>'s
+functions. For example:
+
+    $Carp::CarpLevel = 1;
+    sub bar     { .... or _error('Wrong input') }
+    sub _error  { Carp::carp(@_) }
+
+This would make Carp report the error as coming from C<bar>'s caller,
+rather than from C<_error>'s caller, as it normally would.
+
+Defaults to C<0>.
+
+=head2 $Carp::MaxEvalLen
+
+This variable determines how many characters of a string-eval are to
+be shown in the output. Use a value of C<0> to show all text.
+
+Defaults to C<0>.
+
+=head2 $Carp::MaxArgLen
+
+This variable determines how many characters of each argument to a
+function to print. Use a value of C<0> to show the full length of the
+argument.
+
+Defaults to C<64>.
+
+=head2 $Carp::MaxArgNums
+
+This variable determines how many arguments to each function to show.
+Use a value of C<0> to show all arguments to a function call.
+
+Defaults to C<8>.
+
+=head2 $Carp::Verbose
+
+This variable makes C<Carp> use the C<longmess> function at all times.
+This effectively means that all calls to C<carp> become C<cluck> and
+all calls to C<croak> become C<confess>.
+
+Note, this is analogous to using C<use Carp 'verbose'>.
+
+Defaults to C<0>.
+
+=cut
+
+
 $CarpInternal{Carp}++;
 $CarpInternal{warnings}++;
-$CarpLevel = 0;		# How many extra package levels to skip on carp.
-                        # How many calls to skip on confess.
-                        # Reconciling these notions is hard, use
-                        # %Internal and %CarpInternal instead.
-$MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
-$MaxArgLen = 64;        # How much of each argument to print. 0 = all.
-$MaxArgNums = 8;        # How many arguments to print. 0 = all.
-$Verbose = 0;		# If true then make shortmess call longmess instead
+$CarpLevel = 0;     # How many extra package levels to skip on carp.
+                    # How many calls to skip on confess.
+                    # Reconciling these notions is hard, use
+                    # %Internal and %CarpInternal instead.
+$MaxEvalLen = 0;    # How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64;    # How much of each argument to print. 0 = all.
+$MaxArgNums = 8;    # How many arguments to print. 0 = all.
+$Verbose = 0;       # If true then make shortmess call longmess instead
 
 require Exporter;
 @ISA = ('Exporter');
@@ -135,6 +196,13 @@ require Exporter;
 @EXPORT_OK = qw(cluck verbose longmess shortmess);
 @EXPORT_FAIL = qw(verbose);	# hook to enable verbose mode
 
+=head1 BUGS
+
+The Carp routines don't handle exception objects currently.
+If called with a first argument that is a reference, they simply
+call die() or warn(), as appropriate.
+
+=cut
 
 # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
 # then the following method will be called by the Exporter which knows
diff --git a/lib/Carp.t b/lib/Carp.t
index cc2da1744c..8b9bef98c7 100644
--- a/lib/Carp.t
+++ b/lib/Carp.t
@@ -5,19 +5,19 @@ BEGIN {
 
 use Carp qw(carp cluck croak confess);
 
-print "1..9\n";
+print "1..19\n";
 
 print "ok 1\n";
 
 $SIG{__WARN__} = sub {
     print "ok $1\n"
-	if $_[0] =~ m!ok (\d+)\n at .+\b(?i:carp\.t) line \d+$! };
+	if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! };
 
 carp  "ok 2\n";
-	
+
 $SIG{__WARN__} = sub {
     print "ok $1\n"
-	if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
+	if $_[0] =~ m!(\d+) at.+\b(?i:carp\.t) line \d+$! };
 
 carp 3;
 
@@ -25,7 +25,7 @@ sub sub_4 {
 
 $SIG{__WARN__} = sub {
     print "ok $1\n"
-	if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
+	if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$! };
 
 cluck 4;
 
@@ -35,14 +35,14 @@ sub_4;
 
 $SIG{__DIE__} = sub {
     print "ok $1\n"
-	if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
+	if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$! };
 
 eval { croak 5 };
 
 sub sub_6 {
     $SIG{__DIE__} = sub {
 	print "ok $1\n"
-	    if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at .+\b(?i:carp\.t) line \d+$! };
+	    if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$! };
 
     eval { confess 6 };
 }
@@ -65,7 +65,98 @@ eval {
 	$SIG{__WARN__} =
 	    sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
     }
-    package Z; 
+    package Z;
     BEGIN { eval { Carp::croak() } }
 };
 print $warning ? "not ok 9\n#$warning" : "ok 9\n";
+
+
+# tests for global variables
+sub x { carp @_ }
+sub w { cluck @_ }
+
+# $Carp::Verbose;
+{   my $aref = [
+        qr/t at \S*Carp.t line \d+/,
+        qr/t at \S*Carp.t line \d+\n\s*main::x\('t'\) called at \S*Carp.t line \d+/
+    ];
+    my $test_num = 10; my $i = 0;
+
+    for my $re (@$aref) {
+        local $Carp::Verbose = $i++;
+        local $SIG{__WARN__} = sub {
+	    print "not " unless $_[0] =~ $re;
+	    print "ok ".$test_num++." - Verbose\n";
+	};
+        package Z;
+        main::x('t');
+    }
+}
+
+# $Carp::MaxEvalLen
+{   my $test_num = 12;
+    for(0,4) {
+        my $txt = "Carp::cluck($test_num)";
+        local $Carp::MaxEvalLen = $_;
+        local $SIG{__WARN__} = sub {
+	    "@_"=~/'(.+?)(?:\n|')/s;
+	    print "not " unless length $1 eq length $_?substr($txt,0,$_):substr($txt,0);
+	    print "ok $test_num - MaxEvalLen\n";
+	};
+        eval "$txt"; $test_num++;
+    }
+}
+
+# $Carp::MaxArgLen
+{   my $test_num = 14;
+    for(0,4) {
+        my $arg = 'testtest';
+        local $Carp::MaxArgLen = $_;
+        local $SIG{__WARN__} = sub {
+	    "@_"=~/'(.+?)'/;
+	    print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0);
+	    print "ok ".$test_num++." - MaxArgLen\n";
+	};
+
+        package Z;
+        main::w($arg);
+    }
+}
+
+# $Carp::MaxArgNums
+{   my $test_num = 16; my $i = 0;
+    my $aref = [
+        qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*Carp.t line \d+/,
+        qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*Carp.t line \d+/,
+    ];
+
+    for(@$aref) {
+        local $Carp::MaxArgNums = $i++;
+        local $SIG{__WARN__} = sub {
+	    print "not " unless "@_"=~$_;
+	    print "ok ".$test_num++." - MaxArgNums\n";
+	};
+
+        package Z;
+        main::w(1..4);
+    }
+}
+
+# $Carp::CarpLevel
+{   my $test_num = 18; my $i = 0;
+    my $aref = [
+        qr/1 at \S*Carp.t line \d+\n\s*main::w\(1\) called at \S*Carp.t line \d+/,
+        qr/1 at \S*Carp.t line \d+$/,
+    ];
+
+    for (@$aref) {
+        local $Carp::CarpLevel = $i++;
+        local $SIG{__WARN__} = sub {
+	    print "not " unless "@_"=~$_;
+	    print "ok ".$test_num++." - CarpLevel\n";
+	};
+
+        package Z;
+        main::w(1);
+    }
+}