Skip to content

Commit

Permalink
Rename G_ARRAY to G_LIST; provide back-compat when not(PERL_CORE)
Browse files Browse the repository at this point in the history
  • Loading branch information
@leonerd
leonerd committed Jun 1, 2021
1 parent 499aa13 commit 23abb36
Show file tree
Hide file tree
Showing 28 changed files with 137 additions and 131 deletions.
13 changes: 9 additions & 4 deletions cop.h
View file
Expand Up @@ -1094,10 +1094,15 @@ struct context {

#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))

#define G_SCALAR 2
#define G_ARRAY 3
#define G_VOID 1
#define G_WANT 3
#define G_SCALAR 2
#define G_LIST 3
#define G_VOID 1
#define G_WANT 3

#ifndef PERL_CORE
/* name prior to 5.31.1 */
# define G_ARRAY G_LIST
#endif

/* extra flags for Perl_call_* routines */
#define G_DISCARD 0x4 /* Call FREETMPS.
Expand Down
2 changes: 1 addition & 1 deletion ext/File-Glob/Glob.pm
View file
Expand Up @@ -35,7 +35,7 @@ $EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}];

@EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');

$VERSION = '1.33';
$VERSION = '1.34';

sub import {
require Exporter;
Expand Down
8 changes: 4 additions & 4 deletions ext/File-Glob/Glob.xs
View file
Expand Up @@ -108,7 +108,7 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, boo
}

if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")) {
if (gimme != G_ARRAY)
if (gimme != G_LIST)
PUSHs(&PL_sv_undef);
PUTBACK;
return;
Expand All @@ -120,7 +120,7 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, boo
}

/* chuck it all out, quick or slow */
if (gimme == G_ARRAY) {
if (gimme == G_LIST) {
if (!on_stack && AvFILLp(entries) + 1) {
EXTEND(SP, AvFILLp(entries)+1);
Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
Expand Down Expand Up @@ -286,7 +286,7 @@ csh_glob(pTHX_ AV *entries, const char *pat, STRLEN len, bool is_utf8)
dMARK;
dORIGMARK;
/* short-circuit here for a fairly common case */
if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
if (!patav && gimme == G_LIST) { PUTBACK; return TRUE; }
while (++MARK <= SP)
av_push(entries, SvREFCNT_inc_simple_NN(*MARK));

Expand Down Expand Up @@ -323,7 +323,7 @@ doglob_iter_wrapper(pTHX_ AV *entries, const char *pattern, STRLEN len, bool is_
{
dMARK;
dORIGMARK;
if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
if (GIMME_V == G_LIST) { PUTBACK; return TRUE; }
sv_upgrade((SV *)entries, SVt_PVAV);
while (++MARK <= SP)
av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
Expand Down
2 changes: 1 addition & 1 deletion ext/Opcode/Opcode.pm
View file
Expand Up @@ -6,7 +6,7 @@ use strict;

our($VERSION, @ISA, @EXPORT_OK);

$VERSION = "1.50";
$VERSION = "1.51";

use Carp;
use Exporter ();
Expand Down
2 changes: 1 addition & 1 deletion ext/Opcode/Opcode.xs
View file
Expand Up @@ -536,7 +536,7 @@ CODE:
void
opcodes()
PPCODE:
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
croak("opcodes in list context not yet implemented"); /* XXX */
}
else {
Expand Down
12 changes: 6 additions & 6 deletions ext/POSIX/POSIX.xs
View file
Expand Up @@ -3505,7 +3505,7 @@ strtod(str)
num = strtod(str, &unparsed);
RESTORE_LC_NUMERIC();
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
Expand All @@ -3527,7 +3527,7 @@ strtold(str)
num = strtold(str, &unparsed);
RESTORE_LC_NUMERIC();
PUSHs(sv_2mortal(newSVnv(num)));
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
Expand All @@ -3553,7 +3553,7 @@ strtol(str, base = 0)
else
#endif
PUSHs(sv_2mortal(newSViv((IV)num)));
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
Expand All @@ -3563,7 +3563,7 @@ strtol(str, base = 0)
} else {
SETERRNO(EINVAL, LIB_INVARG);
PUSHs(&PL_sv_undef);
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
}
Expand All @@ -3587,7 +3587,7 @@ strtoul(str, base = 0)
else
#endif
PUSHs(sv_2mortal(newSViv((IV)num)));
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
Expand All @@ -3597,7 +3597,7 @@ strtoul(str, base = 0)
} else {
SETERRNO(EINVAL, LIB_INVARG);
PUSHs(&PL_sv_undef);
if (GIMME_V == G_ARRAY) {
if (GIMME_V == G_LIST) {
EXTEND(SP, 1);
PUSHs(&PL_sv_undef);
}
Expand Down
2 changes: 1 addition & 1 deletion ext/POSIX/lib/POSIX.pm
View file
Expand Up @@ -4,7 +4,7 @@ use warnings;

our ($AUTOLOAD, %SIGRT);

our $VERSION = '1.97';
our $VERSION = '1.98';

require XSLoader;

Expand Down
4 changes: 2 additions & 2 deletions ext/XS-APItest/APItest.pm
View file
Expand Up @@ -5,7 +5,7 @@ use strict;
use warnings;
use Carp;

our $VERSION = '1.16';
our $VERSION = '1.17';

require XSLoader;

Expand Down Expand Up @@ -226,7 +226,7 @@ arg is passed as the args to the called function. They return whatever
the C function itself pushed onto the stack, plus the return value from
the function; for example
call_sv( sub { @_, 'c' }, G_ARRAY, 'a', 'b');
call_sv( sub { @_, 'c' }, G_LIST, 'a', 'b');
# returns 'a', 'b', 'c', 3
call_sv( sub { @_ }, G_SCALAR, 'a', 'b');
# returns 'b', 1
Expand Down
4 changes: 2 additions & 2 deletions ext/XS-APItest/APItest.xs
View file
Expand Up @@ -3202,7 +3202,7 @@ test_op_contextualize()
op_free(o);
o = newSVOP(OP_CONST, 0, newSViv(0));
o->op_flags &= ~OPf_WANT;
o = op_contextualize(o, G_ARRAY);
o = op_contextualize(o, G_LIST);
if (o->op_type != OP_CONST ||
(o->op_flags & OPf_WANT) != OPf_WANT_LIST)
croak_fail();
Expand Down Expand Up @@ -3947,7 +3947,7 @@ CODE:
av_push(av, SvREFCNT_inc(TOPs));
break;

case G_ARRAY:
case G_LIST:
for (p = PL_stack_base + 1; p <= SP; p++)
av_push(av, SvREFCNT_inc(*p));
break;
Expand Down
4 changes: 2 additions & 2 deletions ext/XS-APItest/Makefile.PL
View file
Expand Up @@ -22,15 +22,15 @@ WriteMakefile(

my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
G_SCALAR G_LIST G_VOID G_DISCARD G_EVAL G_NOARGS
G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL G_RETHROW
GV_NOADD_NOINIT
IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
IS_NUMBER_NAN IS_NUMBER_TRAILING PERL_SCAN_TRAILING
PERL_LOADMOD_DENY PERL_LOADMOD_NOIMPORT PERL_LOADMOD_IMPORT_OPS
),
{name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]});
{name=>"G_WANT", default=>["IV", "G_LIST|G_VOID"]});

open my $fh, '<', '../../overload.h' or die "Can't open ../../overload.h: $!";
while (<$fh>) {
Expand Down
14 changes: 7 additions & 7 deletions ext/XS-APItest/t/call.t
View file
Expand Up @@ -60,8 +60,8 @@ for my $test (
[ G_VOID, [ qw(a p q) ], [ 0 ], '3 args, G_VOID' ],
[ G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ],
[ G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ],
[ G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ],
[ G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ],
[ G_LIST, [ ], [ qw(x 1) ], '0 args, G_LIST' ],
[ G_LIST, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_LIST' ],
[ G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ],
[ G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ],
)
Expand Down Expand Up @@ -89,7 +89,7 @@ for my $test (
ok(eq_array( [ call_method('meth', $flags, $obj, @$args) ], $expected),
"$description call_method('meth')");

my $returnval = ((($flags & G_WANT) == G_ARRAY) || ($flags & G_DISCARD))
my $returnval = ((($flags & G_WANT) == G_LIST) || ($flags & G_DISCARD))
? [0] : [ undef, 1 ];
for my $keep (0, G_KEEPERR) {
my $desc = $description . ($keep ? ' G_KEEPERR' : '');
Expand Down Expand Up @@ -313,12 +313,12 @@ for my $fn_type (qw(eval_pv eval_sv call_sv)) {
}
}
elsif ($fn_type eq 'eval_sv') {
$desc = "eval_sv('$code', G_ARRAY|$keep_desc)";
@ret = eval_sv($code, G_ARRAY|$keep);
$desc = "eval_sv('$code', G_LIST|$keep_desc)";
@ret = eval_sv($code, G_LIST|$keep);
}
elsif ($fn_type eq 'call_sv') {
$desc = "call_sv('$code', G_EVAL|G_ARRAY|$keep_desc)";
@ret = call_sv($code, G_EVAL|G_ARRAY|$keep);
$desc = "call_sv('$code', G_EVAL|G_LIST|$keep_desc)";
@ret = call_sv($code, G_EVAL|G_LIST|$keep);
}
is(scalar @ret, ($expect_success && $fn_type ne 'eval_pv') ? 2 : 1,
"$desc - number of returned args");
Expand Down
6 changes: 3 additions & 3 deletions ext/XS-APItest/t/multicall.t
View file
Expand Up @@ -75,7 +75,7 @@ use XS::APItest;
{
package Ret;

use XS::APItest qw(multicall_return G_VOID G_SCALAR G_ARRAY);
use XS::APItest qw(multicall_return G_VOID G_SCALAR G_LIST);

# Helper function for the block that follows:
# check that @$got matches what would be expected if a function returned
Expand All @@ -93,11 +93,11 @@ use XS::APItest;
"G_SCALAR: $desc: correct arg");
}
else {
::is (join('-',@$got), join('-', @$args), "G_ARRAY: $desc");
::is (join('-',@$got), join('-', @$args), "G_LIST: $desc");
}
}

for my $gimme (G_VOID, G_SCALAR, G_ARRAY) {
for my $gimme (G_VOID, G_SCALAR, G_LIST) {
my @a;

# zero args
Expand Down
4 changes: 2 additions & 2 deletions gv.c
View file
Expand Up @@ -3630,7 +3630,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
case G_VOID:
myop.op_flags |= OPf_WANT_VOID;
break;
case G_ARRAY:
case G_LIST:
if (flags & AMGf_want_list) {
myop.op_flags |= OPf_WANT_LIST;
break;
Expand Down Expand Up @@ -3679,7 +3679,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
res = &PL_sv_undef;
SP = PL_stack_base + oldmark;
break;
case G_ARRAY:
case G_LIST:
if (flags & AMGf_want_list) {
res = sv_2mortal((SV *)newAV());
av_extend((AV *)res, nret);
Expand Down
8 changes: 4 additions & 4 deletions op.c
View file
Expand Up @@ -1663,7 +1663,7 @@ Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
=for apidoc op_contextualize

Applies a syntactic context to an op tree representing an expression.
C<o> is the op tree, and C<context> must be C<G_SCALAR>, C<G_ARRAY>,
C<o> is the op tree, and C<context> must be C<G_SCALAR>, C<G_LIST>,
or C<G_VOID> to specify the context to apply. The modified op tree
is returned.

Expand All @@ -1676,7 +1676,7 @@ Perl_op_contextualize(pTHX_ OP *o, I32 context)
PERL_ARGS_ASSERT_OP_CONTEXTUALIZE;
switch (context) {
case G_SCALAR: return scalar(o);
case G_ARRAY: return list(o);
case G_LIST: return list(o);
case G_VOID: return scalarvoid(o);
default:
Perl_croak(aTHX_ "panic: op_contextualize bad context %ld",
Expand Down Expand Up @@ -5843,7 +5843,7 @@ Perl_newPROG(pTHX_ OP *o)

if ((cx->blk_gimme & G_WANT) == G_VOID)
scalarvoid(PL_eval_root);
else if ((cx->blk_gimme & G_WANT) == G_ARRAY)
else if ((cx->blk_gimme & G_WANT) == G_LIST)
list(PL_eval_root);
else
scalar(PL_eval_root);
Expand Down Expand Up @@ -18650,7 +18650,7 @@ const_av_xsub(pTHX_ CV* cv)
#endif
if (SvRMAGICAL(av))
Perl_croak(aTHX_ "Magical list constants are not supported");
if (GIMME_V != G_ARRAY) {
if (GIMME_V != G_LIST) {
EXTEND(SP, 1);
ST(0) = sv_2mortal(newSViv((IV)AvFILLp(av)+1));
XSRETURN(1);
Expand Down
6 changes: 3 additions & 3 deletions op.h
View file
Expand Up @@ -74,12 +74,12 @@ typedef PERL_BITFIELD16 Optype;
=for apidoc Amn|U32|GIMME_V
The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_VOID>,
C<G_SCALAR> or C<G_ARRAY> for void, scalar or list context,
C<G_SCALAR> or C<G_LIST> for void, scalar or list context,
respectively. See L<perlcall> for a usage example.
=for apidoc AmnD|U32|GIMME
A backward-compatible version of C<GIMME_V> which can only return
C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>.
C<G_SCALAR> or C<G_LIST>; in a void context, it returns C<G_SCALAR>.
Deprecated. Use C<GIMME_V> instead.
=cut
Expand Down Expand Up @@ -160,7 +160,7 @@ Deprecated. Use C<GIMME_V> instead.
# define GIMME \
(PL_op->op_flags & OPf_WANT \
? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \
? G_ARRAY \
? G_LIST \
: G_SCALAR) \
: dowantarray())
#endif
Expand Down
2 changes: 1 addition & 1 deletion os2/os2.c
View file
Expand Up @@ -1990,7 +1990,7 @@ XS(XS_OS2_perfSysCall)
if (total) {
int i,j;

if (GIMME_V != G_ARRAY) {
if (GIMME_V != G_LIST) {
PUSHn(u[0][0]); /* Total ticks on the first processor */
XSRETURN(1);
}
Expand Down
4 changes: 2 additions & 2 deletions perl.c
View file
Expand Up @@ -3100,7 +3100,7 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
goto redo_body;
}
PL_stack_sp = PL_stack_base + oldmark;
if ((flags & G_WANT) == G_ARRAY)
if ((flags & G_WANT) == G_LIST)
retval = 0;
else {
retval = 1;
Expand Down Expand Up @@ -3227,7 +3227,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
}

PL_stack_sp = PL_stack_base + oldmark;
if ((flags & G_WANT) == G_ARRAY)
if ((flags & G_WANT) == G_LIST)
retval = 0;
else {
retval = 1;
Expand Down

0 comments on commit 23abb36

Please sign in to comment.