New upstream version 20221112

[perltidy.git] / lib / Perl / Tidy / Diagnostics.pm

diff --git a/lib/Perl/Tidy/Diagnostics.pm b/lib/Perl/Tidy/Diagnostics.pm
index 1893f1c9262d18cf1dd2bed205bc30ec7604ce0c..a111ce8f1723e33837abf7bc7475cbfe0d790d92 100644 (file)
--- a/lib/Perl/Tidy/Diagnostics.pm
+++ b/lib/Perl/Tidy/Diagnostics.pm
@@ -20,15 +20,44 @@
 package Perl::Tidy::Diagnostics;
 use strict;
 use warnings;
-our $VERSION = '20200110';
+use English qw( -no_match_vars );
+our $VERSION = '20221112';
+
+use constant EMPTY_STRING => q{};
+
+sub AUTOLOAD {
+
+    # Catch any undefined sub calls so that we are sure to get
+    # some diagnostic information.  This sub should never be called
+    # except for a programming error.
+    our $AUTOLOAD;
+    return if ( $AUTOLOAD =~ /\bDESTROY$/ );
+    my ( $pkg, $fname, $lno ) = caller();
+    my $my_package = __PACKAGE__;
+    print STDERR <<EOM;
+======================================================================
+Error detected in package '$my_package', version $VERSION
+Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
+Called from package: '$pkg'  
+Called from File '$fname'  at line '$lno'
+This error is probably due to a recent programming change
+======================================================================
+EOM
+    exit 1;
+}
+
+sub DESTROY {
+
+    # required to avoid call to AUTOLOAD in some versions of perl
+}
 
 sub new {
 
     my $class = shift;
     return bless {
         _write_diagnostics_count => 0,
-        _last_diagnostic_file    => "",
-        _input_file              => "",
+        _last_diagnostic_file    => EMPTY_STRING,
+        _input_file              => EMPTY_STRING,
         _fh                      => undef,
     }, $class;
 }
@@ -44,7 +73,7 @@ sub write_diagnostics {
 
     unless ( $self->{_write_diagnostics_count} ) {
         open( $self->{_fh}, ">", "DIAGNOSTICS" )
-          or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $!\n");
+          or Perl::Tidy::Die("couldn't open DIAGNOSTICS: $ERRNO\n");
     }
 
     my $fh                   = $self->{_fh};