Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Subroutine BEGIN redefined - but no BEGIN at all #13926

Closed
p5pRT opened this issue Jun 16, 2014 · 12 comments
Closed

Subroutine BEGIN redefined - but no BEGIN at all #13926

p5pRT opened this issue Jun 16, 2014 · 12 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Jun 16, 2014

Migrated from rt.perl.org#122107 (status was 'resolved')

Searchable as RT122107$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

From Harald.Joerg@arcor.de

This is a bug report for perl from Harald.Joerg@​arcor.de,
generated with the help of perlbug 1.39 running under perl 5.18.2.

It happened in a real-world application after upgrade to Perl 5.18.2,
induced by an upgrade to Ubuntu 14.04​: Perfectly valid Perl modules
suddenly failed to compile. It is easy to fix in the application, but
it took way too long to understand what's going on, hence the bug
report.

Apparently there's a remote side effect when a module fails to
compile, but only under specific conditions which unfortunately
collide in the application. See test script below.

The error message "Subroutine BEGIN redefined" is just too misleading
when there's no BEGIN to be seen in the code. And it "worked" under
Perk V5.10.1.

Test script (works with perl -x)​:

######################################################################
#!/usr/bin/perl -w
use strict;
use v5.10;

say "* This is Perl version $^V";
say '* Loading a module with bad syntax under eval gives an error​:';
eval 'use File​::{Spec}';
print $@​;

$SIG{'__WARN__'} = sub { die @​_ }; # The application is pretty strict
say '* Now we load a perfectly good module under eval​:';
eval 'use File​::Spec';
print $@​;
__END__
######################################################################

Output under Perl V5.18.2​:
######################################################################
* This is Perl version v5.18.2
* Loading a module with bad syntax under eval gives an error​:
Bareword "Spec" not allowed while "strict subs" in use at (eval 1) line 1.
* Now we load a perfectly good module under eval​:
Subroutine BEGIN redefined at (eval 2) line 2.
######################################################################

Output under Perl V5.10.1​:
######################################################################
* This is Perl version v5.10.1
* Loading a module with bad syntax under eval gives an error​:
syntax error at (eval 1) line 1, near "use File​::{"
* Now we load a perfectly good module under eval​:
######################################################################

Some details​:

The application falls over this when loading a list of "plugin"
modules. It does this under eval so that the application doesn't die,
and promotes warnings to errors so that warnings can be captured under
$@​. However, under Perl V5.18.2, an error in one of the plugin
declarations causes all subsequent plugins to be rejected as "having
compilation issues". The list of plugins come as a hash, so
"subsequent" depends on the order of hash keys, looking somewhat
"random".

The compilation issue is "only" a warning, so without promoting
warnings to fatal errors everything with exception of STDERR would
look fine.

The problem vanishes if either of the 'use' statements is replaced by
a 'require'.

The problem vanishes for many other "syntax errors" in the first eval
statement which do not emit "Bareword ... is not allowed". Maybe this
is why Perl 5.10 didn't show the same behaviour​: It rejects the first
eval with a different error message.

Here's perlbug -d output, to be summarized as "vanilla Perl as it
comes with Ubuntu 14.04 LTS".


Flags​:
  category=core
  severity=low


Site configuration information for perl 5.18.2​:

Configured by Debian Project at Thu Mar 27 18​:28​:21 UTC 2014.

Summary of my perl5 (revision 5 version 18 subversion 2) configuration​:
 
  Platform​:
  osname=linux, osvers=3.2.0-58-generic, archname=x86_64-linux-gnu-thread-multi
  uname='linux brownie 3.2.0-58-generic #88-ubuntu smp tue dec 3 17​:37​:58 utc 2013 x86_64 x86_64 x86_64 gnulinux '
  config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -D_FORTIFY_SOURCE=2 -g -O2 -fstack-protector --param=ssp-buffer-size=4 -Wformat -Werror=format-security -Dldflags= -Wl,-Bsymbolic-functions -Wl,-z,relro -Dlddlflags=-shared -Wl,-Bsymbolic-functions -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.18 -Darchlib=/usr/lib/perl/5.18 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.18.2 -Dsitearch=/usr/local/lib/perl/5.18.2 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.18.2 -des'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fstack-protector -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2 -g',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fstack-protector -fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='4.8.2', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib
  libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
  perllibs=-ldl -lm -lpthread -lc -lcrypt
  libc=, so=so, useshrplib=true, libperl=libperl.so.5.18.2
  gnulibc_version='2.19'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib -fstack-protector'

Locally applied patches​:
  DEBPKG​:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
  DEBPKG​:debian/db_file_ver - http​://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
  DEBPKG​:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
  DEBPKG​:debian/enc2xs_inc - http​://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @​INC directories.
  DEBPKG​:debian/errno_ver - http​://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
  DEBPKG​:debian/libperl_embed_doc - http​://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking
  DEBPKG​:fixes/respect_umask - Respect umask during installation
  DEBPKG​:debian/writable_site_dirs - Set umask approproately for site install directories
  DEBPKG​:debian/extutils_set_libperl_path - EU​:MM​: Set location of libperl.a to /usr/lib
  DEBPKG​:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
  DEBPKG​:debian/prefix_changes - Fiddle with *PREFIX and variables written to the makefile
  DEBPKG​:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
  DEBPKG​:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
  DEBPKG​:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
  DEBPKG​:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
  DEBPKG​:debian/mod_paths - Tweak @​INC ordering for Debian
  DEBPKG​:debian/module_build_man_extensions - http​://bugs.debian.org/479460 Adjust Module​::Build manual page extensions for the Debian Perl policy
  DEBPKG​:debian/prune_libs - http​://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
  DEBPKG​:fixes/net_smtp_docs - [rt.cpan.org #36038] http​://bugs.debian.org/100195 Document the Net​::SMTP 'Port' option
  DEBPKG​:debian/perlivp - http​://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
  DEBPKG​:debian/cpanplus_definstalldirs - http​://bugs.debian.org/533707 Configure CPANPLUS to use the site directories by default.
  DEBPKG​:debian/cpanplus_config_path - Save local versions of CPANPLUS​::Config​::System into /etc/perl.
  DEBPKG​:debian/deprecate-with-apt - http​://bugs.debian.org/702096 Point users to Debian packages of deprecated core modules
  DEBPKG​:debian/squelch-locale-warnings - http​://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
  DEBPKG​:debian/skip-upstream-git-tests - Skip tests specific to the upstream Git repository
  DEBPKG​:debian/patchlevel - http​://bugs.debian.org/567489 List packaged patches for 5.18.2-2ubuntu1 in patchlevel.h
  DEBPKG​:debian/skip-kfreebsd-crash - http​://bugs.debian.org/628493 [perl #96272] Skip a crashing test case in t/op/threads.t on GNU/kFreeBSD
  DEBPKG​:fixes/document_makemaker_ccflags - http​://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
  DEBPKG​:debian/find_html2text - http​://bugs.debian.org/640479 Configure CPAN​::Distribution with correct name of html2text
  DEBPKG​:debian/hurd_test_skip_stack - http​://bugs.debian.org/650175 Disable failing GNU/Hurd tests dist/threads/t/stack.t
  DEBPKG​:fixes/manpage_name_Test-Harness - http​://bugs.debian.org/650451 [rt.cpan.org #73399] cpan/Test-Harness​: add NAME headings in modules with POD
  DEBPKG​:debian/makemaker-pasthru - http​://bugs.debian.org/660195 [rt.cpan.org #28632] Make EU​::MM pass LD through to recursive Makefile.PL invocations
  DEBPKG​:debian/perl5db-x-terminal-emulator.patch - http​://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
  DEBPKG​:debian/cpan-missing-site-dirs - http​://bugs.debian.org/688842 Fix CPAN​::FirstTime defaults with nonexisting site dirs if a parent is writable
  DEBPKG​:fixes/memoize_storable_nstore - [rt.cpan.org #77790] http​://bugs.debian.org/587650 Memoize​::Storable​: respect 'nstore' option not respected
  DEBPKG​:fixes/net_ftp_failed_command - [rt.cpan.org #37700] http​://bugs.debian.org/491062 Net​::FTP​: cope gracefully with a failed command
  DEBPKG​:fixes/perlbug-patchlist - [3541c11] http​://bugs.debian.org/710842 [perl #118433] Make perlbug look up the list of local patches at run time
  DEBPKG​:fixes/module_metadata_security_doc - [68cdd4b] CVE-2013-1437 documentation fix
  DEBPKG​:fixes/module_metadata_taint_fix - [bff978f] http​://bugs.debian.org/722210 [rt.cpan.org #88576] untaint version, if needed, in Module​::Metadata
  DEBPKG​:fixes/IPC-SysV-spelling - http​://bugs.debian.org/730558 [rt.cpan.org #86736] Fix spelling of IPC_CREAT in IPC-SysV documentation
  DEBPKG​:fixes/fix-undef-source -


@​INC for perl 5.18.2​:
  /etc/perl
  /usr/local/lib/perl/5.18.2
  /usr/local/share/perl/5.18.2
  /usr/lib/perl5
  /usr/share/perl5
  /usr/lib/perl/5.18
  /usr/share/perl/5.18
  /usr/local/lib/site_perl
  .


Environment for perl 5.18.2​:
  HOME=/home/haj
  LANG=en_US.UTF-8
  LANGUAGE=en_US
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/home/haj/bin​:/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/usr/bin​:/sbin​:/bin​:/usr/games​:/usr/local/games
  PERL_BADLANG (unset)
  SHELL=/bin/bash


Flags​:
  category=core
  severity=low


Site configuration information for perl 5.18.2​:

Configured by Debian Project at Thu Mar 27 18​:28​:21 UTC 2014.

Summary of my perl5 (revision 5 version 18 subversion 2) configuration​:
 
  Platform​:
  osname=linux, osvers=3.2.0-58-generic, archname=x86_64-linux-gnu-thread-multi
  uname='linux brownie 3.2.0-58-generic #88-ubuntu smp tue dec 3 17​:37​:58 utc 2013 x86_64 x86_64 x86_64 gnulinux '
  config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -D_FORTIFY_SOURCE=2 -g -O2 -fstack-protector --param=ssp-buffer-size=4 -Wformat -Werror=format-security -Dldflags= -Wl,-Bsymbolic-functions -Wl,-z,relro -Dlddlflags=-shared -Wl,-Bsymbolic-functions -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.18 -Darchlib=/usr/lib/perl/5.18 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.18.2 -Dsitearch=/usr/local/lib/perl/5.18.2 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.18.2 -des'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fstack-protector -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2 -g',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fstack-protector -fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='4.8.2', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib
  libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
  perllibs=-ldl -lm -lpthread -lc -lcrypt
  libc=, so=so, useshrplib=true, libperl=libperl.so.5.18.2
  gnulibc_version='2.19'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib -fstack-protector'

Locally applied patches​:
  DEBPKG​:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
  DEBPKG​:debian/db_file_ver - http​://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
  DEBPKG​:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
  DEBPKG​:debian/enc2xs_inc - http​://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @​INC directories.
  DEBPKG​:debian/errno_ver - http​://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
  DEBPKG​:debian/libperl_embed_doc - http​://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking
  DEBPKG​:fixes/respect_umask - Respect umask during installation
  DEBPKG​:debian/writable_site_dirs - Set umask approproately for site install directories
  DEBPKG​:debian/extutils_set_libperl_path - EU​:MM​: Set location of libperl.a to /usr/lib
  DEBPKG​:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
  DEBPKG​:debian/prefix_changes - Fiddle with *PREFIX and variables written to the makefile
  DEBPKG​:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
  DEBPKG​:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
  DEBPKG​:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
  DEBPKG​:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
  DEBPKG​:debian/mod_paths - Tweak @​INC ordering for Debian
  DEBPKG​:debian/module_build_man_extensions - http​://bugs.debian.org/479460 Adjust Module​::Build manual page extensions for the Debian Perl policy
  DEBPKG​:debian/prune_libs - http​://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
  DEBPKG​:fixes/net_smtp_docs - [rt.cpan.org #36038] http​://bugs.debian.org/100195 Document the Net​::SMTP 'Port' option
  DEBPKG​:debian/perlivp - http​://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
  DEBPKG​:debian/cpanplus_definstalldirs - http​://bugs.debian.org/533707 Configure CPANPLUS to use the site directories by default.
  DEBPKG​:debian/cpanplus_config_path - Save local versions of CPANPLUS​::Config​::System into /etc/perl.
  DEBPKG​:debian/deprecate-with-apt - http​://bugs.debian.org/702096 Point users to Debian packages of deprecated core modules
  DEBPKG​:debian/squelch-locale-warnings - http​://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
  DEBPKG​:debian/skip-upstream-git-tests - Skip tests specific to the upstream Git repository
  DEBPKG​:debian/patchlevel - http​://bugs.debian.org/567489 List packaged patches for 5.18.2-2ubuntu1 in patchlevel.h
  DEBPKG​:debian/skip-kfreebsd-crash - http​://bugs.debian.org/628493 [perl #96272] Skip a crashing test case in t/op/threads.t on GNU/kFreeBSD
  DEBPKG​:fixes/document_makemaker_ccflags - http​://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
  DEBPKG​:debian/find_html2text - http​://bugs.debian.org/640479 Configure CPAN​::Distribution with correct name of html2text
  DEBPKG​:debian/hurd_test_skip_stack - http​://bugs.debian.org/650175 Disable failing GNU/Hurd tests dist/threads/t/stack.t
  DEBPKG​:fixes/manpage_name_Test-Harness - http​://bugs.debian.org/650451 [rt.cpan.org #73399] cpan/Test-Harness​: add NAME headings in modules with POD
  DEBPKG​:debian/makemaker-pasthru - http​://bugs.debian.org/660195 [rt.cpan.org #28632] Make EU​::MM pass LD through to recursive Makefile.PL invocations
  DEBPKG​:debian/perl5db-x-terminal-emulator.patch - http​://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
  DEBPKG​:debian/cpan-missing-site-dirs - http​://bugs.debian.org/688842 Fix CPAN​::FirstTime defaults with nonexisting site dirs if a parent is writable
  DEBPKG​:fixes/memoize_storable_nstore - [rt.cpan.org #77790] http​://bugs.debian.org/587650 Memoize​::Storable​: respect 'nstore' option not respected
  DEBPKG​:fixes/net_ftp_failed_command - [rt.cpan.org #37700] http​://bugs.debian.org/491062 Net​::FTP​: cope gracefully with a failed command
  DEBPKG​:fixes/perlbug-patchlist - [3541c11] http​://bugs.debian.org/710842 [perl #118433] Make perlbug look up the list of local patches at run time
  DEBPKG​:fixes/module_metadata_security_doc - [68cdd4b] CVE-2013-1437 documentation fix
  DEBPKG​:fixes/module_metadata_taint_fix - [bff978f] http​://bugs.debian.org/722210 [rt.cpan.org #88576] untaint version, if needed, in Module​::Metadata
  DEBPKG​:fixes/IPC-SysV-spelling - http​://bugs.debian.org/730558 [rt.cpan.org #86736] Fix spelling of IPC_CREAT in IPC-SysV documentation
  DEBPKG​:fixes/fix-undef-source -


@​INC for perl 5.18.2​:
  /etc/perl
  /usr/local/lib/perl/5.18.2
  /usr/local/share/perl/5.18.2
  /usr/lib/perl5
  /usr/share/perl5
  /usr/lib/perl/5.18
  /usr/share/perl/5.18
  /usr/local/lib/site_perl
  .


Environment for perl 5.18.2​:
  HOME=/home/haj
  LANG=en_US.UTF-8
  LANGUAGE=en_US
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/home/haj/bin​:/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/usr/bin​:/sbin​:/bin​:/usr/games​:/usr/local/games
  PERL_BADLANG (unset)
  SHELL=/bin/bash

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

From @iabyn

On Sun, Jun 15, 2014 at 07​:10​:12PM -0700, Harald Joerg wrote​:

Output under Perl V5.18.2​:
...
Bareword "Spec" not allowed while "strict subs" in use at (eval 1) line 1.
* Now we load a perfectly good module under eval​:
Subroutine BEGIN redefined at (eval 2) line 2.

Output under Perl V5.10.1​:
...
syntax error at (eval 1) line 1, near "use File​::{"
* Now we load a perfectly good module under eval​:

A bisect shows that the spurious warning appeared with the commit shown
below, although I suspect that just it changed the behaviour of the error
handling in the 'bad' eval, that triggered a pre-existing bug.

The following shows the behaviour of perl pre- and-post- that commit​:

  $ p -e'use strict; use File​::{Spec}'
  syntax error at -e line 1, near "use File​::{"

  $ p -e'use strict; use File​::{Spec}'
  Bareword "Spec" not allowed while "strict subs" in use at -e line 1.

commit 52d0e95
Author​: Father Chrysostomos <sprout@​cpan.org>
AuthorDate​: Fri Aug 3 18​:35​:26 2012 -0700
Commit​: Father Chrysostomos <sprout@​cpan.org>
CommitDate​: Fri Aug 3 19​:40​:30 2012 -0700

  [perl #114222] Make ‘use’ parse arguments in term context
 
  (lexing context, that is)
 
  use constant { () }
 
  was a syntax error, because the lexer was guessing when { should be
  a statement or hash.
 
  It should not be doing that where a term is expected.
 
  It was actually getting itself confused, and trying to parse the
  argument list as a statement.
 
  Setting PL_expect after force_next is ineffectual, as force_next
  records the current value of PL_expect, arranging to have it
  restored.
 
  OPERATOR(USE) was setting PL_expect, but too late. So no we set
  PL_expect explicitly in S_tokenize_use, before any forced tokens,
  and use TOKEN(USE), which does not set PL_expect (as setting it
  there has no effect).

--
It's not that I'm afraid to die, I just don't want to be there when it
happens.
  -- Woody Allen

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 10, 2014

From @tonycoz

On Mon Jun 16 04​:31​:19 2014, davem wrote​:

On Sun, Jun 15, 2014 at 07​:10​:12PM -0700, Harald Joerg wrote​:

Output under Perl V5.18.2​:
...
Bareword "Spec" not allowed while "strict subs" in use at (eval 1) line 1.
* Now we load a perfectly good module under eval​:
Subroutine BEGIN redefined at (eval 2) line 2.

A bisect shows that the spurious warning appeared with the commit shown
below, although I suspect that just it changed the behaviour of the error
handling in the 'bad' eval, that triggered a pre-existing bug.

The attached patches test for and I think fix the bug.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 10, 2014

From @tonycoz

0001-perl-122107-test-that-BEGIN-blocks-with-errors-don-t.patch
From b31436aff4c9260e08d1858f662d2ed752977c42 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 10 Jul 2014 11:37:39 +1000
Subject: [perl #122107] test that BEGIN blocks with errors don't remain named
 subs

---
 t/op/sub.t |   11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/t/op/sub.t b/t/op/sub.t
index 7df8f49..0e4ffda 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 33 );
+plan( tests => 34 );
 
 sub empty_sub {}
 
@@ -222,3 +222,12 @@ ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
     is $str[1], $str[0],
       'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
 }
+
+{ local $TODO = "fixed in next commit";
+# [perl #122107] previously this would return
+#  Subroutine BEGIN redefined at (eval 2) line 2.
+fresh_perl_is(<<'EOS', "", { stderr => 1 },
+use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
+EOS
+	       "check special blocks are cleared on error");
+}
-- 
1.7.10.4

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 10, 2014

From @tonycoz

0002-perl-122107-ensure-that-BEGIN-blocks-with-errors-don.patch
From 85b807102b92d533e72ddef04cdc3278ef093564 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 10 Jul 2014 11:48:07 +1000
Subject: [perl #122107] ensure that BEGIN blocks with errors don't remain
 named subs

---
 embed.fnc  |    2 ++
 embed.h    |    1 +
 op.c       |   27 ++++++++++++++++++++++++---
 proto.h    |    7 +++++++
 t/op/sub.t |    2 --
 5 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index b3e24d6..2027938 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1930,6 +1930,8 @@ s	|OP*	|ref_array_or_hash|NULLOK OP* cond
 s	|void	|process_special_blocks	|I32 floor \
 					|NN const char *const fullname\
 					|NN GV *const gv|NN CV *const cv
+s	|void	|clear_special_blocks	|NN const char *const fullname\
+					|NN GV *const gv|NN CV *const cv
 #endif
 Xpa	|void*	|Slab_Alloc	|size_t sz
 Xp	|void	|Slab_Free	|NN void *op
diff --git a/embed.h b/embed.h
index 37c5b20..5195802 100644
--- a/embed.h
+++ b/embed.h
@@ -1482,6 +1482,7 @@
 #define apply_attrs_my(a,b,c,d)	S_apply_attrs_my(aTHX_ a,b,c,d)
 #define bad_type_gv(a,b,c,d,e)	S_bad_type_gv(aTHX_ a,b,c,d,e)
 #define bad_type_pv(a,b,c,d,e)	S_bad_type_pv(aTHX_ a,b,c,d,e)
+#define clear_special_blocks(a,b,c)	S_clear_special_blocks(aTHX_ a,b,c)
 #define cop_free(a)		S_cop_free(aTHX_ a)
 #define dup_attrlist(a)		S_dup_attrlist(aTHX_ a)
 #define finalize_op(a)		S_finalize_op(aTHX_ a)
diff --git a/op.c b/op.c
index 1ee59a3..bacaf72 100644
--- a/op.c
+++ b/op.c
@@ -7335,7 +7335,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
 	has_name = FALSE;
     }
-
     if (!ec)
         move_proto_attr(&proto, &attrs, gv);
 
@@ -7595,8 +7594,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	    }
 	}
 
-	if (name && ! (PL_parser && PL_parser->error_count))
-	    process_special_blocks(floor, name, gv, cv);
+        if (name) {
+            if (PL_parser && PL_parser->error_count)
+                clear_special_blocks(name, gv, cv);
+            else
+                process_special_blocks(floor, name, gv, cv);
+        }
     }
 
   done:
@@ -7611,6 +7614,24 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 }
 
 STATIC void
+S_clear_special_blocks(pTHX_ const char *const fullname,
+                       GV *const gv, CV *const cv) {
+    const char *const colon = strrchr(fullname,':');
+    const char *const name = colon ? colon + 1 : fullname;
+
+    PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS;
+
+    if ((*name == 'B' && strEQ(name, "BEGIN"))
+        || (*name == 'E' && strEQ(name, "END"))
+        || (*name == 'U' && strEQ(name, "UNITCHECK"))
+        || (*name == 'C' && strEQ(name, "CHECK"))
+        || (*name == 'I' && strEQ(name, "INIT"))) {
+        GvCV_set(gv, NULL);
+        SvREFCNT_dec_NN(MUTABLE_SV(cv));
+    }
+}
+
+STATIC void
 S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
 			 GV *const gv,
 			 CV *const cv)
diff --git a/proto.h b/proto.h
index 46c41bc..fc8cda2 100644
--- a/proto.h
+++ b/proto.h
@@ -6098,6 +6098,13 @@ STATIC void	S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flag
 #define PERL_ARGS_ASSERT_BAD_TYPE_PV	\
 	assert(t); assert(name); assert(kid)
 
+STATIC void	S_clear_special_blocks(pTHX_ const char *const fullname, GV *const gv, CV *const cv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS	\
+	assert(fullname); assert(gv); assert(cv)
+
 STATIC void	S_cop_free(pTHX_ COP *cop)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_COP_FREE	\
diff --git a/t/op/sub.t b/t/op/sub.t
index 0e4ffda..1861623 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -223,11 +223,9 @@ ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
       'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
 }
 
-{ local $TODO = "fixed in next commit";
 # [perl #122107] previously this would return
 #  Subroutine BEGIN redefined at (eval 2) line 2.
 fresh_perl_is(<<'EOS', "", { stderr => 1 },
 use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
 EOS
 	       "check special blocks are cleared on error");
-}
-- 
1.7.10.4

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2014

From @tonycoz

On Wed Jul 09 19​:01​:13 2014, tonyc wrote​:

The attached patches test for and I think fix the bug.

Fix a problem in the fix patch (it used values before the assertion for those values.)

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 14, 2014

From @tonycoz

0002-perl-122107-ensure-that-BEGIN-blocks-with-errors-don.patch
From 9a337c06ccdaa8e5217ee60a66c3a6835a749075 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 14 Jul 2014 10:40:47 +1000
Subject: [perl #122107] ensure that BEGIN blocks with errors don't remain
 named subs

---
 embed.fnc  |    2 ++
 embed.h    |    1 +
 op.c       |   30 +++++++++++++++++++++++++++---
 proto.h    |    7 +++++++
 t/op/sub.t |    2 --
 5 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index b3e24d6..2027938 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1930,6 +1930,8 @@ s	|OP*	|ref_array_or_hash|NULLOK OP* cond
 s	|void	|process_special_blocks	|I32 floor \
 					|NN const char *const fullname\
 					|NN GV *const gv|NN CV *const cv
+s	|void	|clear_special_blocks	|NN const char *const fullname\
+					|NN GV *const gv|NN CV *const cv
 #endif
 Xpa	|void*	|Slab_Alloc	|size_t sz
 Xp	|void	|Slab_Free	|NN void *op
diff --git a/embed.h b/embed.h
index 37c5b20..5195802 100644
--- a/embed.h
+++ b/embed.h
@@ -1482,6 +1482,7 @@
 #define apply_attrs_my(a,b,c,d)	S_apply_attrs_my(aTHX_ a,b,c,d)
 #define bad_type_gv(a,b,c,d,e)	S_bad_type_gv(aTHX_ a,b,c,d,e)
 #define bad_type_pv(a,b,c,d,e)	S_bad_type_pv(aTHX_ a,b,c,d,e)
+#define clear_special_blocks(a,b,c)	S_clear_special_blocks(aTHX_ a,b,c)
 #define cop_free(a)		S_cop_free(aTHX_ a)
 #define dup_attrlist(a)		S_dup_attrlist(aTHX_ a)
 #define finalize_op(a)		S_finalize_op(aTHX_ a)
diff --git a/op.c b/op.c
index 1ee59a3..22dc50a 100644
--- a/op.c
+++ b/op.c
@@ -7335,7 +7335,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
 	has_name = FALSE;
     }
-
     if (!ec)
         move_proto_attr(&proto, &attrs, gv);
 
@@ -7595,8 +7594,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	    }
 	}
 
-	if (name && ! (PL_parser && PL_parser->error_count))
-	    process_special_blocks(floor, name, gv, cv);
+        if (name) {
+            if (PL_parser && PL_parser->error_count)
+                clear_special_blocks(name, gv, cv);
+            else
+                process_special_blocks(floor, name, gv, cv);
+        }
     }
 
   done:
@@ -7611,6 +7614,27 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 }
 
 STATIC void
+S_clear_special_blocks(pTHX_ const char *const fullname,
+                       GV *const gv, CV *const cv) {
+    const char *colon;
+    const char *name;
+
+    PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS;
+
+    colon = strrchr(fullname,':');
+    name = colon ? colon + 1 : fullname;
+
+    if ((*name == 'B' && strEQ(name, "BEGIN"))
+        || (*name == 'E' && strEQ(name, "END"))
+        || (*name == 'U' && strEQ(name, "UNITCHECK"))
+        || (*name == 'C' && strEQ(name, "CHECK"))
+        || (*name == 'I' && strEQ(name, "INIT"))) {
+        GvCV_set(gv, NULL);
+        SvREFCNT_dec_NN(MUTABLE_SV(cv));
+    }
+}
+
+STATIC void
 S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
 			 GV *const gv,
 			 CV *const cv)
diff --git a/proto.h b/proto.h
index 46c41bc..fc8cda2 100644
--- a/proto.h
+++ b/proto.h
@@ -6098,6 +6098,13 @@ STATIC void	S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flag
 #define PERL_ARGS_ASSERT_BAD_TYPE_PV	\
 	assert(t); assert(name); assert(kid)
 
+STATIC void	S_clear_special_blocks(pTHX_ const char *const fullname, GV *const gv, CV *const cv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS	\
+	assert(fullname); assert(gv); assert(cv)
+
 STATIC void	S_cop_free(pTHX_ COP *cop)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_COP_FREE	\
diff --git a/t/op/sub.t b/t/op/sub.t
index 0e4ffda..1861623 100644
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -223,11 +223,9 @@ ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
       'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
 }
 
-{ local $TODO = "fixed in next commit";
 # [perl #122107] previously this would return
 #  Subroutine BEGIN redefined at (eval 2) line 2.
 fresh_perl_is(<<'EOS', "", { stderr => 1 },
 use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
 EOS
 	       "check special blocks are cleared on error");
-}
-- 
1.7.10.4

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 10, 2014

From @cpansprout

On Mon Jun 16 04​:31​:19 2014, davem wrote​:

On Sun, Jun 15, 2014 at 07​:10​:12PM -0700, Harald Joerg wrote​:

Output under Perl V5.18.2​:
...
Bareword "Spec" not allowed while "strict subs" in use at (eval 1) line 1.
* Now we load a perfectly good module under eval​:
Subroutine BEGIN redefined at (eval 2) line 2.

Output under Perl V5.10.1​:
...
syntax error at (eval 1) line 1, near "use File​::{"
* Now we load a perfectly good module under eval​:

A bisect shows that the spurious warning appeared with the commit shown
below, although I suspect that just it changed the behaviour of the error
handling in the 'bad' eval, that triggered a pre-existing bug.

I actually came across this bug myself a while ago (due to a typo), but never got around to reporting it​:

$ perl5.10 -we 'use strict; BEGIN {foo} tr/\x{100}//'
Subroutine BEGIN redefined at -e line 1.
Bareword "foo" not allowed while "strict subs" in use at -e line 1.
BEGIN not safe after errors--compilation aborted at -e line 1.

A bisect points to​:

7678c48 is the first bad commit
commit 7678c48
Author​: Adrian M. Enache <enache@​rdslink.ro>
Date​: Tue Apr 8 10​:12​:13 2003 +0300

  Re​: Error​: Unknown error
  Message-ID​: <20030408041213.GA13553@​ratsnest.hole>
 
  p4raw-id​: //depot/perl@​19170

--

Father Chrysostomos

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 10, 2014

From @cpansprout

On Sun Jul 13 17​:44​:09 2014, tonyc wrote​:

On Wed Jul 09 19​:01​:13 2014, tonyc wrote​:

The attached patches test for and I think fix the bug.

Fix a problem in the fix patch (it used values before the assertion
for those values.)

Tony

Your patch looks good to me. Is there any reason you have not applied it yet?

--

Father Chrysostomos

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 10, 2014

From @tonycoz

On Sun Aug 10 12​:39​:50 2014, sprout wrote​:

On Sun Jul 13 17​:44​:09 2014, tonyc wrote​:

On Wed Jul 09 19​:01​:13 2014, tonyc wrote​:

The attached patches test for and I think fix the bug.

Fix a problem in the fix patch (it used values before the assertion
for those values.)

Tony

Your patch looks good to me. Is there any reason you have not applied
it yet?

Mostly, I forgot.

Applied as 2806bfd and 3969ff3.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 10, 2014

@tonycoz - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this Aug 10, 2014
@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.