This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync with CPAN version 5.00 of Term::ANSIColor
authorRuss Allbery <rra@cpan.org>
Mon, 6 Jan 2020 20:04:59 +0000 (15:04 -0500)
committerJames E Keenan <jkeenan@cpan.org>
Mon, 6 Jan 2020 20:10:58 +0000 (15:10 -0500)
Committer: Provide additional email address for contributor.

13 files changed:
MANIFEST
Porting/Maintainers.pl
Porting/checkAUTHORS.pl
cpan/Term-ANSIColor/lib/Term/ANSIColor.pm
cpan/Term-ANSIColor/t/lib/Test/RRA.pm
cpan/Term-ANSIColor/t/lib/Test/RRA/Config.pm
cpan/Term-ANSIColor/t/module/aliases-func.t
cpan/Term-ANSIColor/t/module/basic.t
cpan/Term-ANSIColor/t/module/basic256.t
cpan/Term-ANSIColor/t/module/eval.t
cpan/Term-ANSIColor/t/module/stringify.t
cpan/Term-ANSIColor/t/module/true-color.t [new file with mode: 0644]
cpan/Term-ANSIColor/t/taint/basic.t

index 1d550f2..80370a7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2013,6 +2013,7 @@ cpan/Term-ANSIColor/t/module/basic.t
 cpan/Term-ANSIColor/t/module/basic256.t
 cpan/Term-ANSIColor/t/module/eval.t
 cpan/Term-ANSIColor/t/module/stringify.t
+cpan/Term-ANSIColor/t/module/true-color.t
 cpan/Term-ANSIColor/t/taint/basic.t
 cpan/Term-Cap/Cap.pm                   Perl module supporting termcap usage
 cpan/Term-Cap/test.pl                  See if Term::Cap works
index 659048e..1f58da1 100755 (executable)
@@ -1013,7 +1013,7 @@ use File::Glob qw(:case);
     },
 
     'Term::ANSIColor' => {
-        'DISTRIBUTION' => 'RRA/Term-ANSIColor-4.06.tar.gz',
+        'DISTRIBUTION' => 'RRA/Term-ANSIColor-5.00.tar.gz',
         'FILES'        => q[cpan/Term-ANSIColor],
         'EXCLUDED'     => [
             qr{^docs/},
index a00d89d..eac5df0 100755 (executable)
@@ -874,6 +874,7 @@ roderick\100argon.org                   roderick\100gate.net
 argrath\100ub32.org                     root\100ub32.org
 rootbeer\100teleport.com                rootbeer\100redcat.com
 +                                       tomphoenix\100unknown
+rra\100stanford.edu                     rra\100cpan.org
 rurban\100x-ray.at                      rurban\100cpan.org
 +                                       rurban\100cpanel.net
 rvtol+news\100isolution.nl              rvtol\100isolution.nl
index 730124b..e3daa88 100644 (file)
@@ -1,17 +1,17 @@
 # Color screen output using ANSI escape sequences.
 #
-# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
-#     2011, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
-# Copyright 1996 Zenin
-# Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
+# This module provides utility functions (in two different forms) for coloring
+# output with ANSI escape sequences.
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# PUSH/POP support submitted 2007 by openmethods.com voice solutions
+# This module is sometimes used in low-memory environments, so avoid use of
+# \d, \w, [:upper:], and similar constructs in the most important functions
+# (color, colored, AUTOLOAD, and the generated constant functions) since
+# loading the Unicode attribute files consumes a lot of memory.
 #
 # Ah, September, when the sysadmins turn colors and fall off the trees....
 #                               -- Dave Van Domelen
+#
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
 ##############################################################################
 # Modules and declarations
 
 package Term::ANSIColor;
 
-use 5.006;
+use 5.008;
 use strict;
 use warnings;
 
 # Also uses Carp but loads it on demand to reduce memory usage.
 
-use Exporter ();
+use Exporter;
 
-# use Exporter plus @ISA instead of use base for 5.6 compatibility.
+# use Exporter plus @ISA instead of use base to reduce memory usage.
 ## no critic (ClassHierarchies::ProhibitExplicitISA)
 
 # Declare variables that should be set in BEGIN for robustness.
@@ -41,7 +41,7 @@ our $AUTOLOAD;
 # against circular module loading (not that we load any modules, but
 # consistency is good).
 BEGIN {
-    $VERSION = '4.06';
+    $VERSION = '5.00';
 
     # All of the basic supported constants, used in %EXPORT_TAGS.
     my @colorlist = qw(
@@ -173,7 +173,7 @@ for my $n (0 .. 23) {
 
 # Reverse lookup.  Alphabetically first name for a sequence is preferred.
 our %ATTRIBUTES_R;
-for my $attr (reverse sort keys %ATTRIBUTES) {
+for my $attr (reverse(sort(keys(%ATTRIBUTES)))) {
     $ATTRIBUTES_R{ $ATTRIBUTES{$attr} } = $attr;
 }
 
@@ -188,17 +188,18 @@ for my $code (16 .. 255) {
 
 # Import any custom colors set in the environment.
 our %ALIASES;
-if (exists $ENV{ANSI_COLORS_ALIASES}) {
+if (exists($ENV{ANSI_COLORS_ALIASES})) {
     my $spec = $ENV{ANSI_COLORS_ALIASES};
-    $spec =~ s{\s+}{}xmsg;
+    $spec =~ s{ \A \s+ }{}xms;
+    $spec =~ s{ \s+ \z }{}xms;
 
     # Error reporting here is an interesting question.  Use warn rather than
     # carp because carp would report the line of the use or require, which
     # doesn't help anyone understand what's going on, whereas seeing this code
     # will be more helpful.
     ## no critic (ErrorHandling::RequireCarping)
-    for my $definition (split m{,}xms, $spec) {
-        my ($new, $old) = split m{=}xms, $definition, 2;
+    for my $definition (split(m{\s*,\s*}xms, $spec)) {
+        my ($new, $old) = split(m{\s*=\s*}xms, $definition, 2);
         if (!$new || !$old) {
             warn qq{Bad color mapping "$definition"};
         } else {
@@ -320,7 +321,6 @@ sub AUTOLOAD {
     $@ = $eval_err;
 
     # Dispatch to the newly-created sub.
-    ## no critic (References::ProhibitDoubleSigils)
     goto &$AUTOLOAD;
 }
 ## use critic
@@ -393,25 +393,35 @@ sub LOCALCOLOR {
 #  Throws: Text exception for any invalid attribute
 sub color {
     my (@codes) = @_;
-    @codes = map { split } @codes;
 
     # Return the empty string if colors are disabled.
     if ($ENV{ANSI_COLORS_DISABLED}) {
         return q{};
     }
 
+    # Split on whitespace and expand aliases.
+    @codes = map { split } @codes;
+    @codes = map { defined($ALIASES{$_}) ? @{ $ALIASES{$_} } : $_ } @codes;
+
     # Build the attribute string from semicolon-separated numbers.
+    ## no critic (RegularExpressions::ProhibitEnumeratedClasses)
     my $attribute = q{};
     for my $code (@codes) {
         $code = lc($code);
         if (defined($ATTRIBUTES{$code})) {
             $attribute .= $ATTRIBUTES{$code} . q{;};
-        } elsif (defined($ALIASES{$code})) {
-            $attribute .= $ALIASES{$code} . q{;};
+        } elsif ($code =~ m{ \A (on_)? r([0-9]+) g([0-9]+) b([0-9]+) \z }xms) {
+            my ($r, $g, $b) = ($2 + 0, $3 + 0, $4 + 0);
+            if ($r > 255 || $g > 255 || $b > 255) {
+                croak("Invalid attribute name $code");
+            }
+            my $prefix = $1 ? '48' : '38';
+            $attribute .= "$prefix;2;$r;$g;$b;";
         } else {
             croak("Invalid attribute name $code");
         }
     }
+    ## use critic
 
     # We added one too many semicolons for simplicity.  Remove the last one.
     chop($attribute);
@@ -444,20 +454,38 @@ sub uncolor {
             croak("Bad escape sequence $escape");
         }
 
-        # Pull off 256-color codes (38;5;n or 48;5;n) as a unit.
-        push(@nums, $attrs =~ m{ ( 0*[34]8;0*5;\d+ | \d+ ) (?: ; | \z ) }xmsg);
+        # Pull off 256-color codes (38;5;n or 48;5;n) and true color codes
+        # (38;2;n;n;n or 48;2;n;n;n) as a unit.
+        my $regex = qr{
+            (
+                0*[34]8 ; 0*2 ; \d+ ; \d+ ; \d+
+              | 0*[34]8 ; 0*5 ; \d+
+              | \d+
+            )
+            (?: ; | \z )
+        }xms;
+        push(@nums, $attrs =~ m{$regex}xmsg);
     }
 
     # Now, walk the list of numbers and convert them to attribute names.
     # Strip leading zeroes from any of the numbers.  (xterm, at least, allows
     # leading zeroes to be added to any number in an escape sequence.)
     for my $num (@nums) {
-        $num =~ s{ ( \A | ; ) 0+ (\d) }{$1$2}xmsg;
-        my $name = $ATTRIBUTES_R{$num};
-        if (!defined($name)) {
-            croak("No name for escape sequence $num");
+        if ($num =~ m{ \A 0*([34])8 ; 0*2 ; (\d+) ; (\d+) ; (\d+) \z }xms) {
+            my ($r, $g, $b) = ($2 + 0, $3 + 0, $4 + 0);
+            if ($r > 255 || $g > 255 || $b > 255) {
+                croak("No name for escape sequence $num");
+            }
+            my $prefix = ($1 == 4) ? 'on_' : q{};
+            push(@result, "${prefix}r${r}g${g}b${b}");
+        } else {
+            $num =~ s{ ( \A | ; ) 0+ (\d) }{$1$2}xmsg;
+            my $name = $ATTRIBUTES_R{$num};
+            if (!defined($name)) {
+                croak("No name for escape sequence $num");
+            }
+            push(@result, $name);
         }
-        push(@result, $name);
     }
 
     # Return the attribute names.
@@ -484,7 +512,7 @@ sub colored {
     my ($first, @rest) = @_;
     my ($string, @codes);
     if (ref($first) && ref($first) eq 'ARRAY') {
-        @codes = @{$first};
+        @codes  = @{$first};
         $string = join(q{}, @rest);
     } else {
         $string = $first;
@@ -514,19 +542,20 @@ sub colored {
 # Define a new color alias, or return the value of an existing alias.
 #
 # $alias - The color alias to define
-# $color - The standard color the alias will correspond to (optional)
+# @color - The color attributes the alias will correspond to (optional)
 #
-# Returns: The standard color value of the alias
+# Returns: The standard color value of the alias as a string (may be multiple
+#              attributes separated by spaces)
 #          undef if one argument was given and the alias was not recognized
 #  Throws: Text exceptions for invalid alias names, attempts to use a
 #          standard color name as an alias, or an unknown standard color name
 sub coloralias {
-    my ($alias, $color) = @_;
-    if (!defined($color)) {
-        if (!exists $ALIASES{$alias}) {
-            return;
+    my ($alias, @color) = @_;
+    if (!@color) {
+        if (exists($ALIASES{$alias})) {
+            return join(q{ }, @{ $ALIASES{$alias} });
         } else {
-            return $ATTRIBUTES_R{ $ALIASES{$alias} };
+            return;
         }
     }
 
@@ -538,14 +567,23 @@ sub coloralias {
         croak(qq{Invalid alias name "$alias"});
     } elsif ($ATTRIBUTES{$alias}) {
         croak(qq{Cannot alias standard color "$alias"});
-    } elsif (!exists $ATTRIBUTES{$color}) {
-        croak(qq{Invalid attribute name "$color"});
     }
     ## use critic
 
+    # Split on whitespace and expand aliases.
+    @color = map { split } @color;
+    @color = map { defined($ALIASES{$_}) ? @{ $ALIASES{$_} } : $_ } @color;
+
+    # Check that all of the attributes are valid.
+    for my $attribute (@color) {
+        if (!exists($ATTRIBUTES{$attribute})) {
+            croak(qq{Invalid attribute name "$attribute"});
+        }
+    }
+
     # Set the alias and return.
-    $ALIASES{$alias} = $ATTRIBUTES{$color};
-    return $color;
+    $ALIASES{$alias} = [@color];
+    return join(q{ }, @color);
 }
 
 # Given a string, strip the ANSI color codes out of that string and return the
@@ -574,9 +612,12 @@ sub colorvalid {
     my (@codes) = @_;
     @codes = map { split(q{ }, lc) } @codes;
     for my $code (@codes) {
-        if (!(defined($ATTRIBUTES{$code}) || defined($ALIASES{$code}))) {
-            return;
+        next if defined($ATTRIBUTES{$code});
+        next if defined($ALIASES{$code});
+        if ($code =~ m{ \A (?: on_ )? r (\d+) g (\d+) b (\d+) \z }xms) {
+            next if ($1 <= 255 && $2 <= 255 && $3 <= 255);
         }
+        return;
     }
     return 1;
 }
@@ -599,7 +640,7 @@ command.com NT ESC Delvare SSH OpenSSH aixterm ECMA-048 Fraktur overlining
 Zenin reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com
 openmethods.com. grey ATTR urxvt mistyped prepending Bareword filehandle
 Cygwin Starsinic aterm rxvt CPAN RGB Solarized Whitespace alphanumerics
-undef
+undef CLICOLOR NNN GGG RRR
 
 =head1 SYNOPSIS
 
@@ -666,16 +707,20 @@ other through constants.  It also offers the utility functions uncolor(),
 colorstrip(), colorvalid(), and coloralias(), which have to be explicitly
 imported to be used (see L</SYNOPSIS>).
 
+If you are using Term::ANSIColor in a console command, consider supporting the
+CLICOLOR standard.  See L</"Supporting CLICOLOR"> for more information.
+
 See L</COMPATIBILITY> for the versions of Term::ANSIColor that introduced
 particular features and the versions of Perl that included them.
 
 =head2 Supported Colors
 
-Terminal emulators that support color divide into three types: ones that
-support only eight colors, ones that support sixteen, and ones that
-support 256.  This module provides the ANSI escape codes for all of them.
-These colors are referred to as ANSI colors 0 through 7 (normal), 8
-through 15 (16-color), and 16 through 255 (256-color).
+Terminal emulators that support color divide into four types: ones that
+support only eight colors, ones that support sixteen, ones that support 256,
+and ones that support 24-bit color.  This module provides the ANSI escape
+codes for all of them.  These colors are referred to as ANSI colors 0 through
+7 (normal), 8 through 15 (16-color), 16 through 255 (256-color), and true
+color (called direct-color by B<xterm>).
 
 Unfortunately, interpretation of colors 0 through 7 often depends on
 whether the emulator supports eight colors or sixteen colors.  Emulators
@@ -698,6 +743,16 @@ C<red> is color 1 and C<bright_red> is color 9.  The same applies for
 background colors: C<on_red> is the normal color and C<on_bright_red> is
 the bright color.  Capitalize these strings for the constant interface.
 
+There is unfortunately no way to know whether the current emulator
+supports more than eight colors, which makes the choice of colors
+difficult.  The most conservative choice is to use only the regular
+colors, which are at least displayed on all emulators.  However, they will
+appear dark in sixteen-color terminal emulators, including most common
+emulators in UNIX X environments.  If you know the display is one of those
+emulators, you may wish to use the bright variants instead.  Even better,
+offer the user a way to configure the colors for a given application to
+fit their terminal emulator.
+
 For 256-color emulators, this module additionally provides C<ansi0>
 through C<ansi15>, which are the same as colors 0 through 15 in
 sixteen-color emulators but use the 256-color escape syntax, C<grey0>
@@ -711,15 +766,12 @@ completely on non-256-color terminals or may be misinterpreted and produce
 random behavior.  Additional attributes such as blink, italic, or bold may
 not work with the 256-color palette.
 
-There is unfortunately no way to know whether the current emulator
-supports more than eight colors, which makes the choice of colors
-difficult.  The most conservative choice is to use only the regular
-colors, which are at least displayed on all emulators.  However, they will
-appear dark in sixteen-color terminal emulators, including most common
-emulators in UNIX X environments.  If you know the display is one of those
-emulators, you may wish to use the bright variants instead.  Even better,
-offer the user a way to configure the colors for a given application to
-fit their terminal emulator.
+For true color emulators, this module supports attributes of the form C<<
+rI<NNN>gI<NNN>bI<NNN> >> and C<< on_rI<NNN>gI<NNN>bI<NNN> >> for all values of
+I<NNN> between 0 and 255.  These represent foreground and background colors,
+respectively, with the RGB values given by the I<NNN> numbers.  These colors
+may be ignored completely on non-true-color terminals or may be misinterpreted
+and produce random behavior.
 
 =head2 Function Interface
 
@@ -766,6 +818,12 @@ C<rgb000> or C<rgb515>.  Similarly, the recognized background colors are:
 
 plus C<on_rgbI<RGB>> for I<R>, I<G>, and I<B> values from 0 to 5.
 
+For true color terminals, the recognized foreground colors are C<<
+rI<RRR>gI<GGG>bI<BBB> >> for I<RRR>, I<GGG>, and I<BBB> values between 0 and
+255.  Similarly, the recognized background colors are C<<
+on_rI<RRR>gI<GGG>bI<BBB> >> for I<RRR>, I<GGG>, and I<BBB> values between 0
+and 255.
+
 For any of the above listed attributes, case is not significant.
 
 Attributes, once set, last until they are unset (by printing the attribute
@@ -808,6 +866,13 @@ default background color for the next line.  Programs like pagers can also
 be confused by attributes that span lines.  Normally you'll want to set
 $Term::ANSIColor::EACHLINE to C<"\n"> to use this feature.
 
+Particularly consider setting $Term::ANSIColor::EACHLINE if you are
+interleaving output to standard output and standard error and you aren't
+flushing standard output (via autoflush() or setting C<$|>).  If you don't,
+the code to reset the color may unexpectedly sit in the standard output buffer
+rather than going to the display, causing standard error output to appear in
+the wrong color.
+
 =item uncolor(ESCAPE)
 
 uncolor() performs the opposite translation as color(), turning escape
@@ -827,17 +892,21 @@ together in scalar context.  Its arguments are not modified.
 colorvalid() takes attribute strings the same as color() and returns true
 if all attributes are known and false otherwise.
 
-=item coloralias(ALIAS[, ATTR])
+=item coloralias(ALIAS[, ATTR ...])
 
-If ATTR is specified, coloralias() sets up an alias of ALIAS for the
-standard color ATTR.  From that point forward, ALIAS can be passed into
-color(), colored(), and colorvalid() and will have the same meaning as
-ATTR.  One possible use of this facility is to give more meaningful names
-to the 256-color RGB colors.  Only ASCII alphanumerics, C<.>, C<_>, and
-C<-> are allowed in alias names.
+If ATTR is specified, it is interpreted as a list of space-separated strings
+naming attributes or existing aliases.  In this case, coloralias() sets up an
+alias of ALIAS for the set of attributes given by ATTR.  From that point
+forward, ALIAS can be passed into color(), colored(), and colorvalid() and
+will have the same meaning as the sequence of attributes given in ATTR.  One
+possible use of this facility is to give more meaningful names to the
+256-color RGB colors.  Only ASCII alphanumerics, C<.>, C<_>, and C<-> are
+allowed in alias names.
 
-If ATTR is not specified, coloralias() returns the standard color name to
-which ALIAS is aliased, if any, or undef if ALIAS does not exist.
+If ATTR is not specified, coloralias() returns the standard attribute or
+attributes to which ALIAS is aliased, if any, or undef if ALIAS does not
+exist.  If it is aliased to multiple attributes, the return value will be a
+single string and the attributes will be separated by spaces.
 
 This is the same facility used by the ANSI_COLORS_ALIASES environment
 variable (see L</ENVIRONMENT> below) but can be used at runtime, not just
@@ -904,6 +973,8 @@ to explicitly import at least C<RESET>, as in:
 
     use Term::ANSIColor 4.00 qw(RESET :constants256);
 
+True color and aliases are not supported by the constant interface.
+
 When using the constants, if you don't want to have to remember to add the
 C<, RESET> at the end of each print line, you can set
 $Term::ANSIColor::AUTORESET to a true value.  Then, the display mode will
@@ -925,13 +996,14 @@ over $Term::ANSIColor::AUTORESET, and the latter is ignored.
 
 The subroutine interface has the advantage over the constants interface in
 that only two subroutines are exported into your namespace, versus
-thirty-eight in the constants interface.  On the flip side, the constants
-interface has the advantage of better compile time error checking, since
-misspelled names of colors or attributes in calls to color() and colored()
-won't be caught until runtime whereas misspelled names of constants will
-be caught at compile time.  So, pollute your namespace with almost two
-dozen subroutines that you may not even use that often, or risk a silly
-bug by mistyping an attribute.  Your choice, TMTOWTDI after all.
+thirty-eight in the constants interface, and aliases and true color attributes
+are supported.  On the flip side, the constants interface has the advantage of
+better compile time error checking, since misspelled names of colors or
+attributes in calls to color() and colored() won't be caught until runtime
+whereas misspelled names of constants will be caught at compile time.  So,
+pollute your namespace with almost two dozen subroutines that you may not even
+use that often, or risk a silly bug by mistyping an attribute.  Your choice,
+TMTOWTDI after all.
 
 =head2 The Color Stack
 
@@ -971,6 +1043,31 @@ PUSHCOLOR pushes the attributes set by its argument, which is normally a
 string of color constants.  It can't ask the terminal what the current
 attributes are.
 
+=head2 Supporting CLICOLOR
+
+L<https://bixense.com/clicolors/> proposes a standard for enabling and
+disabling color output from console commands using two environment variables,
+CLICOLOR and CLICOLOR_FORCE.  Term::ANSIColor cannot automatically support
+this standard, since the correct action depends on where the output is going
+and Term::ANSIColor may be used in a context where colors should always be
+generated even if CLICOLOR is set in the environment.  But you can use the
+supported environment variable ANSI_COLORS_DISABLED to implement CLICOLOR in
+your own programs with code like this:
+
+    if (exists($ENV{CLICOLOR}) && $ENV{CLICOLOR} == 0) {
+        if (!$ENV{CLICOLOR_FORCE}) {
+            $ENV{ANSI_COLORS_DISABLED} = 1;
+        }
+    }
+
+If you are using the constant interface, be sure to include this code before
+you use any color constants (such as at the very top of your script), since
+this environment variable is only honored the first time a color constant is
+seen.
+
+Be aware that this will export ANSI_COLORS_DISABLED to any child processes of
+your program as well.
+
 =head1 DIAGNOSTICS
 
 =over 4
@@ -1070,9 +1167,10 @@ The format is:
 
     ANSI_COLORS_ALIASES='newcolor1=oldcolor1,newcolor2=oldcolor2'
 
-Whitespace is ignored.
+Whitespace is ignored.  The alias value can be a single attribute or a
+space-separated list of attributes.
 
-For example the L<Solarized|http://ethanschoonover.com/solarized> colors
+For example the L<Solarized|https://ethanschoonover.com/solarized> colors
 can be mapped with:
 
     ANSI_COLORS_ALIASES='\
@@ -1135,12 +1233,25 @@ $Term::ANSIColor::AUTOLOCAL was changed to take precedence over
 $Term::ANSIColor::AUTORESET, rather than the other way around, in
 Term::ANSIColor 4.00, included in Perl 5.17.8.
 
-C<ansi16> through C<ansi255>, as aliases for the C<rgb> and C<grey>
-colors, and the corresponding C<on_ansi> names and C<ANSI> and C<ON_ANSI>
-constants, were added in Term::ANSIColor 4.06.
+C<ansi16> through C<ansi255>, as aliases for the C<rgb> and C<grey> colors,
+and the corresponding C<on_ansi> names and C<ANSI> and C<ON_ANSI> constants
+were added in Term::ANSIColor 4.06, included in Perl 5.25.7.
+
+Support for true color (the C<rNNNgNNNbNNN> and C<on_rNNNgNNNbNNN>
+attributes), defining aliases in terms of other aliases, and aliases mapping
+to multiple attributes instead of only a single attribute was added in
+Term::ANSIColor 5.00.
 
 =head1 RESTRICTIONS
 
+Both colored() and many uses of the color constants will add the reset escape
+sequence after a newline.  If a program mixes colored output to standard
+output with output to standard error, this can result in the standard error
+text having the wrong color because the reset escape sequence hasn't yet been
+flushed to the display (since standard output to a terminal is line-buffered
+by default).  To avoid this, either set autoflush() on STDOUT or set
+$Term::ANSIColor::EACHLINE to C<"\n">.
+
 It would be nice if one could leave off the commas around the constants
 entirely and just say:
 
@@ -1210,18 +1321,20 @@ table.  It is not believed to be fully supported by any of the terminals
 listed, although it's displayed as green in the Linux console, but it is
 reportedly supported by urxvt.
 
-Note that codes 6 (rapid blink) and 9 (strike-through) are specified in
-ANSI X3.64 and ECMA-048 but are not commonly supported by most displays
-and emulators and therefore aren't supported by this module at the present
-time.  ECMA-048 also specifies a large number of other attributes,
-including a sequence of attributes for font changes, Fraktur characters,
-double-underlining, framing, circling, and overlining.  As none of these
-attributes are widely supported or useful, they also aren't currently
-supported by this module.
+Note that codes 6 (rapid blink) and 9 (strike-through) are specified in ANSI
+X3.64 and ECMA-048 but are not commonly supported by most displays and
+emulators and therefore aren't supported by this module.  ECMA-048 also
+specifies a large number of other attributes, including a sequence of
+attributes for font changes, Fraktur characters, double-underlining, framing,
+circling, and overlining.  As none of these attributes are widely supported or
+useful, they also aren't currently supported by this module.
 
 Most modern X terminal emulators support 256 colors.  Known to not support
 those colors are aterm, rxvt, Terminal.app, and TTY/VC.
 
+For information on true color support in various terminal emulators, see
+L<True Colour support|https://gist.github.com/XVilka/8346728>.
+
 =head1 AUTHORS
 
 Original idea (using constants) by Zenin, reimplemented using subs by Russ
@@ -1234,10 +1347,10 @@ voice solutions.
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 1996 Zenin
+Copyright 1996-1998, 2000-2002, 2005-2006, 2008-2018, 2020 Russ Allbery
+<rra@cpan.org>
 
-Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
-2011, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
+Copyright 1996 Zenin
 
 Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
 
@@ -1254,7 +1367,7 @@ The CPAN module L<Term::Chrome> provides a different interface using
 objects and operator overloading.
 
 ECMA-048 is available on-line (at least at the time of this writing) at
-L<http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
+L<https://www.ecma-international.org/publications/standards/Ecma-048.htm>.
 
 ISO 6429 is available from ISO for a charge; the author of this module
 does not own a copy of it.  Since the source material for ISO 6429 was
@@ -1262,11 +1375,19 @@ ECMA-048 and the latter is available for free, there seems little reason
 to obtain the ISO standard.
 
 The 256-color control sequences are documented at
-L<http://invisible-island.net/xterm/ctlseqs/ctlseqs.html> (search for
+L<https://invisible-island.net/xterm/ctlseqs/ctlseqs.html> (search for
 256-color).
 
+Information about true color support in various terminal emulators and test
+programs you can run to check the true color support in your terminal emulator
+are available at L<https://gist.github.com/XVilka/8346728>.
+
 The current version of this module is always available from its web site
 at L<https://www.eyrie.org/~eagle/software/ansicolor/>.  It is also part
 of the Perl core distribution as of 5.6.0.
 
 =cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End:
index bcd6532..1d5e4db 100644 (file)
@@ -5,28 +5,46 @@
 # by both C packages with Automake and by stand-alone Perl modules.  See
 # Test::RRA::Automake for additional functions specifically for C Automake
 # distributions.
+#
+# SPDX-License-Identifier: MIT
 
 package Test::RRA;
 
-use 5.006;
+use 5.008;
+use base qw(Exporter);
 use strict;
 use warnings;
 
-use Exporter;
+use Carp qw(croak);
 use File::Temp;
-use Test::More;
 
-# For Perl 5.006 compatibility.
-## no critic (ClassHierarchies::ProhibitExplicitISA)
+# Abort if Test::More was loaded before Test::RRA to be sure that we get the
+# benefits of the Test::More probing below.
+if ($INC{'Test/More.pm'}) {
+    croak('Test::More loaded before Test::RRA');
+}
+
+# Red Hat's base perl package doesn't include Test::More (one has to install
+# the perl-core package in addition).  Try to detect this and skip any Perl
+# tests if Test::More is not present.  This relies on Test::RRA being included
+# before Test::More.
+eval {
+    require Test::More;
+    Test::More->import();
+};
+if ($@) {
+    print "1..0 # SKIP Test::More required for test\n"
+      or croak('Cannot write to stdout');
+    exit 0;
+}
 
 # Declare variables that should be set in BEGIN for robustness.
-our (@EXPORT_OK, @ISA, $VERSION);
+our (@EXPORT_OK, $VERSION);
 
 # Set $VERSION and everything export-related in a BEGIN block for robustness
 # against circular module loading (not that we load any modules, but
 # consistency is good).
 BEGIN {
-    @ISA       = qw(Exporter);
     @EXPORT_OK = qw(
       is_file_contents skip_unless_author skip_unless_automated use_prereq
     );
@@ -34,7 +52,7 @@ BEGIN {
     # This version should match the corresponding rra-c-util release, but with
     # two digits for the minor version, including a leading zero if necessary,
     # so that it will sort properly.
-    $VERSION = '6.02';
+    $VERSION = '8.01';
 }
 
 # Compare a string to the contents of a file, similar to the standard is()
@@ -59,22 +77,27 @@ sub is_file_contents {
         return;
     }
 
-    # Otherwise, we show a diff, but only if we have IPC::System::Simple.
-    eval { require IPC::System::Simple };
+    # Otherwise, we show a diff, but only if we have IPC::System::Simple and
+    # diff succeeds.  Otherwise, we fall back on showing the full expected and
+    # seen output.
+    eval {
+        require IPC::System::Simple;
+
+        my $tmp     = File::Temp->new();
+        my $tmpname = $tmp->filename;
+        print {$tmp} $got or BAIL_OUT("Cannot write to $tmpname: $!\n");
+        my @command = ('diff', '-u', $expected, $tmpname);
+        my $diff    = IPC::System::Simple::capturex([0 .. 1], @command);
+        diag($diff);
+    };
     if ($@) {
-        ok(0, $message);
-        return;
+        diag('Expected:');
+        diag($expected);
+        diag('Seen:');
+        diag($data);
     }
 
-    # They're not equal.  Write out what we got so that we can run diff.
-    my $tmp     = File::Temp->new();
-    my $tmpname = $tmp->filename;
-    print {$tmp} $got or BAIL_OUT("Cannot write to $tmpname: $!\n");
-    my @command = ('diff', '-u', $expected, $tmpname);
-    my $diff = IPC::System::Simple::capturex([0 .. 1], @command);
-    diag($diff);
-
-    # Remove the temporary file and report failure.
+    # Report failure.
     ok(0, $message);
     return;
 }
@@ -89,7 +112,7 @@ sub is_file_contents {
 sub skip_unless_author {
     my ($description) = @_;
     if (!$ENV{AUTHOR_TESTING}) {
-        plan skip_all => "$description only run for author";
+        plan(skip_all => "$description only run for author");
     }
     return;
 }
@@ -108,7 +131,7 @@ sub skip_unless_automated {
     for my $env (qw(AUTOMATED_TESTING RELEASE_TESTING AUTHOR_TESTING)) {
         return if $ENV{$env};
     }
-    plan skip_all => "$description normally skipped";
+    plan(skip_all => "$description normally skipped");
     return;
 }
 
@@ -150,14 +173,14 @@ sub use_prereq {
             use $module $version \@imports;
             1;
         };
-        $error = $@;
+        $error  = $@;
         $sigdie = $SIG{__DIE__} || undef;
     }
 
     # If the use failed for any reason, skip the test.
     if (!$result || $error) {
         my $name = length($version) > 0 ? "$module $version" : $module;
-        plan skip_all => "$name required for test";
+        plan(skip_all => "$name required for test");
     }
 
     # If the module set $SIG{__DIE__}, we cleared that via local.  Restore it.
@@ -200,6 +223,14 @@ This module collects utility functions that are useful for Perl test scripts.
 It assumes Russ Allbery's Perl module layout and test conventions and will
 only be useful for other people if they use the same conventions.
 
+This module B<must> be loaded before Test::More or it will abort during
+import.  It will skip the test (by printing a skip message to standard output
+and exiting with status 0, equivalent to C<plan skip_all>) during import if
+Test::More is not available.  This allows tests written in Perl using this
+module to be skipped if run on a system with Perl but not Test::More, such as
+Red Hat systems with the C<perl> package but not the C<perl-core> package
+installed.
+
 =head1 FUNCTIONS
 
 None of these functions are imported by default.  The ones used by a script
@@ -244,7 +275,9 @@ Russ Allbery <eagle@eyrie.org>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2013, 2014 The Board of Trustees of the Leland Stanford Junior
+Copyright 2016, 2018-2019 Russ Allbery <eagle@eyrie.org>
+
+Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior
 University
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
@@ -277,3 +310,7 @@ by the L<Lancaster
 Consensus|https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>.
 
 =cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End:
index bdb31e6..80a1573 100644 (file)
@@ -4,27 +4,25 @@
 # configuration file to store some package-specific data.  This module loads
 # that configuration and provides the namespace for the configuration
 # settings.
+#
+# SPDX-License-Identifier: MIT
 
 package Test::RRA::Config;
 
-use 5.006;
+use 5.008;
+use base qw(Exporter);
 use strict;
 use warnings;
 
-# For Perl 5.006 compatibility.
-## no critic (ClassHierarchies::ProhibitExplicitISA)
-
-use Exporter;
 use Test::More;
 
 # Declare variables that should be set in BEGIN for robustness.
-our (@EXPORT_OK, @ISA, $VERSION);
+our (@EXPORT_OK, $VERSION);
 
 # Set $VERSION and everything export-related in a BEGIN block for robustness
 # against circular module loading (not that we load any modules, but
 # consistency is good).
 BEGIN {
-    @ISA       = qw(Exporter);
     @EXPORT_OK = qw(
       $COVERAGE_LEVEL @COVERAGE_SKIP_TESTS @CRITIC_IGNORE $LIBRARY_PATH
       $MINIMUM_VERSION %MINIMUM_VERSION @MODULE_VERSION_IGNORE
@@ -34,7 +32,7 @@ BEGIN {
     # This version should match the corresponding rra-c-util release, but with
     # two digits for the minor version, including a leading zero if necessary,
     # so that it will sort properly.
-    $VERSION = '6.02';
+    $VERSION = '8.01';
 }
 
 # If C_TAP_BUILD or C_TAP_SOURCE are set in the environment, look for
@@ -185,9 +183,9 @@ Russ Allbery <eagle@eyrie.org>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2015, 2016 Russ Allbery <eagle@eyrie.org>
+Copyright 2015-2016, 2019 Russ Allbery <eagle@eyrie.org>
 
-Copyright 20132014 The Board of Trustees of the Leland Stanford Junior
+Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior
 University
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
@@ -220,3 +218,7 @@ The C TAP Harness test driver and libraries for TAP-based C testing are
 available from L<https://www.eyrie.org/~eagle/software/c-tap-harness/>.
 
 =cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End:
index 7ba1c3e..a62ea50 100644 (file)
@@ -2,15 +2,15 @@
 #
 # Test setting color aliases via the function interface.
 #
-# Copyright 2012 Russ Allbery <rra@cpan.org>
+# Copyright 2012, 2020 Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
-use Test::More tests => 23;
+use Test::More tests => 30;
 
 # Load the module.
 BEGIN {
@@ -30,21 +30,50 @@ like(
 
 # Basic alias functionality.
 is(coloralias('alert', 'red'), 'red', 'coloralias works and returns color');
-is(color('alert'), color('red'), 'alert now works as a color');
+is(color('alert'),           color('red'),      'alert now works as a color');
 is(colored('test', 'alert'), "\e[31mtest\e[0m", '..and colored works');
 ok(colorvalid('alert'), '...and alert is now a valid color');
 is(coloralias('alert'), 'red', 'coloralias with one arg returns value');
 
 # The alias can be changed.
 is(coloralias('alert', 'green'), 'green', 'changing the alias works');
-is(coloralias('alert'), 'green',        '...and changed the mapping');
-is(color('alert'),      color('green'), '...and now returns its new value');
+is(coloralias('alert'),          'green', '...and changed the mapping');
+is(color('alert'), color('green'), '...and now returns its new value');
+
+# Aliasing to an alias expands the underlying alias.
+is(coloralias('warning', 'alert'), 'green', 'aliasing to an alias works');
+is(color('warning'), color('green'), '...and returns the right value');
+
+# An alias can map to multiple attributes.
+is(
+    coloralias('multiple', 'blue on_green', 'bold'),
+    'blue on_green bold',
+    'aliasing to multiple attributes works'
+);
+is(color('multiple'), color('blue on_green bold'), '...and works with color');
+is(colored('foo', 'multiple'), "\e[34;42;1mfoo\e[0m", '...and colored works');
+ok(colorvalid('multiple'), '...and colorvalid works');
+
+# Those can include other aliases.
+is(
+    coloralias('multiple', 'on_blue alert blink'),
+    'on_blue green blink',
+    'aliasing to multiple attributes including aliases'
+);
+is(color('multiple'), color('on_blue green blink'), '...and works with color');
+
+# color supports aliases among multiple attributes.
+is(
+    color('bold warning'),
+    color('bold', 'green'),
+    'color supports aliases with multiple attributes'
+);
 
 # uncolor ignores aliases.
 is_deeply([uncolor("\e[32m")], ['green'], 'uncolor ignores aliases');
 
 # Asking for the value of an unknown alias returns undef.
-is(coloralias('warning'), undef, 'coloralias on unknown alias returns undef');
+is(coloralias('foo'), undef, 'coloralias on unknown alias returns undef');
 
 # Invalid alias names.
 $output = eval { coloralias('foo;bar', 'green') };
@@ -71,7 +100,7 @@ like(
     '...with the right error'
 );
 
-# Aliasing to a color that doesn't exist, or to another alias.
+# Aliasing to a color that doesn't exist.
 $output = eval { coloralias('warning', 'chartreuse') };
 ok(!$output, 'aliasing to an unknown color rejected');
 like(
@@ -79,10 +108,3 @@ like(
     qr{ \A Invalid [ ] attribute [ ] name [ ] "chartreuse" [ ] at [ ] }xms,
     '...with the right error'
 );
-$output = eval { coloralias('warning', 'alert') };
-ok(!$output, 'aliasing to an alias rejected');
-like(
-    $@,
-    qr{ \A Invalid [ ] attribute [ ] name [ ] "alert" [ ] at [ ] }xms,
-    '...with the right error'
-);
index 735ce52..c70eed6 100644 (file)
@@ -2,12 +2,12 @@
 #
 # Basic test suite for the Term::ANSIColor Perl module.
 #
-# Copyright 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2009, 2010, 2012, 2014
+# Copyright 1997-1998, 2000-2002, 2005-2006, 2009-2010, 2012, 2014, 2020
 #     Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
@@ -24,7 +24,7 @@ BEGIN {
 # Various basic tests.
 is(color('blue on_green', 'bold'), "\e[34;42;1m", 'Simple attributes');
 is(colored('testing', 'blue', 'bold'), "\e[34;1mtesting\e[0m", 'colored');
-is((BLUE BOLD 'testing'), "\e[34m\e[1mtesting", 'Constants');
+is((BLUE BOLD 'testing'),              "\e[34m\e[1mtesting",   'Constants');
 is(join(q{}, BLUE, BOLD, 'testing'),
     "\e[34m\e[1mtesting", 'Constants with commas');
 is((BLUE 'test', 'ing'), "\e[34mtesting", 'Constants with multiple strings');
@@ -130,7 +130,7 @@ is((POPCOLOR 'text'),       "\e[31m\e[42mtext", '...and POPCOLOR works');
 is((LOCALCOLOR GREEN ON_BLUE 'text'),
     "\e[32m\e[44mtext\e[31m\e[42m", 'LOCALCOLOR');
 $Term::ANSIColor::AUTOLOCAL = 1;
-is((BLUE 'text'), "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL');
+is((BLUE 'text'),     "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL');
 is((BLUE 'te', 'xt'), "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL with commas');
 $Term::ANSIColor::AUTOLOCAL = 0;
 is((POPCOLOR 'text'), "\e[0mtext", 'POPCOLOR with empty stack');
index ae06d1a..e72e3a4 100644 (file)
@@ -3,11 +3,11 @@
 # Tests for 256-color support.
 #
 # Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
-# Copyright 2012, 2013, 2016 Russ Allbery <rra@cpan.org>
+# Copyright 2012-2013, 2016, 2020 Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
index b5332ee..72a57fb 100644 (file)
@@ -6,11 +6,11 @@
 # processing and lose its value or leak $@ values to the calling program.
 # This is a regression test to ensure that this problem doesn't return.
 #
-# Copyright 2012, 2013, 2014 Russ Allbery <rra@cpan.org>
+# Copyright 2012-2014, 2020 Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
index acb558d..ed2f7c3 100644 (file)
@@ -3,11 +3,11 @@
 # Test suite for stringify interaction.
 #
 # Copyright 2011 Revilo Reegiles
-# Copyright 2011, 2014 Russ Allbery <rra@cpan.org>
+# Copyright 2011, 2014, 2020 Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
@@ -17,7 +17,7 @@ use Test::More tests => 6;
 ## no critic (Modules::ProhibitMultiplePackages)
 package Test::Stringify;
 use overload '""' => 'stringify';
-sub new { return bless({}, 'Test::Stringify') }
+sub new       { return bless({}, 'Test::Stringify') }
 sub stringify { return "Foo Bar\n" }
 
 # Back to the main package.
diff --git a/cpan/Term-ANSIColor/t/module/true-color.t b/cpan/Term-ANSIColor/t/module/true-color.t
new file mode 100644 (file)
index 0000000..de7bfc7
--- /dev/null
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+#
+# Tests for true color support (24-bit color).
+#
+# Copyright 2020 Russ Allbery <rra@cpan.org>
+#
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use Test::More tests => 82;
+
+# Load the module.
+BEGIN {
+    delete $ENV{ANSI_COLORS_ALIASES};
+    delete $ENV{ANSI_COLORS_DISABLED};
+    use_ok('Term::ANSIColor', qw(color uncolor colorvalid));
+}
+
+# Test basic true color codes.
+is(color('r0g0b0'),          "\e[38;2;0;0;0m",       'foreground 0 0 0');
+is(color('r000g000b000'),    "\e[38;2;0;0;0m",       'foreground 000 000 000');
+is(color('r255g0b0'),        "\e[38;2;255;0;0m",     'foreground 255 0 0');
+is(color('r0g255b0'),        "\e[38;2;0;255;0m",     'foreground 255 0 0');
+is(color('r0g0b255'),        "\e[38;2;0;0;255m",     'foreground 255 0 0');
+is(color('r255g255b255'),    "\e[38;2;255;255;255m", 'foreground 255 255 255');
+is(color('r1g02b003'),       "\e[38;2;1;2;3m",       'foreground 1 02 003');
+is(color('on_r0g0b0'),       "\e[48;2;0;0;0m",       'background 0 0 0');
+is(color('on_r000g000b000'), "\e[48;2;0;0;0m",       'background 000 000 000');
+is(color('on_r255g0b0'),     "\e[48;2;255;0;0m",     'background 255 0 0');
+is(color('on_r0g255b0'),     "\e[48;2;0;255;0m",     'background 255 0 0');
+is(color('on_r0g0b255'),     "\e[48;2;0;0;255m",     'background 255 0 0');
+is(color('on_r255g255b255'), "\e[48;2;255;255;255m", 'background 255 255 255');
+is(color('on_r1g02b003'),    "\e[48;2;1;2;3m",       'background 1 02 003');
+
+# Check that various true color codes are valid.
+my @valid = qw(
+  r0g0b0 r255g255b255 r1g02b003 on_r0g0b0 on_r255g255b255 on_r1g02b003
+);
+for my $color (@valid) {
+    ok(colorvalid($color), "Color $color is valid");
+}
+
+# Errors at boundary cases.
+my @invalid = qw(
+  r0g0 r256g0b0 r0g256b0 r0g0b256 r1000g2b3 rgb r1g2b r1gb2 r1b2g3
+);
+for my $color (@invalid) {
+    my $output = eval { color($color) };
+    is($output, undef, 'color on an invalid attribute fails');
+    like(
+        $@,
+        qr{ \A Invalid [ ] attribute [ ] name [ ] \Q$color\E [ ] at [ ] }xms,
+        '...with the right error'
+    );
+    ok(!colorvalid($color), '...and colorvalid says it is invalid');
+}
+
+# Check uncolor with true color codes.
+is_deeply([uncolor('38;2;0;0;0')],  ['r0g0b0'],    'uncolor of r0g0b0');
+is_deeply([uncolor('48;02;0;0;0')], ['on_r0g0b0'], 'uncolor of on_r0g0b0');
+is_deeply([uncolor("\e[038;2;255;255;255")],
+    ['r255g255b255'], 'uncolor of r255g255b255');
+is_deeply([uncolor("\e[48;002;255;255;255")],
+    ['on_r255g255b255'], 'uncolor of on_r255g255b255');
+is_deeply(
+    [uncolor("\e[1;38;2;1;02;003;5;48;2;4;5;6m")],
+    [qw(bold r1g2b3 blink on_r4g5b6)],
+    'uncolor of a complex escape',
+);
+is_deeply(
+    [uncolor("\e[1;38;2;1;02;003;5;48;5;230m")],
+    [qw(bold r1g2b3 blink on_rgb554)],
+    'uncolor mixing true-color and 256-color',
+);
+
+# An invalid true-color code should report an error on the part that makes it
+# invalid.  Check truncated codes (should report on the 38 or 48), codes with
+# an invalid second part (likewise), and codes with an invalid third part
+# (should report the complete code).
+#
+# This is a hash of test escape sequences to the invalid sequence that should
+# be reported.
+my %uncolor_tests = (
+    "\e[38;1m"             => 38,
+    "\e[38;2m"             => 38,
+    "\e[38;2;255;0m"       => 38,
+    "\e[38;2;256;0;0m"     => '38;2;256;0;0',
+    "\e[38;2;0;256;0m"     => '38;2;0;256;0',
+    "\e[38;2;0;0;256m"     => '38;2;0;0;256',
+    "\e[38;2;777;777;777m" => '38;2;777;777;777',
+    "\e[48;1m"             => 48,
+    "\e[48;2m"             => 48,
+    "\e[48;2;255;0m"       => 48,
+    "\e[48;2;256;0;0m"     => '48;2;256;0;0',
+    "\e[48;2;0;256;0m"     => '48;2;0;256;0',
+    "\e[48;2;0;0;256m"     => '48;2;0;0;256',
+    "\e[48;2;777;777;777m" => '48;2;777;777;777',
+);
+while (my ($escape, $invalid) = each(%uncolor_tests)) {
+    my $output = eval { uncolor($escape) };
+    is($output, undef, "uncolor on unknown color code \Q$escape\E fails");
+    like(
+        $@,
+        qr{ \A No [ ] name [ ] for [ ] escape [ ] sequence [ ] \Q$invalid\E
+            [ ] at [ ] }xms,
+        '...with the right error'
+    );
+}
index 53a6bb6..4d7c012 100644 (file)
@@ -7,11 +7,11 @@
 # an environment variable).  Term::ANSIColor does the work to untaint it; be
 # sure that the taint flag is properly cleared.
 #
-# Copyright 2012 Russ Allbery <rra@cpan.org>
+# Copyright 2012, 2020 Russ Allbery <rra@cpan.org>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
 
+use 5.008;
 use strict;
 use warnings;
 
@@ -27,7 +27,7 @@ BEGIN {
 # Generate a tainted constant name.  PATH is always tainted, and tainting is
 # sticky, so we can prepend the name to whatever PATH holds and then chop it
 # off again.
-my $constant = substr 'BOLD' . $ENV{PATH}, 0, length 'BOLD';
+my $constant = substr('BOLD' . $ENV{PATH}, 0, length('BOLD'));
 
 # Using that as a constant should now work without any tainting problems.
 ## no critic (TestingAndDebugging::ProhibitNoStrict)