From 34e5071063d4d70a293fec81bbcb480cad9f13f3 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Wed, 30 Apr 2014 18:44:41 +0100 Subject: [PATCH] mkaptsrc: Perl's scoping for named subroutines is bobbins. Nested named subroutines don't capture their lexical environment properly on subsequent calls to the enclosing subroutine. This is obviously a bug. --- mkaptsrc | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/mkaptsrc b/mkaptsrc index b8da270..4d32d95 100755 --- a/mkaptsrc +++ b/mkaptsrc @@ -164,14 +164,14 @@ sub parse ($) { my $ln = 0; ## Report a syntax error, citing the offending file and line. - sub syntax { fail "$fn:$ln: $_[0]"; } + my $syntax = sub { fail "$fn:$ln: $_[0]" }; ## Report an error about an indented line with no stanza header. - sub nomode { syntax "missing stanza header" }; - my $mode = \&nomode; + my $nomode = sub { $syntax->("missing stanza header") }; + my $mode = $nomode; ## Parse an assignment LINE and store it in CSET. - sub assign { + my $assign = sub { my ($cset, $line) = @_; $line =~ m{ ^ \s* @@ -180,19 +180,19 @@ sub parse ($) { \s* = \s* (?P | \S | \S.*\S) \s* $ - }x or syntax "invalid assignment"; + }x or $syntax->("invalid assignment"); cset_store $cset, $+{TAG}, $+{IX} // "*", $+{VALUE}; - } + }; ## Parse a subscription LINE and store it in @SUB. - sub subscribe { + my $subscribe = sub { my ($line) = @_; my @w = shellwords $line; my @dist = (); while (my $w = shift @w) { last if $w eq ":"; push @dist, $w; } - @w and @dist or syntax "empty distribution or release list"; + @w and @dist or $syntax->("empty distribution or release list"); push @SUB, [\@dist, \@w]; - } + }; for (;;) { @@ -212,19 +212,19 @@ sub parse ($) { ## Split the header line into tokens and determine an action. my @w = shellwords $line; - $mode = \&nomode; + $mode = $nomode; if ($w[0] eq "distribution") { - @w == 2 or syntax "usage: distribution NAME"; + @w == 2 or $syntax->("usage: distribution NAME"); my $cset = $CSET{$w[1]} //= cset_new; - $mode = sub { assign $cset, @_ }; + $mode = sub { $assign->($cset, @_) }; } elsif ($w[0] eq "default") { - @w == 1 or syntax "usage: default"; - $mode = sub { assign \%DEFAULT, @_ }; + @w == 1 or $syntax->("usage: default"); + $mode = sub { $assign->(\%DEFAULT, @_) }; } elsif ($w[0] eq "subscribe") { - @w == 1 or syntax "usage: subscribe"; - $mode = \&subscribe; + @w == 1 or $syntax->("usage: subscribe"); + $mode = $subscribe; } else { - syntax "unknown toplevel directive `$w[0]'"; + $syntax->("unknown toplevel directive `$w[0]'"); } } -- 2.11.0