croak "unexpected return to Die";
}
+ my $md5_hex = sub {
+ my ($buf) = @_;
+
+ # Evaluate the MD5 sum for a string
+ # Patch for [rt.cpan.org #88020]
+ # Use utf8::encode since md5_hex() only operates on bytes.
+ # my $digest = md5_hex( utf8::encode($sink_buffer) );
+
+ # Note added 20180114: the above patch did not work correctly. I'm not
+ # sure why. But switching to the method recommended in the Perl 5
+ # documentation for Encode worked. According to this we can either use
+ # $octets = encode_utf8($string) or equivalently
+ # $octets = encode("utf8",$string)
+ # and then calculate the checksum. So:
+ my $octets = Encode::encode( "utf8", $buf );
+ my $digest = md5_hex($octets);
+ return $digest;
+ };
+
# extract various dump parameters
my $dump_options_type = $input_hash{'dump_options_type'};
my $dump_options = $get_hash_ref->('dump_options');
while ( my $input_file = shift @ARGV ) {
my $fileroot;
my @input_file_stat;
- my $display_name;
+ my $display_name;
#---------------------------------------------------------------
# prepare this input stream
$rpending_logfile_message );
next unless ($source_object);
+ my $max_iterations = $rOpts->{'iterations'};
+ my $do_convergence_test = $max_iterations > 1;
+ my $convergence_log_message;
+ my %saw_md5;
+ my $digest_input = 0;
+
# Prefilters and postfilters: The prefilter is a code reference
# that will be applied to the source before tidying, and the
# postfilter is a code reference to the result before outputting.
$prefilter
|| ( $rOpts_character_encoding
&& $rOpts_character_encoding eq 'utf8' )
+ || $rOpts->{'assert-unchanged'}
+ || $do_convergence_test
)
{
my $buf = '';
$buf .= $line;
}
- $buf = $prefilter->($buf) if $prefilter;
-
if ( $rOpts_character_encoding
&& $rOpts_character_encoding eq 'utf8'
&& !utf8::is_utf8($buf) )
}
}
+ # MD5 sum of input file is evaluated before any prefilter
+ if ( $rOpts->{'assert-unchanged'} ) {
+ $digest_input = $md5_hex->($buf);
+ }
+
+ $buf = $prefilter->($buf) if $prefilter;
+
+ # starting MD5 sum for convergence test is evaluated after any prefilter
+ if ($do_convergence_test) {
+ my $digest = $md5_hex->($buf);
+ $saw_md5{$digest} = 1;
+ }
+
$source_object = Perl::Tidy::LineSource->new( \$buf, $rOpts,
$rpending_logfile_message );
}
$line_separator = "\n" unless defined($line_separator);
my ( $sink_object, $postfilter_buffer );
- if ($postfilter) {
+ if ( $postfilter || $rOpts->{'assert-unchanged'} ) {
$sink_object =
Perl::Tidy::LineSink->new( \$postfilter_buffer, $tee_file,
$line_separator, $rOpts, $rpending_logfile_message, $binmode );
# loop over iterations for one source stream
#---------------------------------------------------------------
- # We will do a convergence test if 3 or more iterations are allowed.
- # It would be pointless for fewer because we have to make at least
- # two passes before we can see if we are converged, and the test
- # would just slow things down.
- my $max_iterations = $rOpts->{'iterations'};
- my $convergence_log_message;
- my %saw_md5;
- my $do_convergence_test = $max_iterations > 2;
-
- # Since Digest::MD5 qw(md5_hex) has been in the earliest version of Perl
- # we are requiring (5.8), I have commented out this check
-##? if ($do_convergence_test) {
-##? eval "use Digest::MD5 qw(md5_hex)";
-##? $do_convergence_test = !$@;
-##?
-##? ### Trying to avoid problems with ancient versions of perl
-##? ##eval { my $string = "perltidy"; utf8::encode($string) };
-##? ##$do_convergence_test = $do_convergence_test && !$@;
-##? }
-
# save objects to allow redirecting output during iterations
my $sink_object_final = $sink_object;
my $debugger_object_final = $debugger_object;
}
elsif ($do_convergence_test) {
- # Patch for [rt.cpan.org #88020]
- # Use utf8::encode since md5_hex() only operates on bytes.
- # my $digest = md5_hex( utf8::encode($sink_buffer) );
-
- # Note added 20180114: this patch did not work correctly.
- # I'm not sure why. But switching to the method
- # recommended in the Perl 5 documentation for Encode
- # worked. According to this we can either use
- # $octets = encode_utf8($string) or equivalently
- # $octets = encode("utf8",$string)
- # and then calculate the checksum. So:
- my $octets = Encode::encode( "utf8", $sink_buffer );
- my $digest = md5_hex($octets);
+ my $digest = $md5_hex->($sink_buffer);
if ( !$saw_md5{$digest} ) {
$saw_md5{$digest} = $iter;
}
#---------------------------------------------------------------
# Perform any postfilter operation
#---------------------------------------------------------------
- if ($postfilter) {
+ if ( $postfilter || $rOpts->{'assert-unchanged'} ) {
$sink_object->close_output_file();
$sink_object =
Perl::Tidy::LineSink->new( $output_file, $tee_file,
$line_separator, $rOpts, $rpending_logfile_message, $binmode );
- my $buf = $postfilter->($postfilter_buffer);
+
+ my $buf =
+ $postfilter
+ ? $postfilter->($postfilter_buffer)
+ : $postfilter_buffer;
+
+ # Check if file changed if requested, but only after any postfilter
+ if ( $rOpts->{'assert-unchanged'} ) {
+ my $digest_output = $md5_hex->($buf);
+ if ( $digest_output ne $digest_input ) {
+ $logger_object->warning(
+"assertion failure: '--assert-unchanged' is set but output differs from input\n"
+ );
+ }
+ }
+
$source_object =
Perl::Tidy::LineSource->new( \$buf, $rOpts,
$rpending_logfile_message );
# Fix for RT #130297: return a true value if anything was written to the
# standard error output, even non-fatal warning messages, otherwise return
- # false.
+ # false.
# To allow the caller to determine the error severity, these exit codes are
# returned:
# 2 - successful run but with non-fatal warning messages
# Note that if perltidy is run with multiple files, any single file with
- # errors or warnings will write a line like
- # '## Please see file testing.t.ERR'
+ # errors or warnings will write a line like
+ # '## Please see file testing.t.ERR'
# to standard output for each file with errors, so the flag will be true,
# even only some of the multiple files may have had errors.
$add_option->( 'tabs', 't', '!' );
$add_option->( 'default-tabsize', 'dt', '=i' );
$add_option->( 'extended-syntax', 'xs', '!' );
+ $add_option->( 'assert-unchanged', 'auc', '!' );
########################################
$category = 2; # Code indentation control
projects / perltidy.git / commitdiff