Skip to content

Commit a964679

Browse files
committed
ParseXS: refactor: INPUT_handler() move to Node.pm
This is #3 of a small series of commits to refactor the INPUT_handler() method and turn it into a Node subclass method. This commit moves the ExtUtils::ParseXS methods INPUT_handler() INPUT_handler_line() from ParseXS.pm into ParseXS/Node.pm. For now they temporarily remain as ExtUtils::ParseXS methods; this is just a straight cut and paste, except for fully-qualifying the $BLOCK_regexp package variable name and adding a couple of temporary 'package ExtUtils::ParseXS' declarations.
1 parent 8784182 commit a964679

File tree

2 files changed

+208
-201
lines changed

2 files changed

+208
-201
lines changed

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

Lines changed: 0 additions & 201 deletions
Original file line numberDiff line numberDiff line change
@@ -1956,207 +1956,6 @@ sub ST {
19561956
}
19571957

19581958

1959-
# INPUT_handler(): handle an explicit INPUT: block, or any implicit INPUT
1960-
# block which can follow an xsub signature or CASE keyword.
1961-
1962-
sub INPUT_handler {
1963-
my ExtUtils::ParseXS $self = shift;
1964-
my $line = shift;
1965-
1966-
# In this loop: process each line until the next keyword or end of
1967-
# paragraph.
1968-
1969-
for (; $line !~ /^$BLOCK_regexp/o; $line = shift(@{ $self->{line} })) {
1970-
# treat NOT_IMPLEMENTED_YET as another block separator, in addition to
1971-
# $BLOCK_regexp.
1972-
last if $line =~ /^\s*NOT_IMPLEMENTED_YET/;
1973-
1974-
$self->INPUT_handler_line($line);
1975-
} # foreach line in INPUT block
1976-
$_ = $line;
1977-
}
1978-
1979-
1980-
# process a single line from an INPUT section
1981-
1982-
sub INPUT_handler_line {
1983-
my ExtUtils::ParseXS $self = shift;
1984-
my $line = shift;
1985-
1986-
return unless $line =~ /\S/; # skip blank lines
1987-
1988-
trim_whitespace($line);
1989-
my $orig_line = $line; # keep original line for error messages
1990-
1991-
# remove any trailing semicolon, except for initialisations
1992-
$line =~ s/\s*;$//g unless $line =~ /[=;+].*\S/;
1993-
1994-
# Extract optional initialisation code (which overrides the
1995-
# normal typemap), such as 'int foo = ($type)SvIV($arg)'
1996-
my $var_init = '';
1997-
my $init_op;
1998-
($init_op, $var_init) = ($1, $2) if $line =~ s/\s* ([=;+]) \s* (.*) $//xs;
1999-
2000-
$line =~ s/\s+/ /g;
2001-
2002-
# Split 'char * &foo' into ('char *', '&', 'foo')
2003-
# skip to next INPUT line if not valid.
2004-
#
2005-
# Note that this pattern has a very liberal sense of what is "valid",
2006-
# since we don't fully parse C types. For example:
2007-
#
2008-
# int foo(a)
2009-
# int a XYZ
2010-
#
2011-
# would be interpreted as an "alien" (i.e. not in the signature)
2012-
# variable called "XYZ", with a type of "int a". And because it's
2013-
# alien the initialiser is skipped, so 'int a' is never looked up in
2014-
# a typemap, so we don't detect anything wrong. Later on, the C
2015-
# compiler is likely to trip over on the emitted declaration
2016-
# however:
2017-
# int a XYZ;
2018-
2019-
my ($var_type, $var_addr, $var_name) =
2020-
$line =~ /^
2021-
( .*? [^&\s] ) # type
2022-
\s*
2023-
(\&?) # addr
2024-
\s* \b
2025-
(\w+ | length\(\w+\)) # name or length(name)
2026-
$
2027-
/xs
2028-
or $self->blurt("Error: invalid parameter declaration '$orig_line'"), return;
2029-
2030-
# length(s) is only allowed in the XSUB's signature.
2031-
if ($var_name =~ /^length\((\w+)\)$/) {
2032-
$self->blurt("Error: length() not permitted in INPUT section");
2033-
return;
2034-
}
2035-
2036-
my ($var_num, $is_alien);
2037-
2038-
my ExtUtils::ParseXS::Node::Param $param
2039-
= $self->{xsub_sig}{names}{$var_name};
2040-
2041-
2042-
if (defined $param) {
2043-
# The var appeared in the signature too.
2044-
2045-
# Check for duplicate definitions of a particular parameter name.
2046-
# This can be either because it has appeared in multiple INPUT
2047-
# lines, or because the type was already defined in the signature,
2048-
# and thus shouldn't be defined again. The exception to this are
2049-
# synthetic params like THIS, which are assigned a provisional type
2050-
# which can be overridden.
2051-
if ( $param->{in_input}
2052-
or (!$param->{is_synthetic} and defined $param->{type})
2053-
) {
2054-
$self->blurt(
2055-
"Error: duplicate definition of parameter '$var_name' ignored");
2056-
return;
2057-
}
2058-
2059-
if ($var_name eq 'RETVAL' and $param->{is_synthetic}) {
2060-
# Convert a synthetic RETVAL into a real parameter
2061-
delete $param->{is_synthetic};
2062-
delete $param->{no_init};
2063-
if (! defined $param->{arg_num}) {
2064-
# if has arg_num, RETVAL has appeared in signature but with no
2065-
# type, and has already been moved to the correct position;
2066-
# otherwise, it's an alien var that didn't appear in the
2067-
# signature; move to the correct position.
2068-
@{$self->{xsub_sig}{params}} =
2069-
grep $_ != $param, @{$self->{xsub_sig}{params}};
2070-
push @{$self->{xsub_sig}{params}}, $param;
2071-
$is_alien = 1;
2072-
$param->{is_alien} = 1;
2073-
}
2074-
}
2075-
2076-
$param->{in_input} = 1;
2077-
$var_num = $param->{arg_num};
2078-
}
2079-
else {
2080-
# The var is in an INPUT line, but not in signature. Treat it as a
2081-
# general var declaration (which really should have been in a
2082-
# PREINIT section). Legal but nasty: flag is as 'alien'
2083-
$is_alien = 1;
2084-
$param = ExtUtils::ParseXS::Node::Param->new({
2085-
var => $var_name,
2086-
is_alien => 1,
2087-
});
2088-
2089-
push @{$self->{xsub_sig}{params}}, $param;
2090-
$self->{xsub_sig}{names}{$var_name} = $param;
2091-
}
2092-
2093-
# Parse the initialisation part of the INPUT line (if any)
2094-
2095-
my ($init, $defer);
2096-
my $no_init = $param->{no_init}; # may have had OUT in signature
2097-
2098-
if (!$no_init && defined $init_op) {
2099-
# Emit the init code based on overridden $var_init, which was
2100-
# preceded by /[=;+]/ which has been extracted into $init_op
2101-
2102-
if ( $init_op =~ /^[=;]$/
2103-
and $var_init =~ /^NO_INIT\s*;?\s*$/
2104-
) {
2105-
# NO_INIT: skip initialisation
2106-
$no_init = 1;
2107-
}
2108-
elsif ($init_op eq '=') {
2109-
# Overridden typemap, such as '= ($type)SvUV($arg)'
2110-
$var_init =~ s/;\s*$//;
2111-
$init = $var_init,
2112-
}
2113-
else {
2114-
# "; extra code" or "+ extra code" :
2115-
# append the extra code (after passing through eval) after all the
2116-
# INPUT and PREINIT blocks have been processed, indirectly using
2117-
# the $self->{xsub_deferred_code_lines} mechanism.
2118-
# In addition, for '+', also generate the normal initialisation
2119-
# code from the standard typemap - assuming that it's a real
2120-
# parameter that appears in the signature as well as the INPUT
2121-
# line.
2122-
$no_init = !($init_op eq '+' && !$is_alien);
2123-
# But in either case, add the deferred code
2124-
$defer = $var_init;
2125-
}
2126-
}
2127-
else {
2128-
# no initialiser: emit var and init code based on typemap entry,
2129-
# unless: it's alien (so no stack arg to bind to it)
2130-
$no_init = 1 if $is_alien;
2131-
}
2132-
2133-
%$param = (
2134-
%$param,
2135-
type => $var_type,
2136-
arg_num => $var_num,
2137-
var => $var_name,
2138-
defer => $defer,
2139-
init => $init,
2140-
init_op => $init_op,
2141-
no_init => $no_init,
2142-
is_addr => !!$var_addr,
2143-
);
2144-
2145-
$param->check($self)
2146-
or return;
2147-
2148-
# Emit "type var" declaration and possibly various forms of
2149-
# initialiser code.
2150-
2151-
# Synthetic params like THIS will be emitted later - they
2152-
# are treated like ANSI params, except the type can overridden
2153-
# within an INPUT statement
2154-
return if $param->{is_synthetic};
2155-
2156-
$param->as_code($self);
2157-
}
2158-
2159-
21601959
# Process the lines following the OUTPUT: keyword.
21611960

21621961
sub OUTPUT_handler {

0 commit comments

Comments
 (0)