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

1 files changed, 99 insertions, 8 deletions

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);
+    }
+}