sub prototypes not tracking refalias \&foo = \&bar

[p5pRT]

Migrated from rt.perl.org#134072 (status was 'pending release')

Searchable as RT134072$

[p5pRT]

From @jimav

Created by @jimav

This is a bug report for perl from jim.avera@​gmail.com,
generated with the help of perlbug 1.40 running under perl 5.26.2.

-----------------------------------------------------------------
Not sure whether this is intended behavior, but just in case it's not...

The refalias
  \&foo = \&bar
is documented as "foo() now means bar()", but it doesn't entirely​:

In subsequently-compiled code, the compiler still wants calls
to foo() to match the old foo's prototype, not the prototype of bar.

#!/usr/bin/perl
use strict; use warnings; use v5.22.0;

use feature 'refaliasing';
no warnings 'experimental​::refaliasing';

sub foo($$$$) { }
sub bar($) { }

BEGIN{ \&foo = \&bar; }

foo(1); # Gets "Not enough arguments for main​::foo"

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.26.2:

Configured by Ubuntu at Mon Nov 19 15:05:42 UTC 2018.

Summary of my perl5 (revision 5 version 26 subversion 2) configuration:
   
  Platform:
    osname=linux
    osvers=4.9.0
    archname=x86_64-linux-gnu-thread-multi
    uname='linux localhost 4.9.0 #1 smp debian 4.9.0 x86_64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -fdebug-prefix-map=/build/perl-6mb423/perl-5.26.2=. -fstack-protector-strong -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.26 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.26 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.26 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.26.2 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.26.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 -Ui_xlocale -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.26.2'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='x86_64-linux-gnu-gcc'
    ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -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 -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion=''
    gccversion='8.2.0'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='x86_64-linux-gnu-gcc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=libc-2.28.so
    so=so
    useshrplib=true
    libperl=libperl.so.5.26
    gnulibc_version='2.28'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - https://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 - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories.
    DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
    DEBPKG:debian/libperl_embed_doc - https://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 under /usr/lib
    DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
    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/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
    DEBPKG:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules
    DEBPKG:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
    DEBPKG:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.26.2-7ubuntu0.1 in patchlevel.h
    DEBPKG:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
    DEBPKG:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN::Distribution with correct name of html2text
    DEBPKG:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
    DEBPKG:debian/cpan-missing-site-dirs - https://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] https://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option not respected
    DEBPKG:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories
    DEBPKG:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU::MakeMaker honour MANnEXT settings in generated manpage headers
    DEBPKG:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798
    DEBPKG:fixes/autodie-scope - https://bugs.debian.org/798096 Fix a scoping issue with "no autodie" and the "system" sub
    DEBPKG:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize
    DEBPKG:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd
    DEBPKG:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math::Trig: clarify definition of great_circle_midpoint
    DEBPKG:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math::Trig: add missing SEE ALSO
    DEBPKG:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math::Trig: document angle units
    DEBPKG:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN: Add link to main CPAN web site
    DEBPKG:fixes/time_piece_doc - https://bugs.debian.org/817925 Time::Piece: Improve documentation for add_months and add_years
    DEBPKG:fixes/extutils_makemaker_reproducible - https://bugs.debian.org/835815 https://bugs.debian.org/834190 Make perllocal.pod files reproducible
    DEBPKG:fixes/file_path_hurd_errno - File-Path: Fix test failure in Hurd due to hard-coded ENOENT
    DEBPKG:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems
    DEBPKG:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters
    DEBPKG:fixes/file_path_chmod_race - https://bugs.debian.org/863870 [rt.cpan.org #121951] Prevent directory chmod race attack.
    DEBPKG:fixes/extutils_file_path_compat - Correct the order of tests of chmod(). (#294)
    DEBPKG:fixes/getopt-long-2 - [rt.cpan.org #120300] Withdraw part of commit 5d9947fb445327c7299d8beb009d609bc70066c0, which tries to implement more GNU getopt_long campatibility. GNU
    DEBPKG:fixes/getopt-long-3 - provide a default value for optional arguments
    DEBPKG:fixes/getopt-long-4 - https://bugs.debian.org/864544 [rt.cpan.org #122068] Fix issue #122068.
    DEBPKG:fixes/test-builder-reset - https://bugs.debian.org/865894 Reset inside subtest maintains parent
    DEBPKG:debian/hppa_opmini_optimize_workaround - https://bugs.debian.org/869122 Lower the optimization level of opmini.c on hppa
    DEBPKG:debian/sh4_op_optimize_workaround - https://bugs.debian.org/869373 Also lower the optimization level of op.c and opmini.c on sh4
    DEBPKG:fixes/json-pp-example - [rt.cpan.org #92793] https://bugs.debian.org/871837 fix RT-92793: bug in SYNOPSIS
    DEBPKG:debian/perldoc-pager - https://bugs.debian.org/870340 [rt.cpan.org #120229] Fix perldoc terminal escapes when sensible-pager is less
    DEBPKG:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
    DEBPKG:fixes/rename-filexp.U-phase1 - regen-configure: rename filexp.U to filexp_path.U, phase 1
    DEBPKG:fixes/rename-filexp.U-phase2 - regen-configure: rename filexp.U to filexp_path.U, phase 2
    DEBPKG:fixes/packaging_test_skips - Skip various tests if PERL_BUILD_PACKAGING is set
    DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
    DEBPKG:fixes/encode-alias-regexp - https://bugs.debian.org/880085 fix https://github.com/dankogai/p5-encode/issues/127
    DEBPKG:fixes/CVE-2018-6797-testcase - [perl #132227] (perl #132227) restart a node if we change to uni rules within the node and encounter a sharp S
    DEBPKG:fixes/test-printf-null - https://bugs.debian.org/893601 Fix pointer to integer cast in null_printf check
    DEBPKG:debian/configure-regen - https://bugs.debian.org/762638 Regenerate Configure et al. after probe unit changes
    DEBPKG:fixes/CVE-2018-12015-Archive-Tar-directory-traversal - https://bugs.debian.org/900834 [rt.cpan.org #125523] Remove existing files before overwriting them
    DEBPKG:debian/gdbm-fatal - [perl #133295] https://bugs.debian.org/904005 Temporarily skip GDBM_File fatal.t for gdbm >= 1.15 compatibility
    DEBPKG:fixes/CVE-2018-18311.patch - [PATCH] Perl_my_setenv(); handle integer wrap
    DEBPKG:fixes/CVE-2018-18312.patch - [PATCH 242/242] PATCH: [perl #133423] for 5.26 maint
    DEBPKG:fixes/CVE-2018-18313.patch - [PATCH] regcomp.c: Convert some strchr to memchr
    DEBPKG:fixes/CVE-2018-18314.patch - [PATCH] fix #131649 - extended charclass can trigger assert


@INC for perl 5.26.2:
    /home/jima/lib/perl
    /home/jima/perl5/lib/perl5/x86_64-linux-gnu-thread-multi
    /home/jima/perl5/lib/perl5/5.26.2/x86_64-linux-gnu-thread-multi
    /home/jima/perl5/lib/perl5/5.26.2
    /home/jima/perl5/lib/perl5/x86_64-linux-gnu-thread-multi
    /home/jima/perl5/lib/perl5
    /etc/perl
    /usr/local/lib/x86_64-linux-gnu/perl/5.26.2
    /usr/local/share/perl/5.26.2
    /usr/lib/x86_64-linux-gnu/perl5/5.26
    /usr/share/perl5
    /usr/lib/x86_64-linux-gnu/perl/5.26
    /usr/share/perl/5.26
    /home/jima/perl5/lib/perl5/5.26.1
    /home/jima/perl5/lib/perl5/5.26.1/x86_64-linux-gnu-thread-multi
    /home/jima/perl5/lib/perl5/5.26.0
    /home/jima/perl5/lib/perl5/5.26.0/x86_64-linux-gnu-thread-multi
    /usr/local/lib/site_perl
    /usr/lib/x86_64-linux-gnu/perl-base


Environment for perl 5.26.2:
    HOME=/home/jima
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_COLLATE=C
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/jima/.local/bin:/home/jima/perl5/bin:/home/jima/bin:/home/jima/jima_tools/x86_64/bin:/home/jima/jima_tools/bin:/opt/Qt/5.12.1/gcc_64/bin:/opt/Qt/Tools/QtCreator/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/bin/X11:/usr/local/bin:/usr/local/sbin:/usr/games:/usr/local/games:/snap/bin:/usr/lib/jvm/java-8-oracle/bin:/usr/lib/jvm/java-8-oracle/jre/bin:.
    PERL5LIB=/home/jima/lib/perl:/home/jima/perl5/lib/perl5/x86_64-linux-gnu-thread-multi:/home/jima/perl5/lib/perl5
    PERL_BADLANG (unset)
    PERL_LOCAL_LIB_ROOT=/home/jima/perl5
    PERL_MB_OPT=--install_base /home/jima/perl5
    PERL_MM_OPT=INSTALL_BASE=/home/jima/perl5
    SHELL=/bin/bash

[p5pRT]

From @tonycoz

On Tue, 30 Apr 2019 16​:50​:20 -0700, jim.avera@​gmail.com wrote​:

Not sure whether this is intended behavior, but just in case it's
not...

The refalias
\&foo = \&bar
is documented as "foo() now means bar()", but it doesn't entirely​:

In subsequently-compiled code, the compiler still wants calls
to foo() to match the old foo's prototype, not the prototype of bar.

#! /usr/bin/perl
use strict; use warnings; use v5.22.0;

use feature 'refaliasing';
no warnings 'experimental​::refaliasing';

sub foo($$$$) { }
sub bar($) { }

BEGIN{ \&foo = \&bar; }

foo(1); # Gets "Not enough arguments for main​::foo"

It's worse than that​:

./perl -Ilib -Mfeature=refaliasing -e 'sub foo { print "foo\n" } sub bar { print "bar\n" } \&foo = \&bar; $n = "foo"; &$n'
Aliasing via reference is experimental at -e line 1.
foo

It seems to be caused by the optimization of storing coderefs as GVs - pp_refassign is expecting a GV on the left for your sample code, but gets the CVref instead and so nothing happens​:

  switch (left ? SvTYPE(left) : 0) {
  case 0​:
  {
  SV * const old = PAD_SV(ARGTARG);
  PAD_SETSV(ARGTARG, SvREFCNT_inc_NN(SvRV(sv)));
  SvREFCNT_dec(old);
  if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
  == OPpLVAL_INTRO)
  SAVECLEARSV(PAD_SVl(ARGTARG));
  break;
  }
  case SVt_PVGV​:
  if (PL_op->op_private & OPpLVAL_INTRO) {
  S_localise_gv_slot(aTHX_ (GV *)left, type);
  }
  gv_setref(left, sv);
  SvSETMAGIC(left);
  break;
  case SVt_PVAV​:
  assert(key);
  if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
  S_localise_aelem_lval(aTHX_ (AV *)left, key,
  SvCANEXISTDELETE(left));
  }
  av_store((AV *)left, SvIV(key), SvREFCNT_inc_simple_NN(SvRV(sv)));
  break;
  case SVt_PVHV​:
  if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
  assert(key);
  S_localise_helem_lval(aTHX_ (HV *)left, key,
  SvCANEXISTDELETE(left));
  }
  (void)hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
  }

Tony

[p5pRT]

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

[p5pRT]

From @tonycoz

On Tue, 30 Apr 2019 16​:50​:20 -0700, jim.avera@​gmail.com wrote​:

Not sure whether this is intended behavior, but just in case it's
not...

The refalias
\&foo = \&bar
is documented as "foo() now means bar()", but it doesn't entirely​:

In subsequently-compiled code, the compiler still wants calls
to foo() to match the old foo's prototype, not the prototype of bar.

#!/usr/bin/perl
use strict; use warnings; use v5.22.0;

use feature 'refaliasing';
no warnings 'experimental​::refaliasing';

sub foo($$$$) { }
sub bar($) { }

BEGIN{ \&foo = \&bar; }

foo(1); # Gets "Not enough arguments for main​::foo"

Fix attached.

With the fix your code produces​:

$ ./perl -Ilib ../134072.pl
Subroutine main​::foo redefined at ../134072.pl line 11.
Prototype mismatch​: sub main​::foo ($$$$) vs ($) at ../134072.pl line 11.
bar

Tony

Tony

[p5pRT]

From @tonycoz

0001-perl-134072-allow-foo-bar-to-work-in-main.patch

From 9b8b423a9084a4e7ed3f6b704a88801fca6ce555 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 15 May 2019 15:59:49 +1000
Subject: (perl #134072) allow \&foo = \&bar to work in main::

subs in main:: are stored as a RV referring to a CV as a space
optimization, but the pp_refassign code expected to find a glob,
which made the assignment a no-op.

Fix this by upgrading the reference to a glob in the refassign check
function.

Note that this would be an issue in other packages if 1e2cfe157ca
was reverted (allowing the space savings in other packages too.)
---
 op.c         |  9 +++++++++
 t/op/lvref.t | 15 ++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/op.c b/op.c
index 74761ca421..2e20dc886d 100644
--- a/op.c
+++ b/op.c
@@ -12465,7 +12465,16 @@ Perl_ck_refassign(pTHX_ OP *o)
 	OP * const kid = cUNOPx(kidparent)->op_first;
 	o->op_private |= OPpLVREF_CV;
 	if (kid->op_type == OP_GV) {
+            SV *sv = (SV*)cGVOPx_gv(kid);
 	    varop = kidparent;
+            if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
+                /* a CVREF here confuses pp_refassign, so make sure
+                   it gets a GV */
+                CV *const cv = (CV*)SvRV(sv);
+                SV *name_sv = sv_2mortal(newSVhek(CvNAME_HEK(cv)));
+                (void)gv_init_sv((GV*)sv, CvSTASH(cv), name_sv, 0);
+                assert(SvTYPE(sv) == SVt_PVGV);
+            }
 	    goto detach_and_stack;
 	}
 	if (kid->op_type != OP_PADCV)	goto bad;
diff --git a/t/op/lvref.t b/t/op/lvref.t
index 3d5e952fb0..b900cbc12a 100644
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -1,10 +1,11 @@
+#!perl
 BEGIN {
     chdir 't';
     require './test.pl';
     set_up_inc("../lib");
 }
 
-plan 164;
+plan 167;
 
 eval '\$x = \$y';
 like $@, qr/^Experimental aliasing via reference not enabled/,
@@ -291,6 +292,18 @@ package CodeTest {
   my sub bs;
   \(&cs) = expect_list_cx;
   is \&cs, \&ThatSub, '\(&statesub)';
+
+  package main {
+    # this somehow is only a problem in main::
+    sub sx { "x" }
+    sub sy { "y" }
+    is sx(), "x", "check original";
+    my $temp = \&sx;
+    \&sx = \&sy;
+    is sx(), "y", "aliased";
+    \&sx = $temp;
+    is sx(), "x", "and restored";
+  }
 }
 
 # Mixed List Assignments
-- 
2.11.0

[p5pRT]

From @tonycoz

On Tue, 14 May 2019 23​:09​:38 -0700, tonyc wrote​:

On Tue, 30 Apr 2019 16​:50​:20 -0700, jim.avera@​gmail.com wrote​:

Not sure whether this is intended behavior, but just in case it's
not...

The refalias
\&foo = \&bar
is documented as "foo() now means bar()", but it doesn't entirely​:

In subsequently-compiled code, the compiler still wants calls
to foo() to match the old foo's prototype, not the prototype of bar.

#!/usr/bin/perl
use strict; use warnings; use v5.22.0;

use feature 'refaliasing';
no warnings 'experimental​::refaliasing';

sub foo($$$$) { }
sub bar($) { }

BEGIN{ \&foo = \&bar; }

foo(1); # Gets "Not enough arguments for main​::foo"

Fix attached.

Applied as 40258da.

Tony

[p5pRT]

@tonycoz - Status changed from 'open' to 'pending release'