From ddd601047a76fb519d4acba4c59d77ebfde1fa6e Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 30 Apr 2010 20:06:11 -0500
Subject: only color the actual warning/error

also clean up a couple more edge cases
---
 t/001-term.t   |  8 ++++----
 t/002-html.t   |  8 ++++----
 t/003-detect.t |  4 ++--
 t/004-eval.t   | 40 ++++++++++++++++++++++++++++++++++++++++
 t/005-object.t | 10 ++++++++++
 5 files changed, 60 insertions(+), 10 deletions(-)
 create mode 100644 t/004-eval.t
 create mode 100644 t/005-object.t

(limited to 't')

diff --git a/t/001-term.t b/t/001-term.t
index 07c2751..7c1977d 100644
--- a/t/001-term.t
+++ b/t/001-term.t
@@ -20,7 +20,7 @@ output_is(<<EOF,
     use Carp::Always::Color::Term;
     warn "foo";
 EOF
-    "\e[33mfoo at -e line 2\e[m\n",
+    "\e[33mfoo\e[m at -e line 2\n",
     "simple warns work");
 
 output_is(<<EOF,
@@ -30,14 +30,14 @@ output_is(<<EOF,
     }
     foo();
 EOF
-    "\e[33mfoo at -e line 3\e[m\n\tmain::foo() called at -e line 5\n",
+    "\e[33mfoo\e[m at -e line 3\n\tmain::foo() called at -e line 5\n",
     "warns with a stacktrace work");
 
 output_is(<<EOF,
     use Carp::Always::Color::Term;
     die "foo";
 EOF
-    "\e[31mfoo at -e line 2\e[m\n",
+    "\e[31mfoo\e[m at -e line 2\n",
     "simple dies work");
 
 output_is(<<EOF,
@@ -47,5 +47,5 @@ output_is(<<EOF,
     }
     foo();
 EOF
-    "\e[31mfoo at -e line 3\e[m\n\tmain::foo() called at -e line 5\n",
+    "\e[31mfoo\e[m at -e line 3\n\tmain::foo() called at -e line 5\n",
     "dies with a stacktrace work");
diff --git a/t/002-html.t b/t/002-html.t
index 86be6a9..f51914d 100644
--- a/t/002-html.t
+++ b/t/002-html.t
@@ -20,7 +20,7 @@ output_is(<<EOF,
     use Carp::Always::Color::HTML;
     warn "foo";
 EOF
-    "<span style=\"color:#880\">foo at -e line 2</span>\n",
+    "<span style=\"color:#880\">foo</span> at -e line 2\n",
     "simple warns work");
 
 output_is(<<EOF,
@@ -30,14 +30,14 @@ output_is(<<EOF,
     }
     foo();
 EOF
-    "<span style=\"color:#880\">foo at -e line 3</span>\n\tmain::foo() called at -e line 5\n",
+    "<span style=\"color:#880\">foo</span> at -e line 3\n\tmain::foo() called at -e line 5\n",
     "warns with a stacktrace work");
 
 output_is(<<EOF,
     use Carp::Always::Color::HTML;
     die "foo";
 EOF
-    "<span style=\"color:#800\">foo at -e line 2</span>\n",
+    "<span style=\"color:#800\">foo</span> at -e line 2\n",
     "simple dies work");
 
 output_is(<<EOF,
@@ -47,5 +47,5 @@ output_is(<<EOF,
     }
     foo();
 EOF
-    "<span style=\"color:#800\">foo at -e line 3</span>\n\tmain::foo() called at -e line 5\n",
+    "<span style=\"color:#800\">foo</span> at -e line 3\n\tmain::foo() called at -e line 5\n",
     "dies with a stacktrace work");
diff --git a/t/003-detect.t b/t/003-detect.t
index aadcf88..6c4f7d3 100644
--- a/t/003-detect.t
+++ b/t/003-detect.t
@@ -20,7 +20,7 @@ output_is(<<EOF,
     use Carp::Always::Color;
     warn "foo";
 EOF
-    "\e[33mfoo at -e line 2\e[m\n",
+    "\e[33mfoo\e[m at -e line 2\n",
     "detection works for terminal output");
 
 output_is(<<EOF,
@@ -33,5 +33,5 @@ output_is(<<EOF,
     warn "foo";
     print \$stderr;
 EOF
-    "<span style=\"color:#880\">foo at -e line 7</span>\n",
+    "<span style=\"color:#880\">foo</span> at -e line 7\n",
     "detection works for terminal output");
diff --git a/t/004-eval.t b/t/004-eval.t
new file mode 100644
index 0000000..3500dc0
--- /dev/null
+++ b/t/004-eval.t
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+BEGIN {
+    eval "use IO::Pty::Easy;";
+    plan skip_all => "IO::Pty::Easy is required for this test" if $@;
+    plan tests => 2;
+}
+
+sub output_is {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    my ($script, $expected, $desc) = @_;
+    my $pty = IO::Pty::Easy->new;
+    $pty->spawn("$^X", "-e", $script);
+    is($pty->read, $expected, $desc);
+}
+
+output_is(<<EOF,
+    use Carp::Always::Color;
+    eval { die "foo" };
+    if (\$@) {
+        die \$@;
+    }
+EOF
+    "\e[31m\e[31mfoo\e[m\e[m at -e line 4\n",
+    "rethrowing works");
+
+output_is(<<EOF,
+    use Carp::Always::Color;
+    sub foo {
+        eval { die "foo" };
+        if (\$@) {
+            die \$@;
+        }
+    }
+    foo();
+EOF
+    "\e[31m\e[31mfoo\e[m\e[m at -e line 5\n\tmain::foo() called at -e line 8\n",
+    "rethrowing works inside functions");
diff --git a/t/005-object.t b/t/005-object.t
new file mode 100644
index 0000000..3a88dd3
--- /dev/null
+++ b/t/005-object.t
@@ -0,0 +1,10 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use Carp::Always::Color;
+
+my $err = bless({}, 'My::Error::Class');
+eval { die $err };
+is($@, $err, "exception objects aren't affected");
-- 
cgit v1.2.3-54-g00ecf