From ecf6296bdadc61240de5263f5f7edabf1106210a Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Mon, 28 Aug 2023 19:33:33 -0700
Subject: [PATCH] Activate PC BuiltinFunctions::ProhibitStringyEval

---
 .perlcriticrc              |  9 +++------
 lib/Perl/Tidy/Formatter.pm | 13 ++++++-------
 lib/Perl/Tidy/Tokenizer.pm | 12 +-----------
 3 files changed, 10 insertions(+), 24 deletions(-)

diff --git a/.perlcriticrc b/.perlcriticrc
index d6a47abc..89b4e900 100644
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -27,20 +27,17 @@ verbose = %f: [%p] %m at line %l, column %c.\n
 # Following is a list of policies to be skipped for severity=4:
 #--------------------------------------------------------------
 
-# There is a stringy eval in Formatter.pm and Tokenizer.pm which is essential
-# for checking user input. So we have to skip this.
-[-BuiltinFunctions::ProhibitStringyEval]
-
 # Tidy.pm exports 'perltidy'. Changing this could break existing scripts.
 [-Modules::ProhibitAutomaticExportation]
 
 # IOScalar and IOScalarArray need to define a 'print' function
 [-Subroutines::ProhibitBuiltinHomonyms]
 
-# Nested subs are needed for error handling in Tidy.pm.
+# Nested subs are currently needed for error handling in Tidy.pm.
 [-Subroutines::ProhibitNestedSubs]
 
-# Don't require arg unpacking for very short (possibly time-critical) subs.
+# Make adjustment so that we don't require arg unpacking for very short
+# (possibly time-critical) subs.
 [Subroutines::RequireArgUnpacking]
 short_subroutine_statements = 2
 
diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index d479bfd2..47bbaaaf 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -5063,14 +5063,13 @@ EOM
 } ## end closure set_bond_strengths
 
 sub bad_pattern {
-
-    # See if a pattern will compile. We have to use a string eval here,
-    # but it should be safe because the pattern has been constructed
-    # by this program.
     my ($pattern) = @_;
-    my $ok = eval "'##'=~/$pattern/";
-    return !defined($ok) || $EVAL_ERROR;
-} ## end sub bad_pattern
+
+    # See if a pattern will compile.
+    # Note: this sub is also called from Tokenizer
+    my $regex = eval { qr/$pattern/ };
+    return $EVAL_ERROR;
+}
 
 {    ## begin closure prepare_cuddled_block_types
 
diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index 27a7b0e6..bf974dda 100644
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -294,16 +294,6 @@ EOM
     return;
 } ## end sub Fault
 
-sub bad_pattern {
-
-    # See if a pattern will compile. We have to use a string eval here,
-    # but it should be safe because the pattern has been constructed
-    # by this program.
-    my ($pattern) = @_;
-    my $ok = eval "'##'=~/$pattern/";
-    return !defined($ok) || $EVAL_ERROR;
-} ## end sub bad_pattern
-
 sub make_code_skipping_pattern {
     my ( $rOpts, $opt_name, $default ) = @_;
     my $param = $rOpts->{$opt_name};
@@ -313,7 +303,7 @@ sub make_code_skipping_pattern {
         Die("ERROR: the $opt_name parameter '$param' must begin with '#'\n");
     }
     my $pattern = '^\s*' . $param . '\b';
-    if ( bad_pattern($pattern) ) {
+    if ( Perl::Tidy::Formatter::bad_pattern($pattern) ) {
         Die(
 "ERROR: the $opt_name parameter '$param' causes the invalid regex '$pattern'\n"
         );
-- 
2.39.5