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

lexical subs don't seem to honor prototypes #12767

Closed
p5pRT opened this issue Feb 13, 2013 · 28 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Feb 13, 2013

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

Searchable as RT116735$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 13, 2013

From PeterCMartini@GMail.com

Created by petercmartini@gmail.com

lexical subs don't seem to honor prototypes​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Get rid of the 'my', and that dies.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.17.9:

Configured by pmartini at Wed Feb  6 02:51:49 EST 2013.

Summary of my perl5 (revision 5 version 17 subversion 9) configuration:
  Derived from: 52a2a812ca95071d6e5d921cf74061d912278729
  Platform:
    osname=linux, osvers=3.2.0-32-generic, archname=i686-linux-thread-multi
    uname='linux pmlinlaptop 3.2.0-32-generic #51-ubuntu smp wed sep
26 21:32:50 utc 2012 i686 i686 i386 gnulinux '
    config_args='-Dusedevel -DDEBUGGING -Dusethreads -des'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.6.3', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib/i386-linux-gnu /lib/../lib
/usr/lib/i386-linux-gnu /usr/lib/../lib /lib /usr/lib
    libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.15'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib
-fstack-protector'

Locally applied patches:



@INC for perl 5.17.9:
    /usr/local/lib/perl5/site_perl/5.17.9/i686-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.17.9
    /usr/local/lib/perl5/5.17.9/i686-linux-thread-multi
    /usr/local/lib/perl5/5.17.9
    /usr/local/lib/perl5/site_perl
    .


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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 15, 2013

From PeterCMartini@GMail.com

So, this is because prototype handling operates on an rv pointing to a
cv, and padcv is left out (since there's no rv pointing to it).

Fixing that gets to this little bit of ugliness, as explained in op.c​:

  if (!namegv) { /* expletive! */
  /* XXX The call checker API is public. And it guarantees that
  a GV will be provided with the right name. So we have
  to create a GV. But it is still not correct, as its
  stringification will include the package. What we
  really need is a new call checker API that accepts a
  GV or string (or GV or CV). */

I'm not sure what the best way forward is here.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 15, 2013

From [Unknown Contact. See original ticket]

So, this is because prototype handling operates on an rv pointing to a
cv, and padcv is left out (since there's no rv pointing to it).

Fixing that gets to this little bit of ugliness, as explained in op.c​:

  if (!namegv) { /* expletive! */
  /* XXX The call checker API is public. And it guarantees that
  a GV will be provided with the right name. So we have
  to create a GV. But it is still not correct, as its
  stringification will include the package. What we
  really need is a new call checker API that accepts a
  GV or string (or GV or CV). */

I'm not sure what the best way forward is here.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 15, 2013

PeterCMartini@GMail.com - Status changed from 'new' to 'open'

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 17, 2013

From PeterCMartini@GMail.com

The tests for lexical subs (t/cmd/lexsub.t) includes this​:

package main;
{
  sub me ($);
  is prototype eval{\&me}, '$', 'my sub with proto';
  is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

If we can agree that that test should also return '$', then I can submit
a patch (for review) that gets prototypes working for lexical subs.

It's a rather involved patch...

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 17, 2013

From [Unknown Contact. See original ticket]

The tests for lexical subs (t/cmd/lexsub.t) includes this​:

package main;
{
  sub me ($);
  is prototype eval{\&me}, '$', 'my sub with proto';
  is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

If we can agree that that test should also return '$', then I can submit
a patch (for review) that gets prototypes working for lexical subs.

It's a rather involved patch...

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 18, 2013

From @rgarcia

On 17 February 2013 06​:36, Peter Martini via RT
<perlbug-comment@​perl.org> wrote​:

The tests for lexical subs (t/cmd/lexsub.t) includes this​:

package main;
{
sub me ($);
is prototype eval{\&me}, '$', 'my sub with proto';
is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

If we can agree that that test should also return '$', then I can submit
a patch (for review) that gets prototypes working for lexical subs.

It's a rather involved patch...

In any event, I think that either 5.18 should have lexical-sub
prototypes working, or warning (or dying?) just to make sure no-one
starts writing code that assumes the current behaviour is correct...

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 18, 2013

From PeterCMartini@GMail.com

On Mon, Feb 18, 2013 at 3​:47 AM, Rafael Garcia-Suarez <rgs@​consttype.org> wrote​:

On 17 February 2013 06​:36, Peter Martini via RT
<perlbug-comment@​perl.org> wrote​:

The tests for lexical subs (t/cmd/lexsub.t) includes this​:

package main;
{
sub me ($);
is prototype eval{\&me}, '$', 'my sub with proto';
is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

If we can agree that that test should also return '$', then I can submit
a patch (for review) that gets prototypes working for lexical subs.

It's a rather involved patch...

In any event, I think that either 5.18 should have lexical-sub
prototypes working, or warning (or dying?) just to make sure no-one
starts writing code that assumes the current behaviour is correct...

We're in good shape on that point​:

perl5.17.9 -E 'my sub foo {say @​_} foo 1;'
Experimental "my" subs not enabled at -e line 1.

perl5.17.9 -Mfeature=lexical_subs -E 'my sub foo {say @​_} foo 1;'
The lexical_subs feature is experimental at -e line 1.
1

It warns no matter what, but doesn't even execute unless you
specifically enable it.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 18, 2013

From PeterCMartini@GMail.com

On Tue Feb 12 20​:53​:03 2013, pcm wrote​:

This is a bug report for perl from petercmartini@​gmail.com,
generated with the help of perlbug 1.39 running under perl 5.17.9.

-----------------------------------------------------------------
[Please describe your issue here]

lexical subs don't seem to honor prototypes​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Get rid of the 'my', and that dies.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags​:
category=core
severity=low
---
Site configuration information for perl 5.17.9​:

Configured by pmartini at Wed Feb 6 02​:51​:49 EST 2013.

Summary of my perl5 (revision 5 version 17 subversion 9)
configuration​:
Derived from​: 52a2a81
Platform​:
osname=linux, osvers=3.2.0-32-generic, archname=i686-linux-thread-
multi
uname='linux pmlinlaptop 3.2.0-32-generic #51-ubuntu smp wed sep
26 21​:32​:50 utc 2012 i686 i686 i386 gnulinux '
config_args='-Dusedevel -DDEBUGGING -Dusethreads -des'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define,
usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler​:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -g',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.6.3', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries​:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib/i386-linux-gnu /lib/../lib
/usr/lib/i386-linux-gnu /usr/lib/../lib /lib /usr/lib
libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.15'
Dynamic Linking​:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib
-fstack-protector'

Locally applied patches​:

---
@​INC for perl 5.17.9​:
/usr/local/lib/perl5/site_perl/5.17.9/i686-linux-thread-multi
/usr/local/lib/perl5/site_perl/5.17.9
/usr/local/lib/perl5/5.17.9/i686-linux-thread-multi
/usr/local/lib/perl5/5.17.9
/usr/local/lib/perl5/site_perl
.

---
Environment for perl 5.17.9​:
HOME=/home/pmartini
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/usr/lib/lightdm/lightdm​:/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/
usr/bin​:/sbin​:/bin​:/usr/games

PERL\_BADLANG \(unset\)
SHELL=/bin/bash

Further testing​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Does not check prototypes.

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a(1);'

*Does* check prototypes.

The difference is the second one generates an rv2cv pointing to the
padcv, while the first one uses the padcv directly.

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

There are two components, which are separable​:

1. Change ck_subr to grab the CV directly from padcv if that's the last
op, which is the simple fix, and I'll defer to anyone more knowledgeable
on whether it's the correct fix.

2. Father C had noted that the Perl_call_checker API passes a GV*, which
no longer works, since a lexical sub won't have a GV. The solution as
of right now is a faked up GV, which as noted is not ideal, as it
includes the current package.

I added an alternate API, Perl_call_checker_sv and appropriate get/set
functions, so that the name could be passed be specified as an SV*. For
backwards compatibility reasons, if a custom Perl_call_checker was set,
it will use that; if a custom Perl_call_checker_sv was set, it will use
that; otherwise, it will use the default Perl_call_checker_sv.

These both get stored in checkcall magic, so only one can be active at a
time. If the current, GV form, is used in a set, and the SV form is
used in a get, the get returns a NULL pointer. In the reverse case,
where the new API is used to set an override, and the old API is used to
get it back, the code will croak. The reason for the difference is the
old API implies the call will always succeed, so returning a NULL would
be a bad idea, while the new version is documented to return NULL to
indicate that the alternate API should be used.

************

Now that I see that prototypes are actually partially honored, applying
just the first part would get us to consistency with minimal risk of
side effects, and the second part can be polished up as a nice to have.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 18, 2013

From [Unknown Contact. See original ticket]

On Tue Feb 12 20​:53​:03 2013, pcm wrote​:

This is a bug report for perl from petercmartini@​gmail.com,
generated with the help of perlbug 1.39 running under perl 5.17.9.

-----------------------------------------------------------------
[Please describe your issue here]

lexical subs don't seem to honor prototypes​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Get rid of the 'my', and that dies.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags​:
category=core
severity=low
---
Site configuration information for perl 5.17.9​:

Configured by pmartini at Wed Feb 6 02​:51​:49 EST 2013.

Summary of my perl5 (revision 5 version 17 subversion 9)
configuration​:
Derived from​: 52a2a81
Platform​:
osname=linux, osvers=3.2.0-32-generic, archname=i686-linux-thread-
multi
uname='linux pmlinlaptop 3.2.0-32-generic #51-ubuntu smp wed sep
26 21​:32​:50 utc 2012 i686 i686 i386 gnulinux '
config_args='-Dusedevel -DDEBUGGING -Dusethreads -des'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define,
usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler​:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -g',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.6.3', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries​:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib/i386-linux-gnu /lib/../lib
/usr/lib/i386-linux-gnu /usr/lib/../lib /lib /usr/lib
libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.15'
Dynamic Linking​:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib
-fstack-protector'

Locally applied patches​:

---
@​INC for perl 5.17.9​:
/usr/local/lib/perl5/site_perl/5.17.9/i686-linux-thread-multi
/usr/local/lib/perl5/site_perl/5.17.9
/usr/local/lib/perl5/5.17.9/i686-linux-thread-multi
/usr/local/lib/perl5/5.17.9
/usr/local/lib/perl5/site_perl
.

---
Environment for perl 5.17.9​:
HOME=/home/pmartini
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/usr/lib/lightdm/lightdm​:/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/
usr/bin​:/sbin​:/bin​:/usr/games

PERL\_BADLANG \(unset\)
SHELL=/bin/bash

Further testing​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Does not check prototypes.

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a(1);'

*Does* check prototypes.

The difference is the second one generates an rv2cv pointing to the
padcv, while the first one uses the padcv directly.

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

There are two components, which are separable​:

1. Change ck_subr to grab the CV directly from padcv if that's the last
op, which is the simple fix, and I'll defer to anyone more knowledgeable
on whether it's the correct fix.

2. Father C had noted that the Perl_call_checker API passes a GV*, which
no longer works, since a lexical sub won't have a GV. The solution as
of right now is a faked up GV, which as noted is not ideal, as it
includes the current package.

I added an alternate API, Perl_call_checker_sv and appropriate get/set
functions, so that the name could be passed be specified as an SV*. For
backwards compatibility reasons, if a custom Perl_call_checker was set,
it will use that; if a custom Perl_call_checker_sv was set, it will use
that; otherwise, it will use the default Perl_call_checker_sv.

These both get stored in checkcall magic, so only one can be active at a
time. If the current, GV form, is used in a set, and the SV form is
used in a get, the get returns a NULL pointer. In the reverse case,
where the new API is used to set an override, and the old API is used to
get it back, the code will croak. The reason for the difference is the
old API implies the call will always succeed, so returning a NULL would
be a bad idea, while the new version is documented to return NULL to
indicate that the alternate API should be used.

************

Now that I see that prototypes are actually partially honored, applying
just the first part would get us to consistency with minimal risk of
side effects, and the second part can be polished up as a nice to have.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 19, 2013

From PeterCMartini@GMail.com

Father C -

This change​:

Inline Patch
diff --git a/op.c b/op.c
index c9a1b53..9c2d06a 100644
--- a/op.c
+++ b/op.c
@@ -8135,7 +8135,6 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
        dVAR;
        o->op_type = OP_PADCV;
        o->op_ppaddr = PL_ppaddr[OP_PADCV];
-       return o;
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
 }

Seems like it should be sufficient for the fix, but it's causing assertion failures on assert\(hek\) in the case of a const sub​:

'my sub if(){44} if;' # boom!

I haven't been able to chase down a fix for that part yet, though.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 19, 2013

From [Unknown Contact. See original ticket]

Father C -

This change​:

Inline Patch
diff --git a/op.c b/op.c
index c9a1b53..9c2d06a 100644
--- a/op.c
+++ b/op.c
@@ -8135,7 +8135,6 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
        dVAR;
        o->op_type = OP_PADCV;
        o->op_ppaddr = PL_ppaddr[OP_PADCV];
-       return o;
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
 }

Seems like it should be sufficient for the fix, but it's causing assertion failures on assert\(hek\) in the case of a const sub​:

'my sub if(){44} if;' # boom!

I haven't been able to chase down a fix for that part yet, though.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 20, 2013

From @chipdude

On 2/16/2013 9​:36 PM, Peter Martini via RT wrote​:

package main;
{
sub me ($);
is prototype eval{\&me}, '$', 'my sub with proto';
is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

This test seems fine. After all, compare with scalars. While $me
might be a lexical, ${"me"} never is. Why should & break this pattern?

Which isn't to say that lexical subs should ignore prototypes.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 20, 2013

From PeterCMartini@GMail.com

On Tue, Feb 19, 2013 at 9​:38 PM, Reverend Chip <rev.chip@​gmail.com> wrote​:

On 2/16/2013 9​:36 PM, Peter Martini via RT wrote​:

package main;
{
sub me ($);
is prototype eval{\&me}, '$', 'my sub with proto';
is prototype "me", undef, 'prototype "..." ignores my subs';
}

That last test seems like a bug rather than a feature, and is part of
the reason prototypes don't work with lexical variables - prototypes are
only found if they're looked up via rv2cv, rather than via the new padcv
op.

This test seems fine. After all, compare with scalars. While $me
might be a lexical, ${"me"} never is. Why should & break this pattern?

Ah, that makes sense, and proves the point that my original approach
was too hackish for its own good.

Removing the early return in newCVREF certainly looks like a much
saner (and smaller) fix, but I haven't had a chance to look into why
the conversion to a const sub causes so much trouble.

Which isn't to say that lexical subs should ignore prototypes.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 2, 2013

From @cpansprout

On Mon Feb 18 10​:55​:41 2013, pcm wrote​:

On Tue Feb 12 20​:53​:03 2013, pcm wrote​:
Further testing​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Does not check prototypes.

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a(1);'

*Does* check prototypes.

The difference is the second one generates an rv2cv pointing to the
padcv, while the first one uses the padcv directly.

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

There are two components, which are separable​:

1. Change ck_subr to grab the CV directly from padcv if that's the last
op, which is the simple fix, and I'll defer to anyone more knowledgeable
on whether it's the correct fix.

I’ve done what I think is the more correct fix, which is to avoid
generating two disparate op trees to begin with, in commit 9a5e6f3.

2. Father C had noted that the Perl_call_checker API passes a GV*, which
no longer works, since a lexical sub won't have a GV. The solution as
of right now is a faked up GV, which as noted is not ideal, as it
includes the current package.

I added an alternate API, Perl_call_checker_sv and appropriate get/set
functions, so that the name could be passed be specified as an SV*. For
backwards compatibility reasons, if a custom Perl_call_checker was set,
it will use that; if a custom Perl_call_checker_sv was set, it will use
that; otherwise, it will use the default Perl_call_checker_sv.

These both get stored in checkcall magic, so only one can be active at a
time. If the current, GV form, is used in a set, and the SV form is
used in a get, the get returns a NULL pointer. In the reverse case,
where the new API is used to set an override, and the old API is used to
get it back, the code will croak. The reason for the difference is the
old API implies the call will always succeed, so returning a NULL would
be a bad idea, while the new version is documented to return NULL to
indicate that the alternate API should be used.

************

Now that I see that prototypes are actually partially honored, applying
just the first part would get us to consistency with minimal risk of
side effects, and the second part can be polished up as a nice to have.

Would you be willing to do that? :-)

One thing I thought about was to create a new API function, maybe called
cv_name, which can be passed, a CV, a GV, or any stringifiable SV. It
would return an SV containing the name of the sub (a new mortal for a CV
or GV; the SV itself otherwise).

Whatever value is passed through the new call checker API could be
passed through to cv_name when an error is reported.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 2, 2013

From @cpansprout

On Tue Feb 19 07​:08​:56 2013, pcm wrote​:

Father C -

This change​:

diff --git a/op.c b/op.c
index c9a1b53..9c2d06a 100644
--- a/op.c
+++ b/op.c
@​@​ -8135,7 +8135,6 @​@​ Perl_newCVREF(pTHX_ I32 flags, OP *o)
dVAR;
o->op_type = OP_PADCV;
o->op_ppaddr = PL_ppaddr[OP_PADCV];
- return o;
}
return newUNOP(OP_RV2CV, flags, scalar(o));
}

Seems like it should be sufficient for the fix, but it's causing
assertion failures on assert(hek) in the case of a const sub​:

'my sub if(){44} if;' # boom!

I haven't been able to chase down a fix for that part yet, though.

That part I’ve fixed in commit 83a72a1.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 6, 2013

From PeterCMartini@GMail.com

On Sun Jun 02 13​:36​:14 2013, sprout wrote​:

On Mon Feb 18 10​:55​:41 2013, pcm wrote​:

On Tue Feb 12 20​:53​:03 2013, pcm wrote​:
Further testing​:

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a 1;'

Does not check prototypes.

perl5.17.9 -Mfeature=lexical_subs -e 'my sub a($$){} a(1);'

*Does* check prototypes.

The difference is the second one generates an rv2cv pointing to the
padcv, while the first one uses the padcv directly.

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

There are two components, which are separable​:

1. Change ck_subr to grab the CV directly from padcv if that's the
last
op, which is the simple fix, and I'll defer to anyone more
knowledgeable
on whether it's the correct fix.

I’ve done what I think is the more correct fix, which is to avoid
generating two disparate op trees to begin with, in commit
9a5e6f3.

2. Father C had noted that the Perl_call_checker API passes a GV*,
which
no longer works, since a lexical sub won't have a GV. The solution
as
of right now is a faked up GV, which as noted is not ideal, as it
includes the current package.

I added an alternate API, Perl_call_checker_sv and appropriate
get/set
functions, so that the name could be passed be specified as an SV*.
For
backwards compatibility reasons, if a custom Perl_call_checker was
set,
it will use that; if a custom Perl_call_checker_sv was set, it will
use
that; otherwise, it will use the default Perl_call_checker_sv.

These both get stored in checkcall magic, so only one can be active
at a
time. If the current, GV form, is used in a set, and the SV form is
used in a get, the get returns a NULL pointer. In the reverse case,
where the new API is used to set an override, and the old API is
used to
get it back, the code will croak. The reason for the difference is
the
old API implies the call will always succeed, so returning a NULL
would
be a bad idea, while the new version is documented to return NULL to
indicate that the alternate API should be used.

************

Now that I see that prototypes are actually partially honored,
applying
just the first part would get us to consistency with minimal risk of
side effects, and the second part can be polished up as a nice to
have.

Would you be willing to do that? :-)

One thing I thought about was to create a new API function, maybe
called
cv_name, which can be passed, a CV, a GV, or any stringifiable SV. It
would return an SV containing the name of the sub (a new mortal for a
CV
or GV; the SV itself otherwise).

Whatever value is passed through the new call checker API could be
passed through to cv_name when an error is reported.

If you don't beat me to it, I'll put that on my TODO list :-)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 11, 2014

From @cpansprout

On Sun Jun 02 13​:36​:14 2013, sprout wrote​:

On Mon Feb 18 10​:55​:41 2013, pcm wrote​:

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

That URL does not work any more.

There are two components, which are separable​:

1. Change ck_subr to grab the CV directly from padcv if that's the last
op, which is the simple fix, and I'll defer to anyone more knowledgeable
on whether it's the correct fix.

I’ve done what I think is the more correct fix, which is to avoid
generating two disparate op trees to begin with, in commit 9a5e6f3.

2. Father C had noted that the Perl_call_checker API passes a GV*, which
no longer works, since a lexical sub won't have a GV. The solution as
of right now is a faked up GV, which as noted is not ideal, as it
includes the current package.

I added an alternate API, Perl_call_checker_sv and appropriate get/set
functions, so that the name could be passed be specified as an SV*. For
backwards compatibility reasons, if a custom Perl_call_checker was set,
it will use that; if a custom Perl_call_checker_sv was set, it will use
that; otherwise, it will use the default Perl_call_checker_sv.

These both get stored in checkcall magic, so only one can be active at a
time. If the current, GV form, is used in a set, and the SV form is
used in a get, the get returns a NULL pointer. In the reverse case,
where the new API is used to set an override, and the old API is used to
get it back, the code will croak. The reason for the difference is the
old API implies the call will always succeed, so returning a NULL would
be a bad idea, while the new version is documented to return NULL to
indicate that the alternate API should be used.

************

Now that I see that prototypes are actually partially honored, applying
just the first part would get us to consistency with minimal risk of
side effects, and the second part can be polished up as a nice to have.

Would you be willing to do that? :-)

I was about to do that (separate out part 2 from your patch and polish it up), but, as noted above, cannot access that URL.

Do you still have the patch floating around somewhere? If not, I will just have to write it from scratch. I need it right now for the stuff I’m doing on the sprout/cvgv branch. (ck_subr reifies GVs and I need the alternate call checker API to remove the need for that.)

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 11, 2014

From @cpansprout

On Wed Sep 10 20​:39​:40 2014, sprout wrote​:

I was about to do that (separate out part 2 from your patch and polish
it up), but, as noted above, cannot access that URL.

Do you still have the patch floating around somewhere? If not, I will
just have to write it from scratch. I need it right now for the stuff
I’m doing on the sprout/cvgv branch. (ck_subr reifies GVs and I need
the alternate call checker API to remove the need for that.)

Actually, having a separate API that takes an SV* would require us to duplicate all the built-in call checkers.

Instead, how about a cv_set_call_checker_flags, and the only flag is CALL_CHECKER_REQUIRE_GV? cv_set_call_checker calls _flags with that flag.

The name thingy that gets passed to the call checker can be cast to GV *.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 11, 2014

From @rjbs

* Father Chrysostomos via RT <perlbug-followup@​perl.org> [2014-09-10T23​:39​:41]

On Sun Jun 02 13​:36​:14 2013, sprout wrote​:

On Mon Feb 18 10​:55​:41 2013, pcm wrote​:

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

That URL does not work any more.

(This is why, even though it can be a pain in the butt, we ask for patches to
be sent in.)

--
rjbs

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 12, 2014

From PeterCMartini@GMail.com

On Wed, Sep 10, 2014 at 11​:39 PM, Father Chrysostomos via RT
<perlbug-followup@​perl.org> wrote​:

On Sun Jun 02 13​:36​:14 2013, sprout wrote​:

On Mon Feb 18 10​:55​:41 2013, pcm wrote​:

I'd been playing with ways to fix this, and checked in my work-in-
progress (as a single large-ish commit) this morning​:
PeterMartini@lexical

That URL does not work any more.

I'm not quite sure at what point that got borked, since my local git
repo still listed it as only a remote branch on github (even though
github didn't find it). So for my own sanity, I did a local checkout
and pushed it back up to github unmodified. All that said, it's
probably not useful at all :-)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 12, 2014

From @cpansprout

On Thu Sep 11 22​:50​:24 2014, pcm wrote​:

I'm not quite sure at what point that got borked, since my local git
repo still listed it as only a remote branch on github (even though
github didn't find it). So for my own sanity, I did a local checkout
and pushed it back up to github unmodified. All that said, it's
probably not useful at all :-)

Thank you anyway. Or, rather, thank you for not restoring it till now, because I might not have been prompted by laziness to come up with a simpler solution otherwise. :-)

I do think it is over-engineered and that cv_set_call_checker_flags is a better solution.

BTW, have you seen what I am doing on the sprout/cvgv branch? It is almost ready for merging, but not quite. Maybe a few more days. In any case, ‘sub foo{} foo() \&foo’ no longer has to create a *foo glob, saving memory.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 15, 2014

From @cpansprout

On Thu Sep 11 22​:50​:24 2014, pcm wrote​:

I'm not quite sure at what point that got borked, since my local git
repo still listed it as only a remote branch on github (even though
github didn't find it). So for my own sanity, I did a local checkout
and pushed it back up to github unmodified. All that said, it's
probably not useful at all :-)

I’m attaching it here for future readers.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 15, 2014

From @cpansprout

From 0229fcb Mon Sep 17 00​:00​:00 2001
From​: Peter Martini <PeterCMartini@​GMail.com>
Date​: Mon, 18 Feb 2013 11​:04​:35 -0500
Subject​: [PATCH] Changed to allow lexical subs to have prototypes


cv.h | 1 +
embed.fnc | 13 ++
embed.h | 7 +
ext/XS-APItest/APItest.xs | 5 +
ext/XS-APItest/callchecker.xs | 51 +++++++
op.c | 300 ++++++++++++++++++++++++++++++++----------
proto.h | 47 +++++++
t/cmd/lexsub.t | 10 +-
8 files changed, 363 insertions(+), 71 deletions(-)
create mode 100644 ext/XS-APItest/callchecker.xs

Inline Patch
diff --git a/cv.h b/cv.h
index 5da9a50..4dcc35f 100644
--- a/cv.h
+++ b/cv.h
@@ -268,6 +268,7 @@ should print 123:
 */
 
 typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);
+typedef OP *(*Perl_call_checker_sv)(pTHX_ OP *, SV *, SV *);
 
 /*
  * Local variables:
diff --git a/embed.fnc b/embed.fnc
index a288c5a..ed09312 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -977,13 +977,26 @@ Apda	|OP*	|newWHILEOP	|I32 flags|I32 debuggable|NULLOK LOOP* loop \
 				|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \
 				|I32 has_my
 Apd	|CV*	|rv2cv_op_cv	|NN OP *cvop|U32 flags
+#if defined(PERL_IN_OP_C)
+s	|CV*	|padcv_op_cv	|NN OP *padcvop|NULLOK SV ** namesv
+#endif
 Apd	|OP*	|ck_entersub_args_list|NN OP *entersubop
 Apd	|OP*	|ck_entersub_args_proto|NN OP *entersubop|NN GV *namegv|NN SV *protosv
+AMpd	|OP*	|ck_entersub_args_proto_sv|NN OP *entersubop|NN SV *namesv|NN SV *protosv
+#if defined(PERL_IN_OP_C)
+s	|OP*	|ck_entersub_args_proto_core|NN OP *entersubop|NN void *namev|NN SV *protosv|bool name_is_gv
+#endif
 Apd	|OP*	|ck_entersub_args_proto_or_list|NN OP *entersubop|NN GV *namegv|NN SV *protosv
+AMpd	|OP*	|ck_entersub_args_proto_or_list_sv|NN OP *entersubop|NN SV *namesv|NN SV *protosv
 po	|OP*	|ck_entersub_args_core|NN OP *entersubop|NN GV *namegv \
 				      |NN SV *protosv
 Apd	|void	|cv_get_call_checker|NN CV *cv|NN Perl_call_checker *ckfun_p|NN SV **ckobj_p
+AMpd	|void	|cv_get_call_checker_sv|NN CV *cv|NN Perl_call_checker_sv *ckfun_p|NN SV **ckobj_p
 Apd	|void	|cv_set_call_checker|NN CV *cv|NN Perl_call_checker ckfun|NN SV *ckobj
+AMpd	|void	|cv_set_call_checker_sv|NN CV *cv|NN Perl_call_checker_sv ckfun|NN SV *ckobj
+#if defined(PERL_IN_OP_C)
+s	|MAGIC*	|cv_set_call_checker_core|NN CV *cv|NN void *ckfun|NN SV *ckobj
+#endif
 Apd	|void	|wrap_op_checker|Optype opcode|NN Perl_check_t new_checker|NN Perl_check_t *old_checker_p
 Apa	|PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems
 Ap	|char*	|scan_vstring	|NN const char *s|NN const char *const e \
diff --git a/embed.h b/embed.h
index c66eba9..c5154f4 100644
--- a/embed.h
+++ b/embed.h
@@ -77,6 +77,8 @@
 #define ck_entersub_args_list(a)	Perl_ck_entersub_args_list(aTHX_ a)
 #define ck_entersub_args_proto(a,b,c)	Perl_ck_entersub_args_proto(aTHX_ a,b,c)
 #define ck_entersub_args_proto_or_list(a,b,c)	Perl_ck_entersub_args_proto_or_list(aTHX_ a,b,c)
+#define ck_entersub_args_proto_or_list_sv(a,b,c)	Perl_ck_entersub_args_proto_or_list_sv(aTHX_ a,b,c)
+#define ck_entersub_args_proto_sv(a,b,c)	Perl_ck_entersub_args_proto_sv(aTHX_ a,b,c)
 #ifndef PERL_IMPLICIT_CONTEXT
 #define ck_warner		Perl_ck_warner
 #define ck_warner_d		Perl_ck_warner_d
@@ -93,7 +95,9 @@
 #define cv_clone(a)		Perl_cv_clone(aTHX_ a)
 #define cv_const_sv(a)		Perl_cv_const_sv(aTHX_ a)
 #define cv_get_call_checker(a,b,c)	Perl_cv_get_call_checker(aTHX_ a,b,c)
+#define cv_get_call_checker_sv(a,b,c)	Perl_cv_get_call_checker_sv(aTHX_ a,b,c)
 #define cv_set_call_checker(a,b,c)	Perl_cv_set_call_checker(aTHX_ a,b,c)
+#define cv_set_call_checker_sv(a,b,c)	Perl_cv_set_call_checker_sv(aTHX_ a,b,c)
 #define cv_undef(a)		Perl_cv_undef(aTHX_ a)
 #define cx_dump(a)		Perl_cx_dump(aTHX_ a)
 #define cxinc()			Perl_cxinc(aTHX)
@@ -1416,7 +1420,9 @@
 #define apply_attrs_my(a,b,c,d)	S_apply_attrs_my(aTHX_ a,b,c,d)
 #define bad_type_pv(a,b,c,d,e)	S_bad_type_pv(aTHX_ a,b,c,d,e)
 #define bad_type_sv(a,b,c,d,e)	S_bad_type_sv(aTHX_ a,b,c,d,e)
+#define ck_entersub_args_proto_core(a,b,c,d)	S_ck_entersub_args_proto_core(aTHX_ a,b,c,d)
 #define cop_free(a)		S_cop_free(aTHX_ a)
+#define cv_set_call_checker_core(a,b,c)	S_cv_set_call_checker_core(aTHX_ a,b,c)
 #define dup_attrlist(a)		S_dup_attrlist(aTHX_ a)
 #define finalize_op(a)		S_finalize_op(aTHX_ a)
 #define find_and_forget_pmops(a)	S_find_and_forget_pmops(aTHX_ a)
@@ -1439,6 +1445,7 @@
 #define no_fh_allowed(a)	S_no_fh_allowed(aTHX_ a)
 #define op_integerize(a)	S_op_integerize(aTHX_ a)
 #define op_std_init(a)		S_op_std_init(aTHX_ a)
+#define padcv_op_cv(a,b)	S_padcv_op_cv(aTHX_ a,b)
 #define pmtrans(a,b,c)		S_pmtrans(aTHX_ a,b,c)
 #define process_special_blocks(a,b,c,d)	S_process_special_blocks(aTHX_ a,b,c,d)
 #define ref_array_or_hash(a)	S_ref_array_or_hash(aTHX_ a)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index dbb4f50..58d3c94 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1124,6 +1124,9 @@ my_ck_rv2cv(pTHX_ OP *o)
     return old_ck_rv2cv(aTHX_ o);
 }
 
+static OP * my_callchecker(pTHX_ OP *o, GV *g, SV *p) { return o; }
+static OP * my_callchecker_sv(pTHX_ OP *o, SV *g, SV *p) { return o; }
+
 #include "const-c.inc"
 
 MODULE = XS::APItest		PACKAGE = XS::APItest
@@ -1132,6 +1135,8 @@ INCLUDE: const-xs.inc
 
 INCLUDE: numeric.xs
 
+INCLUDE: callchecker.xs
+
 MODULE = XS::APItest::utf8	PACKAGE = XS::APItest::utf8
 
 int
diff --git a/ext/XS-APItest/callchecker.xs b/ext/XS-APItest/callchecker.xs
new file mode 100644
index 0000000..0cba6dc
--- /dev/null
+++ b/ext/XS-APItest/callchecker.xs
@@ -0,0 +1,51 @@
+MODULE = XS::APItest		PACKAGE = XS::APItest::callchecker
+
+UV
+callchecker_address()
+    CODE:
+	RETVAL = PTR2UV(my_callchecker);
+    OUTPUT:
+	RETVAL
+
+UV
+callchecker_sv_address()
+    CODE:
+	RETVAL = PTR2UV(my_callchecker_sv);
+    OUTPUT:
+	RETVAL
+
+void
+setcallchecker(cv)
+	CV * cv
+    CODE:
+	SV * ckobj = (SV *)cv;
+	cv_set_call_checker(cv, my_callchecker, ckobj);
+
+void
+setcallchecker_sv(cv)
+	CV * cv
+    CODE:
+	SV * ckobj = (SV *)cv;
+	cv_set_call_checker_sv(cv, my_callchecker_sv, ckobj);
+
+UV
+getcallchecker(cv)
+	CV * cv
+    CODE:
+	Perl_call_checker ckfun;
+	SV *ckobj;
+	cv_get_call_checker(cv, &ckfun, &ckobj);
+	RETVAL = PTR2UV(ckfun);
+    OUTPUT:
+	RETVAL
+
+UV
+getcallchecker_sv(cv)
+	CV * cv
+    CODE:
+	Perl_call_checker_sv ckfun;
+	SV *ckobj;
+	cv_get_call_checker_sv(cv, &ckfun, &ckobj);
+	RETVAL = PTR2UV(ckfun);
+    OUTPUT:
+	RETVAL
diff --git a/op.c b/op.c
index c9a1b53..c9f64d9 100644
--- a/op.c
+++ b/op.c
@@ -8135,6 +8135,7 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
 	dVAR;
 	o->op_type = OP_PADCV;
 	o->op_ppaddr = PL_ppaddr[OP_PADCV];
+	o->op_private = (U8)(1 | flags >> 8);
 	return o;
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
@@ -9890,24 +9891,7 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
 	    gv = NULL;
 	} break;
 	case OP_PADCV: {
-	    PADNAME *name = PAD_COMPNAME(rvop->op_targ);
-	    CV *compcv = PL_compcv;
-	    PADOFFSET off = rvop->op_targ;
-	    while (PadnameOUTER(name)) {
-		assert(PARENT_PAD_INDEX(name));
-		compcv = CvOUTSIDE(PL_compcv);
-		name = PadlistNAMESARRAY(CvPADLIST(compcv))
-			[off = PARENT_PAD_INDEX(name)];
-	    }
-	    assert(!PadnameIsOUR(name));
-	    if (!PadnameIsSTATE(name)) {
-		MAGIC * mg = mg_find(name, PERL_MAGIC_proto);
-		assert(mg);
-		assert(mg->mg_obj);
-		cv = (CV *)mg->mg_obj;
-	    }
-	    else cv =
-		    (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
+	    cv = padcv_op_cv(rvop, NULL);
 	    gv = NULL;
 	} break;
 	default: {
@@ -9925,6 +9909,33 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
     }
 }
 
+STATIC CV *
+S_padcv_op_cv(pTHX_ OP *padcvop, SV ** namesv)
+{
+    PADOFFSET off = padcvop->op_targ;
+    PADNAME *name = PAD_COMPNAME(off);
+    CV *compcv = PL_compcv;
+    CV *retcv = NULL;
+    while (PadnameOUTER(name)) {
+	assert(PARENT_PAD_INDEX(name));
+	compcv = CvOUTSIDE(PL_compcv);
+	name = PadlistNAMESARRAY(CvPADLIST(compcv))[off = PARENT_PAD_INDEX(name)];
+    }
+    assert(!PadnameIsOUR(name));
+    if (!PadnameIsSTATE(name)) {
+	MAGIC * mg = mg_find(name, PERL_MAGIC_proto);
+	assert(mg);
+	assert(mg->mg_obj);
+	retcv = (CV *)mg->mg_obj;
+    }
+    else retcv = (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
+    if (namesv)
+	*namesv = sv_2mortal(newSVpvn_utf8(
+	    PadnamePV(name)+1,PadnameLEN(name)-1, PadnameUTF8(name)
+	));
+    return retcv;
+}
+
 /*
 =for apidoc Am|OP *|ck_entersub_args_list|OP *entersubop
 
@@ -9986,6 +9997,29 @@ by the name defined by the I<namegv> parameter.
 OP *
 Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 {
+    PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO;
+    return ck_entersub_args_proto_core(entersubop, (void *)namegv, protosv, TRUE);
+}
+
+/*
+=for apidoc AMpd|OP *|ck_entersub_args_proto_sv|OP *entersubop|SV *namegv|SV *protosv
+
+An alternative interface for L</ck_entersub_args_proto> which takes a C<SV*>
+instead of a C<GV*>.
+
+=cut
+*/
+
+OP *
+Perl_ck_entersub_args_proto_sv(pTHX_ OP *entersubop, SV *namesv, SV *protosv)
+{
+    PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_SV;
+    return ck_entersub_args_proto_core(entersubop, (void *)namesv, protosv, FALSE);
+}
+
+STATIC OP *
+S_ck_entersub_args_proto_core(pTHX_ OP *entersubop, void *namev, SV *protosv, bool name_is_gv)
+{
     STRLEN proto_len;
     const char *proto, *proto_end;
     OP *aop, *prev, *cvop;
@@ -9993,7 +10027,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     I32 arg = 0;
     I32 contextclass = 0;
     const char *e = NULL;
-    PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO;
+    SV * namesv = (name_is_gv ? gv_ename((GV *)namev) : (SV *)namev);
     if (SvTYPE(protosv) == SVt_PVCV ? !SvPOK(protosv) : !SvOK(protosv))
 	Perl_croak(aTHX_ "panic: ck_entersub_args_proto CV with no proto, "
 		   "flags=%lx", (unsigned long) SvFLAGS(protosv));
@@ -10019,7 +10053,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    o3 = aop;
 
 	if (proto >= proto_end)
-	    return too_many_arguments_sv(entersubop, gv_ename(namegv), 0);
+	    return too_many_arguments_sv(entersubop, namesv, 0);
 
 	switch (*proto) {
 	    case ';':
@@ -10046,7 +10080,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 		if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
 		    bad_type_sv(arg,
 			    arg == 1 ? "block or sub {}" : "sub {}",
-			    gv_ename(namegv), 0, o3);
+			    namesv, 0, o3);
 		break;
 	    case '*':
 		/* '*' allows any scalar type, including bareword */
@@ -10133,7 +10167,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				    )) goto wrapref;
 			    bad_type_sv(arg, Perl_form(aTHX_ "one of %.*s",
 					(int)(end - p), p),
-				    gv_ename(namegv), 0, o3);
+				    namesv, 0, o3);
 			} else
 			    goto oops;
 			break;
@@ -10141,13 +10175,13 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 			if (o3->op_type == OP_RV2GV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "symbol", gv_ename(namegv), 0, o3);
+			    bad_type_sv(arg, "symbol", namesv, 0, o3);
 			break;
 		    case '&':
 			if (o3->op_type == OP_ENTERSUB)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "subroutine entry", gv_ename(namegv), 0,
+			    bad_type_sv(arg, "subroutine entry", namesv, 0,
 				    o3);
 			break;
 		    case '$':
@@ -10163,7 +10197,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				    OP_READ,  /* not entersub */
 				    OP_LVALUE_NO_CROAK
 			       )) goto wrapref;
-			    bad_type_sv(arg, "scalar", gv_ename(namegv), 0, o3);
+			    bad_type_sv(arg, "scalar", namesv, 0, o3);
 			}
 			break;
 		    case '@':
@@ -10171,14 +10205,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				o3->op_type == OP_PADAV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "array", gv_ename(namegv), 0, o3);
+			    bad_type_sv(arg, "array", namesv, 0, o3);
 			break;
 		    case '%':
 			if (o3->op_type == OP_RV2HV ||
 				o3->op_type == OP_PADHV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "hash", gv_ename(namegv), 0, o3);
+			    bad_type_sv(arg, "hash", namesv, 0, o3);
 			break;
 		    wrapref:
 			{
@@ -10204,10 +10238,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 		continue;
 	    default:
 	    oops: {
-                SV* const tmpsv = sv_newmortal();
-                gv_efullname3(tmpsv, namegv, NULL);
 		Perl_croak(aTHX_ "Malformed prototype for %"SVf": %"SVf,
-			SVfARG(tmpsv), SVfARG(protosv));
+			SVfARG(namesv), SVfARG(protosv));
             }
 	}
 
@@ -10223,7 +10255,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     }
     if (!optional && proto_end > proto &&
 	(*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_'))
-	return too_few_arguments_sv(entersubop, gv_ename(namegv), 0);
+	return too_few_arguments_sv(entersubop, namesv, 0);
     return entersubop;
 }
 
@@ -10265,6 +10297,27 @@ Perl_ck_entersub_args_proto_or_list(pTHX_ OP *entersubop,
 	return ck_entersub_args_list(entersubop);
 }
 
+/*
+=for apidoc AMpd|OP *|ck_entersub_args_proto_or_list_sv|OP *entersubop|SV *namesv|SV *protosv
+
+Equivalent to L</ck_entersub_args_proto_or_list>, but passes the name of
+the function as an C<SV*> rather than a C<GV*>, since not all functions
+have a C<GV> to store a name.
+
+=cut
+*/
+
+OP *
+Perl_ck_entersub_args_proto_or_list_sv(pTHX_ OP *entersubop,
+	SV *namesv, SV *protosv)
+{
+    PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_OR_LIST_SV;
+    if (SvTYPE(protosv) == SVt_PVCV ? SvPOK(protosv) : SvOK(protosv))
+	return ck_entersub_args_proto_sv(entersubop, namesv, protosv);
+    else
+	return ck_entersub_args_list(entersubop);
+}
+
 OP *
 Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 {
@@ -10385,6 +10438,26 @@ and the SV parameter is I<cv> itself.  This implements standard
 prototype processing.  It can be changed, for a particular subroutine,
 by L</cv_set_call_checker>.
 
+See L</cv_get_call_checker_sv> for an alternative version which uses
+I<Perl_call_checker_sv> instead of I<Perl_call_checker>.
+
+There are two differences between the functions:
+
+=over 4
+
+=item *
+
+The L</cv_get_call_checker_sv> returns a function which takes
+an C<SV*> instead of a C<GV*> (set by L</cv_get_call_checker_sv>
+
+=item *
+
+L</cv_get_call_checker> will croak if the call checker is not the
+default and is not the right type; L</cv_get_call_checker_sv>
+will set the function pointer to NULL instead.
+
+=back
+
 =cut
 */
 
@@ -10394,9 +10467,20 @@ Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p)
     MAGIC *callmg;
     PERL_ARGS_ASSERT_CV_GET_CALL_CHECKER;
     callmg = SvMAGICAL((SV*)cv) ? mg_find((SV*)cv, PERL_MAGIC_checkcall) : NULL;
-    if (callmg) {
+    if (callmg && callmg->mg_private == 0) {
 	*ckfun_p = DPTR2FPTR(Perl_call_checker, callmg->mg_ptr);
 	*ckobj_p = callmg->mg_obj;
+    } else if (callmg && callmg->mg_private == 1) {
+	/* If it's still set to the default, return the origianl default call checker */
+	if (callmg->mg_ptr == (char *)Perl_ck_entersub_args_proto_or_list_sv) {
+	    *ckfun_p = Perl_ck_entersub_args_proto_or_list;
+	    *ckobj_p = (SV*)cv;
+	} else {
+	    SV *xpt = Perl_newSVpvf(aTHX_
+	              "cv_get_call_checker cannot return a value set by cv_get_call_checker_sv");
+	    Perl_sv_2mortal(aTHX_ xpt);
+	    Perl_croak_sv(aTHX_ xpt);
+	}
     } else {
 	*ckfun_p = Perl_ck_entersub_args_proto_or_list;
 	*ckobj_p = (SV*)cv;
@@ -10404,6 +10488,65 @@ Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p)
 }
 
 /*
+=for apidoc AMpd|void|cv_get_call_checker_sv|CV *cv|Perl_call_checker_sv *ckfun_p|SV **ckobj_p
+
+See L</cv_get_call_checker> for details.
+
+=cut
+*/
+
+void
+Perl_cv_get_call_checker_sv(pTHX_ CV *cv, Perl_call_checker_sv *ckfun_p, SV **ckobj_p)
+{
+    MAGIC *callmg;
+    PERL_ARGS_ASSERT_CV_GET_CALL_CHECKER_SV;
+    callmg = SvMAGICAL((SV*)cv) ? mg_find((SV*)cv, PERL_MAGIC_checkcall) : NULL;
+    if (callmg && callmg->mg_private == 1) {
+	*ckfun_p = DPTR2FPTR(Perl_call_checker_sv, callmg->mg_ptr);
+	*ckobj_p = callmg->mg_obj;
+    } else if (callmg && callmg->mg_private == 0) {
+	*ckfun_p = NULL;
+	*ckobj_p = callmg->mg_obj;
+    } else {
+	*ckfun_p = Perl_ck_entersub_args_proto_or_list_sv;
+	*ckobj_p = (SV*)cv;
+    }
+}
+
+/* Utility function for common code between cv_set_call_checker(|_sv) */
+
+STATIC MAGIC *
+S_cv_set_call_checker_core(pTHX_ CV *cv, void *ckfun, SV *ckobj)
+{
+    PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER_CORE;
+    if (ckfun == Perl_ck_entersub_args_proto_or_list && ckobj == (SV*)cv) {
+	if (SvMAGICAL((SV*)cv))
+	    mg_free_type((SV*)cv, PERL_MAGIC_checkcall);
+    } else if (ckfun == Perl_ck_entersub_args_proto_or_list_sv && ckobj == (SV*)cv) {
+	/* If this version is desired, cv_get_call_checker will return it */
+        if (SvMAGICAL((SV*)cv))
+	    mg_free_type((SV*)cv, PERL_MAGIC_checkcall);
+    } else {
+	MAGIC *callmg;
+	sv_magic((SV*)cv, &PL_sv_undef, PERL_MAGIC_checkcall, NULL, 0);
+	callmg = mg_find((SV*)cv, PERL_MAGIC_checkcall);
+	if (callmg->mg_flags & MGf_REFCOUNTED) {
+	    SvREFCNT_dec(callmg->mg_obj);
+	    callmg->mg_flags &= ~MGf_REFCOUNTED;
+	}
+	callmg->mg_ptr = FPTR2DPTR(char *, ckfun);
+	callmg->mg_obj = ckobj;
+	if (ckobj != (SV*)cv) {
+	    SvREFCNT_inc_simple_void_NN(ckobj);
+	    callmg->mg_flags |= MGf_REFCOUNTED;
+	}
+	callmg->mg_flags |= MGf_COPY;
+	return callmg;
+    }
+    return NULL;
+}
+
+/*
 =for apidoc Am|void|cv_set_call_checker|CV *cv|Perl_call_checker ckfun|SV *ckobj
 
 Sets the function that will be used to fix up a call to I<cv>.
@@ -10427,6 +10570,16 @@ such as to a call to a different subroutine or to a method call.
 The current setting for a particular CV can be retrieved by
 L</cv_get_call_checker>.
 
+See L</cv_set_call_checker_sv> for an alternative version which uses
+I<Perl_call_checker_sv> instead of I<Perl_call_checker>.  If
+L</cv_set_call_checker_sv> is used to set the call checker, 
+L</cv_get_call_checker_sv> must be used to retrieve it.  Likewise,
+if L</cv_set_call_checker> is used to set the call checker,
+L</cv_get_call_checker> must be used to retrieve it.  The sole
+exception to this rule is the default call checker; if the call checker
+is never set, or is set back to the default, each get call checker
+functions will return the appropriate version.
+
 =cut
 */
 
@@ -10434,25 +10587,26 @@ void
 Perl_cv_set_call_checker(pTHX_ CV *cv, Perl_call_checker ckfun, SV *ckobj)
 {
     PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER;
-    if (ckfun == Perl_ck_entersub_args_proto_or_list && ckobj == (SV*)cv) {
-	if (SvMAGICAL((SV*)cv))
-	    mg_free_type((SV*)cv, PERL_MAGIC_checkcall);
-    } else {
-	MAGIC *callmg;
-	sv_magic((SV*)cv, &PL_sv_undef, PERL_MAGIC_checkcall, NULL, 0);
-	callmg = mg_find((SV*)cv, PERL_MAGIC_checkcall);
-	if (callmg->mg_flags & MGf_REFCOUNTED) {
-	    SvREFCNT_dec(callmg->mg_obj);
-	    callmg->mg_flags &= ~MGf_REFCOUNTED;
-	}
-	callmg->mg_ptr = FPTR2DPTR(char *, ckfun);
-	callmg->mg_obj = ckobj;
-	if (ckobj != (SV*)cv) {
-	    SvREFCNT_inc_simple_void_NN(ckobj);
-	    callmg->mg_flags |= MGf_REFCOUNTED;
-	}
-	callmg->mg_flags |= MGf_COPY;
-    }
+    cv_set_call_checker_core(cv, (void *)ckfun, ckobj);
+}
+
+/*
+=for apidoc Am|void|cv_set_call_checker_sv|CV *cv|Perl_call_checker_sv *ckfun_p|SV **ckobj_p
+
+See L</cv_set_call_checker> for more details.  The difference between the two versions is
+limited to the I<Perl_call_checker_sv> function taking a SV * instead of a GV * for the name
+of the function, since not all functions will have a GV.
+
+=cut
+*/
+
+void
+Perl_cv_set_call_checker_sv(pTHX_ CV *cv, Perl_call_checker_sv ckfun, SV *ckobj)
+{
+    PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER_SV;
+    MAGIC * callmg = cv_set_call_checker_core(cv, (void *)ckfun, ckobj);
+    if (callmg)
+	callmg->mg_private = 1;
 }
 
 OP *
@@ -10461,6 +10615,7 @@ Perl_ck_subr(pTHX_ OP *o)
     OP *aop, *cvop;
     CV *cv;
     GV *namegv;
+    SV *namesv;
 
     PERL_ARGS_ASSERT_CK_SUBR;
 
@@ -10469,8 +10624,14 @@ Perl_ck_subr(pTHX_ OP *o)
 	aop = cUNOPx(aop)->op_first;
     aop = aop->op_sibling;
     for (cvop = aop; cvop->op_sibling; cvop = cvop->op_sibling) ;
-    cv = rv2cv_op_cv(cvop, RV2CVOPCV_MARK_EARLY);
-    namegv = cv ? (GV*)rv2cv_op_cv(cvop, RV2CVOPCV_RETURN_NAME_GV) : NULL;
+    if (cvop->op_type == OP_PADCV && !(cvop->op_private & OPpENTERSUB_AMPER)) {
+	cv = padcv_op_cv(cvop, &namesv);
+	namegv = NULL;
+    } else {
+	cv = rv2cv_op_cv(cvop, RV2CVOPCV_MARK_EARLY);
+	namegv = cv ? (GV*)rv2cv_op_cv(cvop, RV2CVOPCV_RETURN_NAME_GV) : NULL;
+	namesv = namegv ? gv_ename(namegv) : sv_2mortal(newSVpvs("__ANON__::__ANON__"));
+    }
 
     o->op_private &= ~1;
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -10496,20 +10657,25 @@ Perl_ck_subr(pTHX_ OP *o)
 	Perl_call_checker ckfun;
 	SV *ckobj;
 	cv_get_call_checker(cv, &ckfun, &ckobj);
-	if (!namegv) { /* expletive! */
-	    /* XXX The call checker API is public.  And it guarantees that
-		   a GV will be provided with the right name.  So we have
-		   to create a GV.  But it is still not correct, as its
-		   stringification will include the package.  What we
-		   really need is a new call checker API that accepts a
-		   GV or string (or GV or CV). */
-	    HEK * const hek = CvNAME_HEK(cv);
-	    assert(hek);
-	    namegv = (GV *)sv_newmortal();
-	    gv_init_pvn(namegv, PL_curstash, HEK_KEY(hek), HEK_LEN(hek),
-			SVf_UTF8 * !!HEK_UTF8(hek));
-	}
-	return ckfun(aTHX_ o, namegv, ckobj);
+	/* If a GV* call checker is in place, use it, otherwise use the SV* style */
+	if (ckfun != Perl_ck_entersub_args_proto_or_list) {
+	    if (!namegv) { /* expletive! */
+		/* XXX The call checker API is public.  And it guarantees that
+		       a GV will be provided with the right name.  So we have
+		       to create a GV.  But it is still not correct, as its
+		       stringification will include the package. */
+		HEK * const hek = CvNAME_HEK(cv);
+		assert(hek);
+		namegv = (GV *)sv_newmortal();
+		gv_init_pvn(namegv, PL_curstash, HEK_KEY(hek), HEK_LEN(hek),
+			    SVf_UTF8 * !!HEK_UTF8(hek));
+	    }
+	    return ckfun(aTHX_ o, namegv, ckobj);
+	} else {
+	    Perl_call_checker_sv ckfun;
+	    cv_get_call_checker_sv(cv, &ckfun, &ckobj);
+	    return ckfun(aTHX_ o, namesv, ckobj);
+	}
     }
 }
 
diff --git a/proto.h b/proto.h
index 18f46cc..a323100 100644
--- a/proto.h
+++ b/proto.h
@@ -418,6 +418,20 @@ PERL_CALLCONV OP*	Perl_ck_entersub_args_proto_or_list(pTHX_ OP *entersubop, GV *
 #define PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_OR_LIST	\
 	assert(entersubop); assert(namegv); assert(protosv)
 
+PERL_CALLCONV OP*	Perl_ck_entersub_args_proto_or_list_sv(pTHX_ OP *entersubop, SV *namesv, SV *protosv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_OR_LIST_SV	\
+	assert(entersubop); assert(namesv); assert(protosv)
+
+PERL_CALLCONV OP*	Perl_ck_entersub_args_proto_sv(pTHX_ OP *entersubop, SV *namesv, SV *protosv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_SV	\
+	assert(entersubop); assert(namesv); assert(protosv)
+
 PERL_CALLCONV OP *	Perl_ck_eof(pTHX_ OP *o)
 			__attribute__warn_unused_result__
 			__attribute__nonnull__(pTHX_1);
@@ -758,6 +772,13 @@ PERL_CALLCONV void	Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckf
 #define PERL_ARGS_ASSERT_CV_GET_CALL_CHECKER	\
 	assert(cv); assert(ckfun_p); assert(ckobj_p)
 
+PERL_CALLCONV void	Perl_cv_get_call_checker_sv(pTHX_ CV *cv, Perl_call_checker_sv *ckfun_p, SV **ckobj_p)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CV_GET_CALL_CHECKER_SV	\
+	assert(cv); assert(ckfun_p); assert(ckobj_p)
+
 PERL_CALLCONV void	Perl_cv_set_call_checker(pTHX_ CV *cv, Perl_call_checker ckfun, SV *ckobj)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
@@ -765,6 +786,13 @@ PERL_CALLCONV void	Perl_cv_set_call_checker(pTHX_ CV *cv, Perl_call_checker ckfu
 #define PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER	\
 	assert(cv); assert(ckfun); assert(ckobj)
 
+PERL_CALLCONV void	Perl_cv_set_call_checker_sv(pTHX_ CV *cv, Perl_call_checker_sv ckfun, SV *ckobj)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER_SV	\
+	assert(cv); assert(ckfun); assert(ckobj)
+
 PERL_CALLCONV void	Perl_cv_undef(pTHX_ CV* cv)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_CV_UNDEF	\
@@ -5863,11 +5891,25 @@ STATIC void	S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, con
 #define PERL_ARGS_ASSERT_BAD_TYPE_SV	\
 	assert(t); assert(namesv); assert(kid)
 
+STATIC OP*	S_ck_entersub_args_proto_core(pTHX_ OP *entersubop, void *namev, SV *protosv, bool name_is_gv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO_CORE	\
+	assert(entersubop); assert(namev); assert(protosv)
+
 STATIC void	S_cop_free(pTHX_ COP *cop)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_COP_FREE	\
 	assert(cop)
 
+STATIC MAGIC*	S_cv_set_call_checker_core(pTHX_ CV *cv, void *ckfun, SV *ckobj)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CV_SET_CALL_CHECKER_CORE	\
+	assert(cv); assert(ckfun); assert(ckobj)
+
 STATIC OP *	S_dup_attrlist(pTHX_ OP *o)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_DUP_ATTRLIST	\
@@ -5962,6 +6004,11 @@ PERL_STATIC_INLINE OP*	S_op_std_init(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_OP_STD_INIT	\
 	assert(o)
 
+STATIC CV*	S_padcv_op_cv(pTHX_ OP *padcvop, SV ** namesv)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADCV_OP_CV	\
+	assert(padcvop)
+
 STATIC OP*	S_pmtrans(pTHX_ OP* o, OP* expr, OP* repl)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t
index 86c7e26..5f715fd 100644
--- a/t/cmd/lexsub.t
+++ b/t/cmd/lexsub.t
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 128;
+plan 129;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -86,6 +86,8 @@ sub bar::c { 43 }
 {
   our sub e ($);
   is prototype "::e", '$', 'our sub with proto';
+  eval "e(1,2);";
+  like $@, qq 'Too many arguments for main::e at', 'prototypes honored with parens';
 }
 {
   our sub if() { 42 }
@@ -415,12 +417,12 @@ sub mc { 43 }
 }
 package main;
 {
-  my sub me ($);
+  sub me ($);
   is prototype eval{\&me}, '$', 'my sub with proto';
-  is prototype "me", undef, 'prototype "..." ignores my subs';
+  is prototype "me", '$', 'prototype "..." ignores my subs';
 }
 {
-  my sub if() { 44 }
+  my sub if { 44 }
   my $x = if if if;
   is $x, 44, 'my subs override all keywords';
   package bar;
@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 15, 2014

From @cpansprout

On Fri Sep 12 00​:26​:55 2014, sprout wrote​:

I do think it is over-engineered and that cv_set_call_checker_flags is
a better solution.

BTW, have you seen what I am doing on the sprout/cvgv branch? It is
almost ready for merging, but not quite. Maybe a few more days. In
any case, ‘sub foo{} foo() \&foo’ no longer has to create a *foo glob,
saving memory.

It is now in blead as merge commit f9d9e96. The new call checker API is in commit aa38f4b, and cv_name was added in c5569a5, fb09404 and b5e03f4.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 15, 2014

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

@p5pRT p5pRT closed this Sep 15, 2014
@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 16, 2014

From @bulk88

On Mon Sep 15 08​:31​:16 2014, sprout wrote​:

It is now in blead as merge commit f9d9e96. The new call checker
API is in commit aa38f4b, and cv_name was added in c5569a5,
fb09404 and b5e03f4.

Bug needs to be reopened.

Visual C 2003 is complaining of new warnings because of these commits.

  cl -c -nologo -GF -W3 -I..\lib\CORE -I.\include -I. -I.. -DWIN32 -D_CONSOLE -DNO_STRICT -DPERLDLL -DPERL_CORE -O1 -MD -Zi -DNDEBUG -G7 -GL -DPERL_EXTERNAL_GLOB -DPERL_IS_MINIPERL -Fo.\mini\op.obj ..\op.c
op.c
op.c(7897) : warning C4146​: unary minus operator applied to unsigned type, result still unsigned
op.c(7958) : warning C4146​: unary minus operator applied to unsigned type, result still unsigned
op.c(10751) : warning C4098​: 'Perl_cv_get_call_checker' : 'void' function returning a value
op.c(10825) : warning C4244​: '=' : conversion from 'U32' to 'U8', possible loss of data

line 7897 7958 comes from Sept 15 2014 commit http​://perl5.git.perl.org/perl.git/commit/2eaf799e74b14dc77b90d5484a3fd4ceac12b46a

line 10751 comes from Sept 15 2014 commit
http​://perl5.git.perl.org/perl.git/commit/9c98a81fd30898ed03895d1368f4f9f2761b69da

line 10825 comes from Sept 15 2014 commit
http​://perl5.git.perl.org/perl.git/commit/aa38f4b16ec84f790a5473b0ff1ffe264bd93f5a

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 16, 2014

From @cpansprout

On Mon Sep 15 17​:43​:35 2014, bulk88 wrote​:

On Mon Sep 15 08​:31​:16 2014, sprout wrote​:

It is now in blead as merge commit f9d9e96. The new call checker
API is in commit aa38f4b, and cv_name was added in c5569a5,
fb09404 and b5e03f4.

Bug needs to be reopened.

Visual C 2003 is complaining of new warnings because of these commits.

cl -c -nologo -GF -W3 -I..\lib\CORE -I.\include -I. -I.. -DWIN32
-D_CONSOLE -DNO_STRICT -DPERLDLL -DPERL_CORE -O1 -MD -Zi -DNDEBUG
-G7 -GL -DPERL_EXTERNAL_GLOB -DPERL_IS_MINIPERL -Fo.\mini\op.obj
..\op.c
op.c
op.c(7897) : warning C4146​: unary minus operator applied to unsigned
type, result still unsigned
op.c(7958) : warning C4146​: unary minus operator applied to unsigned
type, result still unsigned
op.c(10751) : warning C4098​: 'Perl_cv_get_call_checker' : 'void'
function returning a value
op.c(10825) : warning C4244​: '=' : conversion from 'U32' to 'U8',
possible loss of data

Thank you.

line 7897 7958 comes from Sept 15 2014 commit
http​://perl5.git.perl.org/perl.git/commit/2eaf799e74b14dc77b90d5484a3fd4ceac12b46a

Oops.

line 10751 comes from Sept 15 2014 commit
http​://perl5.git.perl.org/perl.git/commit/9c98a81fd30898ed03895d1368f4f9f2761b69da

Oops.

line 10825 comes from Sept 15 2014 commit
http​://perl5.git.perl.org/perl.git/commit/aa38f4b16ec84f790a5473b0ff1ffe264bd93f5a

Dumb compiler, but whatever.

I have fixed, or at least hope I have fixed, these in 53d0634.

--

Father Chrysostomos

@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
1 participant
You can’t perform that action at this time.