@@ -3036,40 +3036,41 @@ sub as_code {
3036
3036
3037
3037
# ======================================================================
3038
3038
3039
- package ExtUtils::ParseXS ; # XXX tmp
3039
+ package ExtUtils::ParseXS::Node::OUTPUT ;
3040
3040
3041
- # Process the lines following the OUTPUT: keyword.
3041
+ # Handle an OUTPUT: block
3042
3042
3043
- sub OUTPUT_handler {
3044
- my ExtUtils::ParseXS $self = shift ;
3043
+ BEGIN { $build_subclass -> ( ' keylines ' , # parent
3044
+ )} ;
3045
3045
3046
- my $line = shift ;
3046
+ # The inherited parse() method will call OUTPUT_line->parse() for each line
3047
3047
3048
- # In this loop: process each line until the next keyword or end of
3049
- # paragraph
3050
3048
3051
- for (; $line !~ / ^$ExtUtils::ParseXS::BLOCK_regexp /o ; $line = shift (@{ $self -> {line } })) {
3052
- $self -> OUTPUT_handler_line($line );
3053
- } # foreach line in OUTPUT block
3049
+ # ======================================================================
3054
3050
3055
- $_ = $line ;
3056
- }
3051
+ package ExtUtils::ParseXS::Node::OUTPUT_line ;
3057
3052
3053
+ # Handle one line from an OUTPUT keyword block
3058
3054
3059
- # ======================================================================
3055
+ BEGIN { $build_subclass -> (' keyline' , # parent
3056
+ ' param' , # the param object associated with this OUTPUT line.
3057
+ )};
3060
3058
3061
- package ExtUtils::ParseXS ; # XXX tmp
3062
3059
3063
- # process a single line from an OUTPUT section
3060
+ # Parse one line from an OUTPUT block
3064
3061
3065
- sub OUTPUT_handler_line {
3066
- my ExtUtils::ParseXS $self = shift ;
3067
- my $line = shift ;
3062
+ sub parse {
3063
+ my __PACKAGE__ $self = shift ;
3064
+ my ExtUtils::ParseXS $pxs = shift ;
3065
+ my ExtUtils::ParseXS::Node::OUTPUT $parent = shift ; # parent OUTPUT node
3066
+
3067
+ $self -> SUPER::parse($pxs ); # set file/line_no/line
3068
+ my $line = $self -> {line }; # line of text to be processed
3068
3069
3069
3070
return unless $line =~ / \S / ; # skip blank lines
3070
3071
3071
3072
if ($line =~ / ^\s *SETMAGIC\s *:\s *(ENABLE|DISABLE)\s */ ) {
3072
- $self -> {xsub_SETMAGIC_state } = ($1 eq " ENABLE" ? 1 : 0);
3073
+ $pxs -> {xsub_SETMAGIC_state } = ($1 eq " ENABLE" ? 1 : 0);
3073
3074
return ;
3074
3075
}
3075
3076
@@ -3080,30 +3081,31 @@ sub OUTPUT_handler_line {
3080
3081
my ($outarg , $outcode ) = $line =~ / ^\s *(\S +)\s *(.*?)\s *$ /s ;
3081
3082
3082
3083
my ExtUtils::ParseXS::Node::Param $param =
3083
- $self -> {xsub_sig }{names }{$outarg };
3084
+ $pxs -> {xsub_sig }{names }{$outarg };
3085
+ $self -> {param } = $param ;
3084
3086
3085
3087
if ($param && $param -> {in_output }) {
3086
- $self -> blurt(" Error: duplicate OUTPUT parameter '$outarg ' ignored" );
3088
+ $pxs -> blurt(" Error: duplicate OUTPUT parameter '$outarg ' ignored" );
3087
3089
return ;
3088
3090
}
3089
3091
3090
- if ($outarg eq " RETVAL" and $self -> {xsub_seen_NO_OUTPUT }) {
3091
- $self -> blurt(" Error: can't use RETVAL in OUTPUT when NO_OUTPUT declared" );
3092
+ if ($outarg eq " RETVAL" and $pxs -> {xsub_seen_NO_OUTPUT }) {
3093
+ $pxs -> blurt(" Error: can't use RETVAL in OUTPUT when NO_OUTPUT declared" );
3092
3094
return ;
3093
3095
}
3094
3096
3095
3097
if ( !$param # no such param or, for RETVAL, RETVAL was void
3096
3098
# not bound to an arg which can be updated
3097
3099
or $outarg ne " RETVAL" && !$param -> {arg_num })
3098
3100
{
3099
- $self -> blurt(" Error: OUTPUT $outarg not a parameter" );
3101
+ $pxs -> blurt(" Error: OUTPUT $outarg not a parameter" );
3100
3102
return ;
3101
3103
}
3102
3104
3103
3105
$param -> {in_output } = 1;
3104
3106
$param -> {do_setmagic } = $outarg eq ' RETVAL'
3105
3107
? 0 # RETVAL never needs magic setting
3106
- : $self -> {xsub_SETMAGIC_state };
3108
+ : $pxs -> {xsub_SETMAGIC_state };
3107
3109
$param -> {output_code } = $outcode if length $outcode ;
3108
3110
3109
3111
if ($outarg eq ' RETVAL' ) {
@@ -3112,7 +3114,17 @@ sub OUTPUT_handler_line {
3112
3114
return ;
3113
3115
}
3114
3116
3115
- $param -> as_output_code($self );
3117
+ 1;
3118
+ }
3119
+
3120
+
3121
+ sub as_code {
3122
+ my __PACKAGE__ $self = shift ;
3123
+ my ExtUtils::ParseXS $pxs = shift ;
3124
+
3125
+ my $param = $self -> {param };
3126
+ return unless $param ; # might be an ENABLE line with no param to emit
3127
+ $param -> as_output_code($pxs );
3116
3128
}
3117
3129
3118
3130
0 commit comments