Update to Getopt::Long 2.30.

p4raw-id: //depot/perl@16288

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index 86dd61f..f038b8b 100644 (file)
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,12 +2,12 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.55 2002-03-13 13:06:44+01 jv Exp $
+# RCS Status      : $Id: GetoptLong.pm,v 2.56 2002-04-30 13:00:14+02 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Wed Mar 13 12:54:01 2002
-# Update Count    : 1070
+# Last Modified On: Tue Apr 30 12:48:49 2002
+# Update Count    : 1078
 # Status          : Released
 
 ################ Copyright ################
@@ -35,10 +35,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.29;
+$VERSION        =  2.30;
 # For testing versions only.
 use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.29";
+$VERSION_STRING = "2.30";
 
 use Exporter;
 
@@ -260,7 +260,7 @@ sub GetOptions {
     $error = '';
 
     print STDERR ("GetOpt::Long $Getopt::Long::VERSION (",
-                 '$Revision: 2.55 $', ") ",
+                 '$Revision: 2.56 $', ") ",
                  "called from package \"$pkg\".",
                  "\n  ",
                  "ARGV: (@ARGV)",
@@ -482,21 +482,25 @@ sub GetOptions {
                                      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
                                      ", \"$arg\")\n")
                            if $debug;
-                       local ($@);
-                       eval {
+                       my $eval_error = do {
+                           local $@;
                            local $SIG{__DIE__}  = '__DEFAULT__';
-                           &{$linkage{$opt}}($opt,
-                                             $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
-                                             $arg);
+                           eval {
+                               &{$linkage{$opt}}($opt,
+                                                 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+                                                 $arg);
+                           };
+                           $@;
                        };
-                       print STDERR ("=> die($@)\n") if $debug && $@ ne '';
-                       if ( $@ =~ /^!/ ) {
-                           if ( $@ =~ /^!FINISH\b/ ) {
+                       print STDERR ("=> die($eval_error)\n")
+                         if $debug && $eval_error ne '';
+                       if ( $eval_error =~ /^!/ ) {
+                           if ( $eval_error =~ /^!FINISH\b/ ) {
                                $goon = 0;
                            }
                        }
-                       elsif ( $@ ne '' ) {
-                           warn ($@);
+                       elsif ( $eval_error ne '' ) {
+                           warn ($eval_error);
                            $error++;
                        }
                    }
@@ -555,21 +559,23 @@ sub GetOptions {
            # Try non-options call-back.
            my $cb;
            if ( (defined ($cb = $linkage{'<>'})) ) {
-               local ($@);
                print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
                  if $debug;
-               eval {
+               my $eval_error = do {
+                   local $@;
                    local $SIG{__DIE__}  = '__DEFAULT__';
-                   &$cb ($tryopt);
+                   eval { &$cb ($tryopt) };
+                   $@;
                };
-               print STDERR ("=> die($@)\n") if $debug && $@ ne '';
-               if ( $@ =~ /^!/ ) {
-                   if ( $@ =~ /^!FINISH\b/ ) {
+               print STDERR ("=> die($eval_error)\n")
+                 if $debug && $eval_error ne '';
+               if ( $eval_error =~ /^!/ ) {
+                   if ( $eval_error =~ /^!FINISH\b/ ) {
                        $goon = 0;
                    }
                }
-               elsif ( $@ ne '' ) {
-                   warn ($@);
+               elsif ( $eval_error ne '' ) {
+                   warn ($eval_error);
                    $error++;
                }
            }