This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to branch master
in repository libgetopt-euclid-perl.

commit 1c397af505a62f4f107fc08dd858fd311c3493cd
Author: gregor herrmann <gre...@debian.org>
Date:   Tue May 6 19:18:24 2014 +0200

    Imported Upstream version 0.4.5
---
 Changes                |  4 +++
 MANIFEST               |  2 +-
 META.json              | 56 ---------------------------------------
 META.yml               | 22 ++++++++++------
 README                 |  2 +-
 lib/Getopt/Euclid.pm   | 71 +++++++++++++++++++++-----------------------------
 t/fail_missing_var_2.t | 36 +++++++++++++++++++++++++
 7 files changed, 85 insertions(+), 108 deletions(-)

diff --git a/Changes b/Changes
index 0ec0480..d73fa14 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Getopt-Euclid
 
+0.4.5  2014-03-21
+  - Fixed bug when parsing arguments with missing variable (reported by 
Torbjørn
+    Lindahl)
+
 0.4.4  2013-08-21
   - Fixed bug with Bleadperl v5.19.2-257-gc30fc27 (bug #87804, reported by
     Andreas Koenig, patch by Dave Mitchell)
diff --git a/MANIFEST b/MANIFEST
index ce86882..9aa4568 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,7 +11,6 @@ inc/Module/Install/WriteAll.pm
 lib/Getopt/Euclid.pm
 Makefile.PL
 MANIFEST                       This list of files
-META.json
 META.yml
 README
 t/00.load.t
@@ -38,6 +37,7 @@ t/fail_minimal_clash.t
 t/fail_misplaced_type.t
 t/fail_missing_required.t
 t/fail_missing_var.t
+t/fail_missing_var_2.t
 t/fail_no_spec.t
 t/fail_quoted_args.t
 t/fail_type.t
diff --git a/META.json b/META.json
deleted file mode 100644
index 01397a1..0000000
--- a/META.json
+++ /dev/null
@@ -1,56 +0,0 @@
-{
-   "abstract" : "Executable Uniform Command-Line Interface Descriptions",
-   "author" : [
-      "Damian Conway <dcon...@cpan.org>"
-   ],
-   "dynamic_config" : 1,
-   "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter 
version 2.120921",
-   "license" : [
-      "perl_5"
-   ],
-   "meta-spec" : {
-      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
-      "version" : "2"
-   },
-   "name" : "Getopt-Euclid",
-   "prereqs" : {
-      "build" : {
-         "requires" : {
-            "Pod::Checker" : "0",
-            "Test::More" : "0"
-         }
-      },
-      "configure" : {
-         "requires" : {
-            "Module::Build" : "0.40"
-         }
-      },
-      "runtime" : {
-         "recommends" : {
-            "IO::Pager::Page" : "0"
-         },
-         "requires" : {
-            "File::Basename" : "0",
-            "File::Spec::Functions" : "0",
-            "List::Util" : "0",
-            "Pod::PlainText" : "0",
-            "Pod::Select" : "0",
-            "Text::Balanced" : "0",
-            "version" : "0"
-         }
-      }
-   },
-   "provides" : {
-      "Getopt::Euclid" : {
-         "file" : "lib/Getopt/Euclid.pm",
-         "version" : "v0.4.3"
-      }
-   },
-   "release_status" : "stable",
-   "resources" : {
-      "license" : [
-         "http://dev.perl.org/licenses/";
-      ]
-   },
-   "version" : "v0.4.3"
-}
diff --git a/META.yml b/META.yml
index 3e0eee4..ae83361 100644
--- a/META.yml
+++ b/META.yml
@@ -1,23 +1,25 @@
 ---
 abstract: 'Executable Uniform Command-Line Interface Descriptions'
 author:
-  - 'Damian Conway <dcon...@cpan.org>'
+  - 'Damian Conway (dcon...@cpan.org)'
 build_requires:
+  ExtUtils::MakeMaker: 6.36
   Pod::Checker: 0
   Test::More: 0
 configure_requires:
-  Module::Build: 0.40
+  ExtUtils::MakeMaker: 6.36
+distribution_type: module
 dynamic_config: 1
-generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 
2.120921'
+generated_by: 'Module::Install version 1.06'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
   version: 1.4
 name: Getopt-Euclid
-provides:
-  Getopt::Euclid:
-    file: lib/Getopt/Euclid.pm
-    version: v0.4.3
+no_index:
+  directory:
+    - inc
+    - t
 recommends:
   IO::Pager::Page: 0
 requires:
@@ -27,7 +29,11 @@ requires:
   Pod::PlainText: 0
   Pod::Select: 0
   Text::Balanced: 0
+  perl: 5.005
   version: 0
 resources:
+  bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Euclid
+  homepage: http://search.cpan.org/search?query=Getopt%3A%3AEuclid&mode=dist
   license: http://dev.perl.org/licenses/
-version: v0.4.3
+  repository: 
git://getopt-euclid.git.sourceforge.net/gitroot/getopt-euclid/getopt-euclid
+version: 0.004005
diff --git a/README b/README
index 9181358..f5ec534 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions
 
 VERSION
-    This document describes Getopt::Euclid version 0.4.4
+    This document describes Getopt::Euclid version 0.4.5
 
 SYNOPSIS
         use Getopt::Euclid;
diff --git a/lib/Getopt/Euclid.pm b/lib/Getopt/Euclid.pm
index 384cba8..d72ec08 100644
--- a/lib/Getopt/Euclid.pm
+++ b/lib/Getopt/Euclid.pm
@@ -1,6 +1,6 @@
 package Getopt::Euclid;
 
-use version; our $VERSION = version->declare('0.4.4');
+use version; our $VERSION = version->declare('0.4.5');
 
 use warnings;
 use strict;
@@ -121,6 +121,11 @@ sub import {
     $has_run = 1;
 
     # Parse POD + parse and export arguments
+
+    ######
+    #use Data::Dumper; print "ARGV: ".Dumper(\@ARGV);
+    ######
+
     __PACKAGE__->process_args( \@ARGV ) unless $defer;
 
     return 1;
@@ -204,20 +209,16 @@ sub process_args {
     if ( first { $_ eq '--man' } @$args ) {
         _print_pod( __PACKAGE__->man(), 'paged' );
         exit;
-    }
-    elsif ( first { $_ eq '--usage' } @$args ) {
+    } elsif ( first { $_ eq '--usage' } @$args ) {
         print __PACKAGE__->usage();
         exit;
-    }
-    elsif ( first { $_ eq '--help' } @$args ) {
+    } elsif ( first { $_ eq '--help' } @$args ) {
         _print_pod( __PACKAGE__->help(), 'paged' );
         exit;
-    }
-    elsif ( first { $_ eq '--version' } @$args ) {
+    } elsif ( first { $_ eq '--version' } @$args ) {
         print __PACKAGE__->version();
         exit;
-    }
-    elsif ( first { $_ eq '--podfile' } @$args ) {
+    } elsif ( first { $_ eq '--podfile' } @$args ) {
         # Option meant for authors
         my $podfile = podfile( );
         print "Wrote POD manual in file $podfile\n";
@@ -291,8 +292,7 @@ sub process_args {
 
                 if ($repeatable) {
                     push @{ $ARGV{$arg_flag} }, $variant_val;
-                }
-                else {
+                } else {
                     $ARGV{$arg_flag} = $variant_val;
                 }
                 $vars_opt_vals{$arg_flag} = $ARGV{$arg_flag} if $vars_prefix;
@@ -525,9 +525,7 @@ sub _parse_pod {
     $matcher = join '|', map { $_->{matcher} }
       sort( { $b->{name} cmp $a->{name} } grep { $_->{name} =~ /^[^<]/ } 
@arg_list ),
       sort( { $a->{seq}  <=> $b->{seq}  } grep { $_->{name} =~ /^[<]/  } 
@arg_list );
-
     $matcher .= '|(?> (.+)) (?{ push @errors, $^N }) (?!)';
-
     $matcher = '(?:' . $matcher . ')';
 
     return 1;
@@ -601,8 +599,7 @@ sub _process_euclid_specs {
             # Decode...
             if ( $field eq 'type.error' ) {
                 $arg->{var}{$var}{type_error} = $val;
-            }
-            elsif ( $field eq 'type' ) {
+            } elsif ( $field eq 'type' ) {
                 $val = _qualify_variables_fully( $val );
                 my ( $matchtype, $comma, $constraint ) =
                   $val =~ m{(/(?:\.|.)+/ | [^,\s]+)\s*(?:(,))?\s*(.*)}xms;
@@ -613,14 +610,12 @@ sub _process_euclid_specs {
                     $constraint =~ s/\b\Q$var\E\b/\$_[0]/g;
                     $arg->{var}{$var}{constraint} = eval "sub{ $constraint }"
                       or _fail("Invalid .type constraint: $spec\n($@)");
-                }
-                elsif ( length $constraint ) {
+                } elsif ( length $constraint ) {
                     $arg->{var}{$var}{constraint_desc} = $constraint;
                     $arg->{var}{$var}{constraint} = 
                       eval "sub{ \$_[0] $constraint }"
                       or _fail("Invalid .type constraint: $spec\n($@)");
-                }
-                else {
+                } else {
                     $arg->{var}{$var}{constraint_desc} = $matchtype;
                     $arg->{var}{$var}{constraint} =
                       $matchtype =~ m{\A\s*/.*/\s*\z}xms
@@ -629,8 +624,7 @@ sub _process_euclid_specs {
                       or _fail("Unknown .type constraint: $spec");
                 }
 
-            }
-            elsif ( ($field eq 'default') || ($field eq 'opt_default') ) {
+            } elsif ( ($field eq 'default') || ($field eq 'opt_default') ) {
                 $val = _qualify_variables_fully( $val );
                 eval "\$val = $val; 1"
                   or _fail("Invalid .$field value: $spec\n($@)");
@@ -654,11 +648,9 @@ sub _process_euclid_specs {
                     }
                 }
 
-            }
-            elsif ( $field eq 'excludes.error' ) {
+            } elsif ( $field eq 'excludes.error' ) {
                 $arg->{var}{$var}{excludes_error} = $val;
-            }
-            elsif ( $field eq 'excludes' ) {
+            } elsif ( $field eq 'excludes' ) {
                 $arg->{var}{$var}{excludes} = [ split '\s*,\s*', $val ];
                 for my $excl_var (@{$arg->{var}{$var}{excludes}}) {
                     if ($var eq $excl_var) {
@@ -666,8 +658,7 @@ sub _process_euclid_specs {
                             "<$excl_var> cannot exclude itself." );
                     }
                 }
-            }
-            else {
+            } else {
                 _fail("Unknown specification: $spec");
             }
         }
@@ -848,17 +839,14 @@ sub _rectify_all_args {
                 for my $var ( values %{$arg} ) {
                     if ( ref $var eq 'ARRAY' ) {
                         $var = [ map { _rectify_arg($_) } @{$var} ];
-                    }
-                    else {
+                    } else {
                         $var = _rectify_arg($var);
                     }
                 }
-            }
-            else {
+            } else {
                 if ( ref $arg eq 'ARRAY' ) {
                     $arg = [ map { _rectify_arg($_) } @{$arg} ];
-                }
-                else {
+                } else {
                     $arg = _rectify_arg($arg);
                 }
             }
@@ -928,8 +916,8 @@ sub _verify_args {
                 # Check constraints on vars...
                 if ( exists $ARGV{$arg_name} ) {
 
-                    # Named vars...
                     if ( ref $entry eq 'HASH' && defined $entry->{$var} ) {
+                        # Named vars...
                         for my $val (
                             ref $entry->{$var} eq 'ARRAY'
                             ? @{ $entry->{$var} }
@@ -944,10 +932,8 @@ sub _verify_args {
                             }
                         }
                         next VAR;
-                    }
-
-                    # Unnamed vars...
-                    elsif ( ref $entry ne 'HASH' && defined $entry ) {
+                    } elsif ( ref $entry ne 'HASH' && defined $entry ) {
+                        # Unnamed vars...
                         for my $val (
                             ref $entry eq 'ARRAY'
                             ? @{$entry}
@@ -1026,6 +1012,7 @@ sub _convert_to_regex {
     while ( my ($arg_name, $arg_specs) = each %{$args_ref} ) {
         push @arg_variants, @{$arg_specs->{variants}};
     }
+
     my $no_match = join('|',@arg_variants);
     $no_match = _escape_specials($no_match);
     $no_match = '(?!(?:'.$no_match.')'.$no_esc_ws.')';
@@ -1056,7 +1043,8 @@ sub _convert_to_regex {
                    or _fail("Unknown type ($type) in specification: 
$arg_name");
                $var_rep ?
                  "(?:[\\s\\0\\1]*$no_match($matcher)(?{push 
\@{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}}}, \$^N}))+"
-                 : 
"(?:($matcher)(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}} = \$^N}))";
+                 :
+                 
"(?:$no_match($matcher)(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}} = 
\$^N}))";
              }gexms
              or do {
                  $regex .= "(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{}} = 1})";
@@ -1064,8 +1052,7 @@ sub _convert_to_regex {
 
         if ( $arg->{is_repeatable} ) {
             $arg->{matcher} = "$regex (?:(?<!\\w)|(?!\\w)) (?{push 
\@{\$ARGV{q{$arg_name}}}, {} })";
-        }
-        else {
+        } else {
             $arg->{matcher} = "(??{exists\$ARGV{q{$arg_name}}?'(?!)':''}) "
               . (
                 $arg->{false_vals}
@@ -1300,7 +1287,7 @@ Getopt::Euclid - Executable Uniform Command-Line 
Interface Descriptions
 
 =head1 VERSION
 
-This document describes Getopt::Euclid version 0.4.4
+This document describes Getopt::Euclid version 0.4.5
 
 =head1 SYNOPSIS
 
diff --git a/t/fail_missing_var_2.t b/t/fail_missing_var_2.t
new file mode 100644
index 0000000..70e9e1a
--- /dev/null
+++ b/t/fail_missing_var_2.t
@@ -0,0 +1,36 @@
+use Test::More 'no_plan';
+
+BEGIN {
+    require 5.006_001 or plan 'skip_all';
+    close *STDERR;
+    open *STDERR, '>', \my $stderr;
+    *CORE::GLOBAL::exit = sub { die $stderr };
+}
+
+BEGIN {
+    @ARGV = (
+        "--foo",
+        "--bar",
+    );
+}
+
+if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) {
+    ok 0 => 'Unexpectedly succeeded';
+}
+else {
+    like $@, qr/Unknown argument: --foo --bar/ => 'Failed as expected'; 
+}
+
+__END__
+
+=head1 OPTIONS
+
+=over
+
+=item --foo <foo>
+
+=item --bar <bar>
+
+=back
+
+=cut

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libgetopt-euclid-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to