improve error diagnostics

diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl
index 7a343760fa96c4410f4f5219e4075f67aa11dfc9..d3696fc81beccfc329c8c895bbe8b63b5008324e 100755 (executable)
--- a/dev-bin/perltidy_random_setup.pl
+++ b/dev-bin/perltidy_random_setup.pl
@@ -21,7 +21,7 @@ our $rsetup;    # the setup hash
 my $config_file   = "config.txt";
 my $FILES_file    = "FILES.txt";
 my $PROFILES_file = "PROFILES.txt";
-my $perltidy      = "";
+my $perltidy      = "./perltidy.pl";
 my $rfiles        = [];
 my $rprofiles     = [];
 

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index df8f477a12a809811833f4d2421e5e0fb416d840..8c839601b47e703a40314213c3600511a251e7bc 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -4654,12 +4654,16 @@ sub make_closing_side_comment_prefix {
         if ( bad_pattern($test_csc_prefix_pattern) ) {
 
             # shouldn't happen..must have screwed up escaping, above
-            report_definite_bug();
-            Warn(
-"Program Error: the -cscp prefix '$csc_prefix' caused the invalid regex '$csc_prefix_pattern'\n"
-            );
+            if (DEVEL_MODE) {
+                Fault(<<EOM);
+Program Error: the -cscp prefix '$csc_prefix' caused the invalid regex '$csc_prefix_pattern'
+EOM
+            }
 
             # just warn and keep going with defaults
+            Warn(
+"Error: the -cscp prefix '$csc_prefix' caused the invalid regex '$csc_prefix_pattern'\n"
+            );
             Warn("Please consider using a simpler -cscp prefix\n");
             Warn("Using default -cscp instead; please check output\n");
         }
@@ -13755,12 +13759,11 @@ Program bug in call to lookup_opening_indentation - index out of range
  called with index i_opening=$i_opening  > $i_last_line = max index of last line
 This batch has max index = $max_index_to_go,
 EOM
-        report_definite_bug();    # old coding, will not get here
         $nline = $#{$ri_last};
     }
 
     $rindentation_list->[0] =
-      $nline;                     # save line number to start looking next call
+      $nline;    # save line number to start looking next call
     my $ibeg       = $ri_start->[$nline];
     my $offset     = token_sequence_length( $ibeg, $i_opening ) - 1;
     my $is_leading = ( $ibeg == $i_opening );
@@ -13849,10 +13852,11 @@ sub pad_array_to_go {
             # not be possible to get here unless the code has a bracing error
             # which leaves a closing brace with zero nesting depth.
             unless ( get_saw_brace_error() ) {
-                warning(
-"Program bug in pad_array_to_go: hit nesting error which should have been caught\n"
-                );
-                report_definite_bug();
+                if (DEVEL_MODE) {
+                    Fault(<<EOM);
+Program bug in pad_array_to_go: hit nesting error which should have been caught
+EOM
+                }
             }
         }
         else {
@@ -14018,10 +14022,11 @@ sub insert_additional_breaks {
 
             # shouldn't happen unless caller passes bad indexes
             if ( $line_number >= @{$ri_last} ) {
-                warning(
-"Non-fatal program bug: couldn't set break at $i_break_left\n"
-                );
-                report_definite_bug();
+                if (DEVEL_MODE) {
+                    Fault(<<EOM);
+Non-fatal program bug: couldn't set break at $i_break_left
+EOM
+                }
                 return;
             }
             $i_f = $ri_first->[$line_number];
@@ -17041,10 +17046,11 @@ sub set_continuation_breaks {
             # formatting.
             if ( $type eq '#' ) {
                 if ( $i != $max_index_to_go ) {
-                    warning(
-"Non-fatal program bug: backup logic required to break after a comment\n"
-                    );
-                    report_definite_bug();
+                    if (DEVEL_MODE) {
+                        Fault(<<EOM);
+Non-fatal program bug: backup logic required to break after a comment
+EOM
+                    }
                     $nobreak_to_go[$i] = 0;
                     $self->set_forced_breakpoint($i);
                 } ## end if ( $i != $max_index_to_go)
@@ -19441,12 +19447,16 @@ sub get_available_spaces_to_go {
                             if (   $gnu_sequence_number != $seqno
                                 || $i > $max_gnu_item_index )
                             {
+                                if (DEVEL_MODE) {
+                                    Fault(<<EOM);
+Program bug with -lp.  seqno=$seqno should be $gnu_sequence_number and i=$i should be less than max=$max_gnu_item_index
+EOM
+                                }
                                 warning(
 "Program bug with -lp.  seqno=$seqno should be $gnu_sequence_number and i=$i should be less than max=$max_gnu_item_index\n"
                                 );
                                 report_definite_bug();
                             }
-
                             else {
                                 if ( $arrow_count == 0 ) {
                                     $gnu_item_list[$i]
@@ -19486,6 +19496,12 @@ sub get_available_spaces_to_go {
                 # only negative levels can get here, and $level was forced
                 # to be positive above.
                 else {
+                    if (DEVEL_MODE) {
+                        Fault(<<EOM);
+program bug with -lp: stack_error. level=$level; lev=$lev; ci_level=$ci_level; ci_lev=$ci_lev; rerun with -nlp
+EOM
+                    }
+
                     warning(
 "program bug with -lp: stack_error. level=$level; lev=$lev; ci_level=$ci_level; ci_lev=$ci_lev; rerun with -nlp\n"
                     );
@@ -19793,6 +19809,12 @@ sub get_available_spaces_to_go {
                     my $ci_level     = $gnu_item_list[$i_debug]->get_ci_level();
                     my $old_level    = $gnu_item_list[$i]->get_level();
                     my $old_ci_level = $gnu_item_list[$i]->get_ci_level();
+                    if (DEVEL_MODE) {
+                        Fault(<<EOM);
+program bug with -lp: want to delete $deleted_spaces from item $i, but old=$old_spaces deleted: lev=$level ci=$ci_level  deleted: level=$old_level ci=$ci_level
+EOM
+                    }
+
                     warning(
 "program bug with -lp: want to delete $deleted_spaces from item $i, but old=$old_spaces deleted: lev=$level ci=$ci_level  deleted: level=$old_level ci=$ci_level\n"
                     );

diff --git a/lib/Perl/Tidy/Logger.pm b/lib/Perl/Tidy/Logger.pm
index 16ef5f258fcbc569b8acc369e10ba99f7321891f..9b7a8ce4f7acdd54e2a2fde6c2e1680fcd2ac2ac 100644 (file)
--- a/lib/Perl/Tidy/Logger.pm
+++ b/lib/Perl/Tidy/Logger.pm
@@ -564,7 +564,9 @@ sub finish {
             $self->warning("To save a full .LOG file rerun with -g\n");
         }
     }
-    $self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
+
+    # deactivated - prefer Fault reports in DEVEL_MODE during random testing
+    ##$self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
 
     if ($save_logfile) {
         my $log_file        = $self->{_log_file};

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index 164d94548d58da1b00338d6970b6c43d30c0c619..b604e1bb640c2bd1149219e0f53c615ea9b73bc1 100644 (file)
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -3022,7 +3022,13 @@ EOM
                 elsif ( $expecting == TERM ) {
                     unless ($saw_error) {
 
-                        # shouldn't happen..
+                        # shouldn't happen..arriving here implies an error in
+                        # the logic in sub 'find_here_doc'
+                        if (DEVEL_MODE) {
+                            Fault(<<EOM);
+Program bug; didn't find here doc target
+EOM
+                        }
                         warning("Program bug; didn't find here doc target\n");
                         report_definite_bug();
                     }
@@ -3066,7 +3072,13 @@ EOM
                 elsif ( $expecting == TERM ) {
                     unless ($saw_error) {
 
-                        # shouldn't happen..
+                        # shouldn't happen..arriving here implies an error in
+                        # the logic in sub 'find_here_doc'
+                        if (DEVEL_MODE) {
+                            Fault(<<EOM);
+Program bug; didn't find here doc target
+EOM
+                        }
                         warning("Program bug; didn't find here doc target\n");
                         report_definite_bug();
                     }
@@ -4442,6 +4454,11 @@ EOM
                 if ( !defined($number) ) {
 
                     # shouldn't happen - we should always get a number
+                    if (DEVEL_MODE) {
+                        Fault(<<EOM);
+non-number beginning with digit--program bug
+EOM
+                    }
                     warning("non-number beginning with digit--program bug\n");
                     report_definite_bug();
                 }
@@ -6815,6 +6832,11 @@ sub scan_id_do {
     if ( $id_scan_state && ( !defined($type) || !$type ) ) {
 
         # shouldn't happen:
+        if (DEVEL_MODE) {
+            Fault(<<EOM);
+Program bug in scan_id: undefined type but scan_state=$id_scan_state
+EOM
+        }
         warning(
 "Program bug in scan_id: undefined type but scan_state=$id_scan_state\n"
         );
@@ -7034,11 +7056,10 @@ sub scan_identifier_do {
         }
         else {
 
-            # shouldn't happen
-            my ( $a, $b, $c ) = caller;
-            warning("Program Bug: scan_identifier given bad token = $tok \n");
-            warning("   called from sub $a  line: $c\n");
-            report_definite_bug();
+            # shouldn't happen: bad call parameter
+            Fault(<<EOM);
+Program Bug: scan_identifier received bad starting token = '$tok' 
+EOM
         }
         $saw_type = !$saw_alpha;
     }
@@ -8316,8 +8337,11 @@ sub scan_number_do {
 
     # Look for bad starting characters; Shouldn't happen..
     if ( $first_char !~ /[\d\.\+\-Ee]/ ) {
-        warning("Program bug - scan_number given character $first_char\n");
-        report_definite_bug();
+        if (DEVEL_MODE) {
+            Fault(<<EOM);
+Program bug - scan_number given bad first character = '$first_char'
+EOM
+        }
         return ( $i, $type, $number );
     }