@@ -1956,207 +1956,6 @@ sub ST {
1956
1956
}
1957
1957
1958
1958
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
-
2160
1959
# Process the lines following the OUTPUT: keyword.
2161
1960
2162
1961
sub OUTPUT_handler {
0 commit comments