From a2d85d10f650cb2f8d3f9c53f71219aa62841a7a Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Mon, 11 Oct 2021 17:53:32 -0700 Subject: [PATCH] removed unused syntax check coding; updated some error messages --- lib/Perl/Tidy.pm | 130 ++----------------------------------- lib/Perl/Tidy/Logger.pm | 92 ++------------------------ lib/Perl/Tidy/Tokenizer.pm | 20 ++++-- 3 files changed, 23 insertions(+), 219 deletions(-) diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index e33fd335..aa37dfc4 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -1644,7 +1644,7 @@ EOM $source_object->close_input_file(); } - # Save names of the input and output files for syntax check + # Save names of the input and output files my $ifname = $input_file; my $ofname = $output_file; @@ -1782,21 +1782,6 @@ EOM } } - #--------------------------------------------------------------- - # Do syntax check if requested and possible - # This is permanently deactivated but the code remains for reference - #--------------------------------------------------------------- - my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes - if ( 0 - && $logger_object - && $rOpts->{'check-syntax'} - && $ifname - && $ofname ) - { - $infile_syntax_ok = - check_syntax( $ifname, $ofname, $logger_object, $rOpts ); - } - #--------------------------------------------------------------- # remove the original file for in-place modify as follows: # $delete_backup=0 never @@ -1828,7 +1813,7 @@ EOM } } - $logger_object->finish( $infile_syntax_ok, $formatter ) + $logger_object->finish($formatter) if $logger_object; } ## end of main loop to process all files @@ -2007,8 +1992,8 @@ sub get_stream_as_named_file { # $fname = name of file if possible, or undef # $if_tmpfile = true if temp file, undef if not temp file # - # This routine is needed for passing actual files to Perl for - # a syntax check. + # NOTE: This routine was previously needed for passing actual files to Perl + # for a syntax check. It is not currently used. my ($stream) = @_; my $is_tmpfile; my $fname; @@ -4251,7 +4236,6 @@ I/O control -bext=s change default backup extension from 'bak' to s -q deactivate error messages (for running under editor) -w include non-critical warning messages in the .ERR error output - -syn run perl -c to check syntax (default under unix systems) -log save .LOG file, which has useful diagnostics -f force perltidy to read a binary file -g like -log but writes more detailed .LOG file, for debugging scripts @@ -4445,110 +4429,4 @@ sub process_this_file { return; } - -sub check_syntax { - - # Use 'perl -c' to make sure that we did not create bad syntax - # This is a very good independent check for programming errors - # - # Given names of the input and output files, ($istream, $ostream), - # we do the following: - # - check syntax of the input file - # - if bad, all done (could be an incomplete code snippet) - # - if infile syntax ok, then check syntax of the output file; - # - if outfile syntax bad, issue warning; this implies a code bug! - # - set and return flag "infile_syntax_ok" : =-1 bad 0 unknown 1 good - - my ( $istream, $ostream, $logger_object, $rOpts ) = @_; - my $infile_syntax_ok = 0; - my $line_of_dashes = '-' x 42 . "\n"; - - my $flags = $rOpts->{'perl-syntax-check-flags'}; - - # be sure we invoke perl with -c - # note: perl will accept repeated flags like '-c -c'. It is safest - # to append another -c than try to find an interior bundled c, as - # in -Tc, because such a 'c' might be in a quoted string, for example. - if ( $flags !~ /(^-c|\s+-c)/ ) { $flags .= " -c" } - - # be sure we invoke perl with -x if requested - # same comments about repeated parameters applies - if ( $rOpts->{'look-for-hash-bang'} ) { - if ( $flags !~ /(^-x|\s+-x)/ ) { $flags .= " -x" } - } - - # this shouldn't happen unless a temporary file couldn't be made - if ( $istream eq '-' ) { - $logger_object->write_logfile_entry( - "Cannot run perl -c on STDIN and STDOUT\n"); - return $infile_syntax_ok; - } - - $logger_object->write_logfile_entry( - "checking input file syntax with perl $flags\n"); - - # Not all operating systems/shells support redirection of the standard - # error output. - my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1'; - - my ( $istream_filename, $perl_output ) = - do_syntax_check( $istream, $flags, $error_redirection ); - $logger_object->write_logfile_entry( - "Input stream passed to Perl as file $istream_filename\n"); - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry("$perl_output\n"); - - if ( $perl_output =~ /syntax\s*OK/ ) { - $infile_syntax_ok = 1; - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry( - "checking output file syntax with perl $flags ...\n"); - my ( $ostream_filename, $perl_output ) = - do_syntax_check( $ostream, $flags, $error_redirection ); - $logger_object->write_logfile_entry( - "Output stream passed to Perl as file $ostream_filename\n"); - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry("$perl_output\n"); - - unless ( $perl_output =~ /syntax\s*OK/ ) { - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->warning( -"The output file has a syntax error when tested with perl $flags $ostream !\n" - ); - $logger_object->warning( - "This implies an error in perltidy; the file $ostream is bad\n" - ); - $logger_object->report_definite_bug(); - - # the perl version number will be helpful for diagnosing the problem - $logger_object->write_logfile_entry( $^V . "\n" ); - } - } - else { - - # Only warn of perl -c syntax errors. Other messages, - # such as missing modules, are too common. They can be - # seen by running with perltidy -w - $logger_object->complain("A syntax check using perl $flags\n"); - $logger_object->complain( - "for the output in file $istream_filename gives:\n"); - $logger_object->complain($line_of_dashes); - $logger_object->complain("$perl_output\n"); - $logger_object->complain($line_of_dashes); - $infile_syntax_ok = -1; - $logger_object->write_logfile_entry($line_of_dashes); - $logger_object->write_logfile_entry( -"The output file will not be checked because of input file problems\n" - ); - } - return $infile_syntax_ok; -} - -sub do_syntax_check { - - # This should not be called; the syntax check is deactivated - Die("Unexpected call for syntax check-shouldn't happen\n"); - return; -} - 1; diff --git a/lib/Perl/Tidy/Logger.pm b/lib/Perl/Tidy/Logger.pm index 9b7a8ce4..9ec2e239 100644 --- a/lib/Perl/Tidy/Logger.pm +++ b/lib/Perl/Tidy/Logger.pm @@ -435,113 +435,32 @@ sub warning { return; } -# programming bug codes: -# -1 = no bug -# 0 = maybe, not sure. -# 1 = definitely -sub report_possible_bug { - my $self = shift; - my $saw_code_bug = $self->{_saw_code_bug}; - $self->{_saw_code_bug} = ( $saw_code_bug < 0 ) ? 0 : $saw_code_bug; - return; -} - sub report_definite_bug { my $self = shift; $self->{_saw_code_bug} = 1; return; } -sub ask_user_for_bug_report { - - my ( $self, $infile_syntax_ok, $formatter ) = @_; - my $saw_code_bug = $self->{_saw_code_bug}; - if ( ( $saw_code_bug == 0 ) && ( $infile_syntax_ok == 1 ) ) { - $self->warning(<{_saw_extrude} ) { - $self->warning(<warning(<get_added_semicolon_count(); - }; - if ( $added_semicolon_count > 0 ) { - $self->warning(<{_saw_code_bug}; my $rOpts = $self->{_rOpts}; - return - $saw_code_bug == 1 - || $rOpts->{'logfile'} - || $rOpts->{'check-syntax'}; + return $saw_code_bug == 1 || $rOpts->{'logfile'}; } sub finish { # called after all formatting to summarize errors - my ( $self, $infile_syntax_ok, $formatter ) = @_; + my ( $self, $formatter ) = @_; my $rOpts = $self->{_rOpts}; my $warning_count = $self->{_warning_count}; my $saw_code_bug = $self->{_saw_code_bug}; - my $save_logfile = - ( $saw_code_bug == 0 && $infile_syntax_ok == 1 ) - || $saw_code_bug == 1 + my $save_logfile = $saw_code_bug == 1 || $rOpts->{'logfile'}; my $log_file = $self->{_log_file}; if ($warning_count) { @@ -565,9 +484,6 @@ sub finish { } } - # 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}; my $is_encoded_data = $self->{_is_encoded_data}; diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 20d8f755..c65728bd 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -3029,7 +3029,9 @@ EOM Program bug; didn't find here doc target EOM } - warning("Program bug; didn't find here doc target\n"); + warning( +"Possible program error: didn't find here doc target\n" + ); report_definite_bug(); } } @@ -3079,7 +3081,9 @@ EOM Program bug; didn't find here doc target EOM } - warning("Program bug; didn't find here doc target\n"); + warning( +"Possible program error: didn't find here doc target\n" + ); report_definite_bug(); } } @@ -4459,7 +4463,9 @@ EOM non-number beginning with digit--program bug EOM } - warning("non-number beginning with digit--program bug\n"); + warning( +"Unexpected error condition: non-number beginning with digit\n" + ); report_definite_bug(); } } @@ -6838,7 +6844,7 @@ 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" +"Possible program bug in sub scan_id: undefined type but scan_state=$id_scan_state\n" ); report_definite_bug(); } @@ -8240,9 +8246,13 @@ sub find_angle_operator_termination { # It may be possible that a quote ends midway in a pretoken. # If this happens, it may be necessary to split the pretoken. if ($error) { + if (DEVEL_MODE) { + Fault(<