Skip to content

Commit 0515139

Browse files
iabyniabyn
committed
ParseXS: refactor: IO_Param::lookup_input_typemap
Move all the code out of ExtUtils::ParseXS::Node::IO_Param::as_input_code() which is responsible for looking up the template initialisation code in the typemap (or elsewhere) and put it in it's own method, lookup_input_typemap(). As well as splitting a 300-line method into two approx 150-line methods, this will also allow us shortly to move the template lookup to earlier, at parse time rather than code-emitting time. Also add some more tests for the length(foo) pseudo-parameter, which I broke while working on this commit, and then noticed it was under-tested.
1 parent 156f4ea commit 0515139

File tree

2 files changed

+134
-80
lines changed

2 files changed

+134
-80
lines changed

‎dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm

Lines changed: 116 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -1102,98 +1102,44 @@ BEGIN { $build_subclass->('Param', # parent
11021102
)};
11031103

11041104

1105-
# $self->as_input_code():
1105+
# Given a param with known type etc, extract its typemap INPUT template
1106+
# and also create a hash of vars that can be used to eval that template.
1107+
# An undef returned hash ref signifies that the returned template string
1108+
# doesn't need to be evalled.
11061109
#
1107-
# Emit the param object as C code which declares and initialise the variable.
1108-
# See also the as_output_code() method, which emits code to return the value
1109-
# of that local var.
1110+
# Returns ($expr, $eval_vars, $is_template)
1111+
# or empty list on failure.
1112+
#
1113+
# $expr: text like '$var = SvIV($arg)'
1114+
# $eval_vars: hash ref like { var => 'foo', arg => 'ST(0)', ... }
1115+
# $is_template: $expr has '$arg' etc and needs evalling
11101116

1111-
sub as_input_code {
1117+
sub lookup_input_typemap {
11121118
my __PACKAGE__ $self = shift;
11131119
my ExtUtils::ParseXS $pxs = shift;
11141120
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
11151121
my $xbody = shift;
11161122

1117-
my ($type, $arg_num, $var, $init, $no_init, $defer, $default)
1118-
= @{$self}{qw(type arg_num var init no_init defer default)};
1119-
1123+
my ($type, $arg_num, $var, $init, $no_init, $default)
1124+
= @{$self}{qw(type arg_num var init no_init default)};
1125+
$var = "XSauto_length_of_$self->{len_name}" if $self->{is_length};
11201126
my $arg = $pxs->ST($arg_num);
11211127

1122-
if ($self->{is_length}) {
1123-
# Process length(foo) parameter.
1124-
# Basically for something like foo(char *s, int length(s)),
1125-
# create *two* local C vars: one with STRLEN type, and one with the
1126-
# type specified in the signature. Eventually, generate code looking
1127-
# something like:
1128-
# STRLEN STRLEN_length_of_s;
1129-
# int XSauto_length_of_s;
1130-
# char *s = (char *)SvPV(ST(0), STRLEN_length_of_s);
1131-
# XSauto_length_of_s = STRLEN_length_of_s;
1132-
# RETVAL = foo(s, XSauto_length_of_s);
1133-
#
1134-
# Note that the SvPV() code line is generated via a separate call to
1135-
# this sub with s as the var (as opposed to *this* call, which is
1136-
# handling length(s)), by overriding the normal T_PV typemap (which
1137-
# uses PV_nolen()).
1138-
1139-
my $name = $self->{len_name};
1140-
1141-
print "\tSTRLEN\tSTRLEN_length_of_$name;\n";
1142-
# defer this line until after all the other declarations
1143-
$xbody->{input_part}{deferred_code_lines} .=
1144-
"\n\tXSauto_length_of_$name = STRLEN_length_of_$name;\n";
1145-
1146-
# this var will be declared using the normal typemap mechanism below
1147-
$var = "XSauto_length_of_$name";
1148-
}
1149-
1150-
# Emit the variable's type and name.
1151-
#
1152-
# Includes special handling for function pointer types. An INPUT line
1153-
# always has the C type followed by the variable name. The C code
1154-
# which is emitted normally follows the same pattern. However for
1155-
# function pointers, the code is different: the variable name has to
1156-
# be embedded *within* the type. For example, these two INPUT lines:
1157-
#
1158-
# char * s
1159-
# int (*)(int) fn_ptr
1160-
#
1161-
# cause the following lines of C to be emitted;
1162-
#
1163-
# char * s = [something from a typemap]
1164-
# int (* fn_ptr)(int) = [something from a typemap]
1165-
#
1166-
# So handle specially the specific case of a type containing '(*)' by
1167-
# embedding the variable name *within* rather than *after* the type.
1168-
1169-
1170-
if ($type =~ / \( \s* \* \s* \) /x) {
1171-
# for a fn ptr type, embed the var name in the type declaration
1172-
print "\t" . $pxs->map_type($type, $var);
1173-
}
1174-
else {
1175-
print "\t",
1176-
((defined($xsub->{decl}{class}) && $var eq 'CLASS')
1177-
? $type
1178-
: $pxs->map_type($type, undef)),
1179-
"\t$var";
1180-
}
1181-
11821128
# whitespace-tidy the type
11831129
$type = ExtUtils::Typemaps::tidy_type($type);
11841130

11851131
# Specify the environment for when the initialiser template is evaled.
11861132
# Only the common ones are specified here. Other fields may be added
11871133
# later.
11881134
my $eval_vars = {
1189-
type => $type,
1190-
var => $var,
1191-
num => $arg_num,
1192-
arg => $arg,
1193-
alias => $xsub->{seen_ALIAS},
1194-
func_name => $xsub->{decl}{name},
1195-
full_perl_name => $xsub->{decl}{full_perl_name},
1196-
full_C_name => $xsub->{decl}{full_C_name},
1135+
type => $type,
1136+
var => $var,
1137+
num => $arg_num,
1138+
arg => $arg,
1139+
alias => $xsub->{seen_ALIAS},
1140+
func_name => $xsub->{decl}{name},
1141+
full_perl_name => $xsub->{decl}{full_perl_name},
1142+
full_C_name => $xsub->{decl}{full_C_name},
11971143
};
11981144

11991145
# The type looked up in the eval is Foo__Bar rather than Foo::Bar
@@ -1254,10 +1200,10 @@ sub as_input_code {
12541200
# would emit SvPV_nolen(...) - and instead, emit SvPV(...,
12551201
# STRLEN_length_of_foo)
12561202
if ($xstype eq 'T_PV' and $self->{has_length}) {
1257-
print " = ($type)SvPV($arg, STRLEN_length_of_$var);\n";
12581203
die "default value not supported with length(NAME) supplied"
12591204
if defined $default;
1260-
return;
1205+
return "($type)SvPV($arg, STRLEN_length_of_$var);",
1206+
$eval_vars, 0;
12611207
}
12621208

12631209
# Get the ExtUtils::Typemaps::InputMap object associated with the
@@ -1312,8 +1258,6 @@ sub as_input_code {
13121258
}
13131259

13141260
if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
1315-
# XXX this really aught to be determined during parse rather
1316-
# than during code emitting.
13171261
$xsub->{SCOPE_enabled} = 1;
13181262
}
13191263

@@ -1323,6 +1267,98 @@ sub as_input_code {
13231267
$init_template = $expr;
13241268
}
13251269

1270+
return ($init_template, $eval_vars, 1);
1271+
}
1272+
1273+
1274+
# $self->as_input_code():
1275+
#
1276+
# Emit the param object as C code which declares and initialise the variable.
1277+
# See also the as_output_code() method, which emits code to return the value
1278+
# of that local var.
1279+
1280+
sub as_input_code {
1281+
my __PACKAGE__ $self = shift;
1282+
my ExtUtils::ParseXS $pxs = shift;
1283+
my ExtUtils::ParseXS::Node::xsub $xsub = shift;
1284+
my $xbody = shift;
1285+
1286+
my ($type, $arg_num, $var, $init, $no_init, $defer, $default)
1287+
= @{$self}{qw(type arg_num var init no_init defer default)};
1288+
1289+
my $arg = $pxs->ST($arg_num);
1290+
1291+
if ($self->{is_length}) {
1292+
# Process length(foo) parameter.
1293+
# Basically for something like foo(char *s, int length(s)),
1294+
# create *two* local C vars: one with STRLEN type, and one with the
1295+
# type specified in the signature. Eventually, generate code looking
1296+
# something like:
1297+
# STRLEN STRLEN_length_of_s;
1298+
# int XSauto_length_of_s;
1299+
# char *s = (char *)SvPV(ST(0), STRLEN_length_of_s);
1300+
# XSauto_length_of_s = STRLEN_length_of_s;
1301+
# RETVAL = foo(s, XSauto_length_of_s);
1302+
#
1303+
# Note that the SvPV() code line is generated via a separate call to
1304+
# this sub with s as the var (as opposed to *this* call, which is
1305+
# handling length(s)), by overriding the normal T_PV typemap (which
1306+
# uses PV_nolen()).
1307+
1308+
my $name = $self->{len_name};
1309+
1310+
print "\tSTRLEN\tSTRLEN_length_of_$name;\n";
1311+
# defer this line until after all the other declarations
1312+
$xbody->{input_part}{deferred_code_lines} .=
1313+
"\n\tXSauto_length_of_$name = STRLEN_length_of_$name;\n";
1314+
$var = "XSauto_length_of_$name";
1315+
}
1316+
1317+
# Emit the variable's type and name.
1318+
#
1319+
# Includes special handling for function pointer types. An INPUT line
1320+
# always has the C type followed by the variable name. The C code
1321+
# which is emitted normally follows the same pattern. However for
1322+
# function pointers, the code is different: the variable name has to
1323+
# be embedded *within* the type. For example, these two INPUT lines:
1324+
#
1325+
# char * s
1326+
# int (*)(int) fn_ptr
1327+
#
1328+
# cause the following lines of C to be emitted;
1329+
#
1330+
# char * s = [something from a typemap]
1331+
# int (* fn_ptr)(int) = [something from a typemap]
1332+
#
1333+
# So handle specially the specific case of a type containing '(*)' by
1334+
# embedding the variable name *within* rather than *after* the type.
1335+
1336+
1337+
if ($type =~ / \( \s* \* \s* \) /x) {
1338+
# for a fn ptr type, embed the var name in the type declaration
1339+
print "\t" . $pxs->map_type($type, $var);
1340+
}
1341+
else {
1342+
print "\t",
1343+
((defined($xsub->{decl}{class}) && $var eq 'CLASS')
1344+
? $type
1345+
: $pxs->map_type($type, undef)),
1346+
"\t$var";
1347+
}
1348+
1349+
my ($init_template, $eval_vars, $is_template) =
1350+
$self->lookup_input_typemap($pxs, $xsub, $xbody);
1351+
1352+
return unless defined $init_template; # an error occurred
1353+
unless ($is_template) {
1354+
# template already expanded
1355+
print " = $init_template\n";
1356+
return;
1357+
}
1358+
1359+
# whitespace-tidy the type
1360+
$type = ExtUtils::Typemaps::tidy_type($type);
1361+
13261362
# Now finally, emit the actual variable declaration and initialisation
13271363
# line(s). The variable type and name will already have been emitted.
13281364

‎dist/ExtUtils-ParseXS/t/001-basic.t

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1503,6 +1503,24 @@ EOF
15031503
EOF
15041504
15051505
my @test_fns = (
1506+
[
1507+
"length() basic",
1508+
[ Q(<<'EOF') ],
1509+
|void
1510+
|foo(char *s, int length(s))
1511+
EOF
1512+
[ 0, 0, qr{^\s+STRLEN\s+STRLEN_length_of_s;}m, "decl STRLEN" ],
1513+
[ 0, 0, qr{^\s+int\s+XSauto_length_of_s;}m, "decl int" ],
1514+
1515+
[ 0, 0, qr{^ \s+ \Qchar *\E \s+
1516+
\Qs = (char *)SvPV(ST(0), STRLEN_length_of_s);}xm,
1517+
"decl s" ],
1518+
1519+
[ 0, 0, qr{^\s+\QXSauto_length_of_s = STRLEN_length_of_s}m,
1520+
"assign" ],
1521+
1522+
[ 0, 0, qr{^\s+\Qfoo(s, XSauto_length_of_s);}m, "autocall" ],
1523+
],
15061524
[
15071525
"length() default value",
15081526
[ Q(<<'EOF') ],

0 commit comments

Comments
 (0)