Skip to content

eval_sv: add a G_USEHINTS flag #21421

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.

Sign up for GitHub

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

Merged
merged 2 commits into from
Aug 31, 2023
Merged

eval_sv: add a G_USEHINTS flag #21421

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
e4a57a5
features: populate cop_features from a hints hash the hard way
tonycoz Aug 23, 2023
346e58f
eval_sv: add a G_USEHINTS flag
tonycoz Aug 23, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cop.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1219,6 +1219,7 @@ struct context {
#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */
#define G_METHOD_NAMED 0x1000 /* calling named method, eg without :: or ' */
#define G_RETHROW 0x2000 /* eval_sv(): re-throw any error */
#define G_USEHINTS 0x4000 /* eval_sv(): use current hints/features */

/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
Expand Down
2 changes: 1 addition & 1 deletion ext/XS-APItest/Makefile.PL
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ 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_LIST G_VOID G_DISCARD G_EVAL G_NOARGS
G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL G_RETHROW
GV_NOADD_NOINIT
GV_NOADD_NOINIT G_USEHINTS
SV_GMAGIC SV_SKIP_OVERLOAD
IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
Expand Down
19 changes: 17 additions & 2 deletions ext/XS-APItest/t/call.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,11 @@ use warnings;
use strict;

# Test::More doesn't have fresh_perl_is() yet
# use Test::More tests => 342;
# use Test::More tests => 344;

BEGIN {
require '../../t/test.pl';
plan(538);
plan(542);
use_ok('XS::APItest')
};
use Config;
Expand Down Expand Up @@ -340,6 +340,21 @@ for my $fn_type (qw(eval_pv eval_sv call_sv)) {
}
}

{
use feature "fc";
use strict;
# the XS eval_sv() returns the count of results
is(eval_sv('fc("A") eq fc("a"); 1', G_LIST), 0,
"don't inherit hints by default (so the eval fails)");
is(eval_sv('fc("A") eq fc("a"); 1', G_LIST | G_USEHINTS), 1,
"inherit hints when requested (so the eval succeeds)")
or diag($@);
is(eval_sv('$x = 1', G_LIST), 1,
"don't inherit hints (strict) by default, so the eval succeeds");
is(eval_sv('$x = 1', G_LIST | G_USEHINTS), 0,
"inherit hints (strict) when requested, so the evail fails");
}

# DAPM 9-Aug-04. A taint test in eval_sv() could die after setting up
# a new jump level but before pushing an eval context, leading to
# stack corruption
Expand Down
172 changes: 163 additions & 9 deletions feature.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion op.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12227,7 +12227,6 @@ Perl_ck_eval(pTHX_ OP *o)
/* Store a copy of %^H that pp_entereval can pick up. */
HV *hh = hv_copy_hints_hv(GvHV(PL_hintgv));
OP *hhop;
STOREFEATUREBITSHH(hh);
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hmm, took me a little while to work out why this bit, until I saw that we're now reconstructing the feature bits from the entire hinthash. Is that OK? In general the hh might contain a lot more keys (e.g. other bits of enabled syntax and options), so iterating the whole thing might take a little while, as compared just storing/fetching the UV as we used to.

hhop = newSVOP(OP_HINTSEVAL, 0, MUTABLE_SV(hh));
/* append hhop to only child */
op_sibling_splice(o, cUNOPo->op_first, 0, hhop);
Expand Down
8 changes: 8 additions & 0 deletions perl.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3229,7 +3229,12 @@ as C<call_sv>, with the obvious exception of C<G_EVAL>. See L<perlcall>.
The C<G_RETHROW> flag can be used if you only need eval_sv() to
execute code specified by a string, but not catch any errors.

By default the code is compiled and executed with the default hints,
such as strict and features. Set C<G_USEHINTS> in flags to use the
current hints from C<PL_curcop>.

=for apidoc Amnh||G_RETHROW
=for apidoc Amnh||G_USEHINTS
=cut
*/

Expand Down Expand Up @@ -3277,6 +3282,9 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
if (flags & G_RE_REPARSING)
myop.op_private |= (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING);

if (flags & G_USEHINTS)
myop.op_private |= OPpEVAL_COPHH;

/* fail now; otherwise we could fail after the JMPENV_PUSH but
* before a cx_pusheval(), which corrupts the stack after a croak */
TAINT_PROPER("eval_sv()");
Expand Down
54 changes: 45 additions & 9 deletions regen/feature.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -392,14 +392,7 @@ sub longest {

#define CLEARFEATUREBITS() (PL_compiling.cop_features = 0)

#define STOREFEATUREBITSHH(hh) \\
(hv_stores((hh), "feature/bits", newSVuv(PL_compiling.cop_features)))

#define FETCHFEATUREBITSHH(hh) \\
STMT_START { \\
SV **fbsv = hv_fetchs((hh), "feature/bits", FALSE); \\
PL_compiling.cop_features = fbsv ? SvUV(*fbsv) : 0; \\
} STMT_END
#define FETCHFEATUREBITSHH(hh) S_fetch_feature_bits_hh(aTHX_ (hh))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This commit turned 1 hv_fetch(), into 26 always failing hv_fetch() calls, on a HV* with only 1 key/1 HE* in it, with a key name of "CORE/prevailing_version".


#endif /* PERL_CORE or PERL_EXT */

Expand Down Expand Up @@ -434,7 +427,7 @@ sub longest {
}
#endif /* PERL_IN_OP_C */

#ifdef PERL_IN_MG_C
#if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_CTL_C)

#define magic_sethint_feature(keysv, keypv, keylen, valsv, valbool) \\
S_magic_sethint_feature(aTHX_ (keysv), (keypv), (keylen), (valsv), (valbool))
Expand Down Expand Up @@ -491,6 +484,49 @@ sub longest {
}
#endif /* PERL_IN_MG_C */

/* subject to change */
struct perl_feature_bit {
const char *name;
STRLEN namelen;
U32 mask;
};

#ifdef PERL_IN_PP_CTL_C

static const struct perl_feature_bit
PL_feature_bits[] = {
EOJ
for my $key (sort keys %feature) {
my $val = $feature{$key};
print $h <<EOJ;
{
/* feature $key */
"feature_$val",
STRLENs("feature_$val"),
FEATURE_\U$val\E_BIT
},
EOJ
}

print $h <<EOJ;
{ NULL, 0, 0U }
};

PERL_STATIC_INLINE void
S_fetch_feature_bits_hh(pTHX_ HV *hh) {
PL_compiling.cop_features = 0;

const struct perl_feature_bit *fb = PL_feature_bits;
while (fb->name) {
SV **svp = hv_fetch(hh, fb->name, (I32)fb->namelen, 0);
if (svp && SvTRUE(*svp))
PL_compiling.cop_features |= fb->mask;
++fb;
Copy link
Contributor

@bulk88 bulk88 Apr 18, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This while loop has 26 hash key name entries to test/look for. All 26 hash keys, are never found in typical production perl code. The HV* called hh, has only 1 HE*/key in it total called "CORE/prevailing_version". Pretty bad O(n) problems here with this PR.

}
}

#endif

#endif /* PERL_FEATURE_H_ */
EOJ

Expand Down