File Coverage

blib/lib/ExtUtils/ParseXS.pm
Criterion Covered Total %
statement 207 221 93.6
branch 67 90 74.4
condition 18 28 64.2
subroutine 21 22 95.4
pod 3 9 33.3
total 316 370 85.4


line stmt bran cond sub pod time code
1             package ExtUtils::ParseXS;
2 28     28   3764571 use strict;
  28         48  
  28         1029  
3 28     28   112 use warnings;
  28         52  
  28         1970  
4              
5             # Note that the pod for this module is separate in ParseXS.pod.
6             #
7             # This module provides the guts for the xsubpp XS-to-C translator utility.
8             # By having it as a module separate from xsubpp, it makes it more efficient
9             # to be used for example by Module::Build without having to shell out to
10             # xsubpp. It also makes it easier to test the individual components.
11             #
12             # The main function in this file is process_file(), which oversees the
13             # whole job of reading in a .xs file, parsing it into an Abstract Syntax
14             # Tree (AST), then walking the tree to generate C code and output it to a
15             # .c file.
16             #
17             # Most of the actual logic is in the ExtUtils::ParseXS::Node::FOO
18             # subclasses, which hold the nodes of the AST. The parse() methods of
19             # these subclasses do a top-down recursive-descent parse of the input
20             # file, building the AST; while the as_code() methods walk the tree,
21             # emitting C code.
22             #
23             # The main parsing loop is contained in the Node::cpp_scope::parse()
24             # method, which in turn relies on fetch_para() to read a paragraph's worth
25             # of lines from the input while stripping out any POD or XS comments. It
26             # is fetch_para() which decides where an XSUB, BOOT or TYPEMAP block ends,
27             # mainly by using a blank line followed by character in column 1 as the
28             # delimiter (except for TYPEMAP, where it looks for the matching EOF-style
29             # string).
30             #
31             # The remainder of this file mainly consists of helper functions and
32             # functions to help with outputting stuff.
33             #
34             # Of particular note is the Q() function, which is typically used to
35             # process escaped ("quoted") heredoc text of C code fragments to be
36             # output. It strips an initial '|' preceded by optional spaces, and
37             # converts [[ and ]] to { and }. This allows unmatched braces to be
38             # included in the C fragments without confusing text editors.
39             #
40             # Some other tasks have been moved out to various .pm files under ParseXS:
41             #
42             # ParseXS::CountLines provides tied handle methods for automatically
43             # injecting '#line' directives into output.
44             #
45             # ParseXS::Eval provides methods for evalling typemaps within
46             # an environment where suitable vars like $var and
47             # $arg have been up, but with nothing else in scope.
48             #
49             # ParseXS::Node This and its subclasses provide the nodes
50             # which make up the Abstract Syntax Tree (AST)
51             # generated by the parser.
52             #
53             # ParseXS::Constants defines a few constants used here, such the regex
54             # patterns used to detect a new XS keyword.
55             #
56             # ParseXS::Utilities provides various private utility methods for
57             # the use of ParseXS, such as analysing C
58             # pre-processor directives.
59             #
60             # Note: when making changes to this module (or to its children), you
61             # can make use of the author/mksnapshot.pl tool to capture before and
62             # after snapshots of all .c files generated from .xs files (e.g. all the
63             # ones generated when building the perl distribution), to make sure that
64             # the only the changes to have appeared are ones which you expected.
65              
66             # 5.8.0 is required for "use fields"
67             # 5.8.3 is required for "use Exporter 'import'"
68 28     28   482 use 5.008003;
  28         85  
69              
70 28     28   117 use Cwd;
  28         92  
  28         2286  
71 28     28   140 use Config;
  28         48  
  28         1209  
72 28     28   111 use Exporter 'import';
  28         34  
  28         756  
73 28     28   114 use File::Basename;
  28         40  
  28         1968  
74 28     28   161 use File::Spec;
  28         92  
  28         616  
75 28     28   9668 use Symbol;
  28         26097  
  28         3705  
76              
77             our $VERSION;
78             BEGIN {
79 28     28   76 $VERSION = '3.63';
80 28         10493 require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION);
  28         403  
81 28         10426 require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION);
  28         410  
82 28         31633 require ExtUtils::ParseXS::Node; ExtUtils::ParseXS::Node->VERSION($VERSION);
  28         550  
83 28         15415 require ExtUtils::ParseXS::Utilities; ExtUtils::ParseXS::Utilities->VERSION($VERSION);
  28         556  
84 28         11419 require ExtUtils::ParseXS::Eval; ExtUtils::ParseXS::Eval->VERSION($VERSION);
  28         2841  
85             }
86             $VERSION = eval $VERSION if $VERSION =~ /_/;
87              
88 28         9235 use ExtUtils::ParseXS::Utilities qw(
89             trim_whitespace
90             C_string
91             valid_proto_string
92             process_typemaps
93             map_type
94             set_cond
95             Warn
96             WarnHint
97             current_line_number
98             blurt
99             death
100             deathHint
101             escape_file_for_line_directive
102             report_typemap_failure
103 28     28   314 );
  28         141  
104              
105             our @EXPORT_OK = qw(
106             process_file
107             report_error_count
108             errors
109             );
110              
111             ##############################
112             # A number of "constants"
113             our $DIE_ON_ERROR;
114              
115             our $AUTHOR_WARNINGS;
116             $AUTHOR_WARNINGS = ($ENV{AUTHOR_WARNINGS} || 0)
117             unless defined $AUTHOR_WARNINGS;
118              
119             # Match an XS Keyword
120             our $BLOCK_regexp = '\s*(' . $ExtUtils::ParseXS::Constants::XSKeywordsAlternation . ")\\s*:";
121              
122              
123             # All the valid fields of an ExtUtils::ParseXS hash object. The 'use
124             # fields' enables compile-time or run-time errors if code attempts to
125             # use a key which isn't listed here.
126              
127             my $USING_FIELDS;
128              
129             BEGIN {
130 28     28   260 my @fields = (
131              
132             # I/O:
133              
134             'dir', # The directory component of the main input file:
135             # we will normally chdir() to this directory.
136              
137             'in_pathname', # The full pathname of the current input file.
138             'in_filename', # The filename of the current input file.
139             'in_fh', # The filehandle of the current input file.
140              
141             'IncludedFiles', # Bool hash of INCLUDEd filenames (plus main file).
142              
143             'line', # Array of lines recently read in and being processed.
144             # Typically one XSUB's worth of lines.
145             'line_no', # Array of line nums corresponding to @{$self->{line}}.
146              
147             'lastline', # The contents of the line most recently read in
148             # but not yet processed.
149             'lastline_no', # The line number of lastline.
150              
151              
152             # File-scoped configuration state:
153              
154             'config_RetainCplusplusHierarchicalTypes', # Bool: "-hiertype" switch
155             # value: it stops the typemap code doing
156             # $type =~ tr/:/_/.
157              
158             'config_WantLineNumbers', # Bool: (default true): "-nolinenumbers"
159             # switch not present: causes '#line NNN' lines to
160             # be emitted.
161              
162             'config_die_on_error',# Bool: make death() call die() rather than exit().
163             # It is set initially from the die_on_error option
164             # or from the $ExtUtils::ParseXS::DIE_ON_ERROR global.
165              
166             'config_author_warnings', # Bool: enables some warnings only useful to
167             # ParseXS.pm's authors rather than module creators.
168             # Set from Options or $AUTHOR_WARNINGS env var.
169              
170             'config_strip_c_func_prefix', # The discouraged -strip=... switch.
171              
172             'config_allow_argtypes', # Bool: (default true): "-noargtypes" switch not
173             # present. Enables ANSI-like arg types to be
174             # included in the XSUB signature.
175              
176             'config_allow_inout', # Bool: (default true): "-noinout" switch not present.
177             # Enables processing of IN/OUT/etc arg modifiers.
178              
179             'config_allow_exceptions', # Bool: (default false): the '-except' switch
180             # present.
181              
182             'config_optimize', # Bool: (default true): "-nooptimize" switch not
183             # present. Enables optimizations (currently just
184             # the TARG one).
185              
186              
187             # File-scoped parsing state:
188              
189             'AST', # the Node::XS_file object representing the AST
190             # tree for the whole XS file
191              
192             'typemaps_object', # An ExtUtils::Typemaps object: the result of
193             # reading in the standard (or other) typemap.
194              
195             'error_count', # Num: count of number of errors seen so far.
196              
197             'cpp_next_tmp_define',# the next string like XSubPPtmpAAAA
198             # to use as CPP defines for distringuishing
199             # similar calls to newXS() etc
200              
201             'MODULE_cname', # MODULE canonical name (i.e. after s/\W/_/g).
202             'PACKAGE_name', # PACKAGE name.
203             'PACKAGE_C_name', # Ditto, but with tr/:/_/.
204             'PACKAGE_class', # Ditto, but with '::' appended.
205             'PREFIX_pattern', # PREFIX value, but after quotemeta().
206              
207             'map_overloaded_package_to_C_package', # Hash: for every PACKAGE which
208             # has at least one overloaded XSUB, add a
209             # (package name => package C name) entry.
210              
211             'map_package_to_fallback_string', # Hash: for every package, maps it to
212             # the overload fallback state for that package (if
213             # specified). Each value is one of the strings
214             # "TRUE", "FALSE", "UNDEF".
215              
216             'proto_behaviour_specified', # Bool: prototype behaviour has been
217             # specified by the -prototypes switch and/or
218             # PROTOTYPE(S) keywords, so no need to warn.
219              
220             'PROTOTYPES_value', # Bool: most recent PROTOTYPES: value. Defaults to
221             # the value of the "-prototypes" switch.
222              
223             'VERSIONCHECK_value', # Bool: most recent VERSIONCHECK: value. Defaults
224             # to the value of the "-noversioncheck" switch.
225              
226             'seen_an_XSUB', # Bool: at least one XSUB has been encountered
227              
228             # File-scoped code-emitting state:
229              
230             'need_boot_cv', # must declare 'cv' within the boot function
231              
232             # Per-XSUB parsing state:
233              
234             'file_SCOPE_enabled', # Bool: the current state of the file-scope
235             # (as opposed to
236             # XSUB-scope) SCOPE keyword
237             );
238              
239             # do 'use fields', except: fields needs Hash::Util which is XS, which
240             # needs us. So only 'use fields' on systems where Hash::Util has already
241             # been built.
242 28 50       1998 if (eval 'require Hash::Util; 1;') {
243 28         89 require fields;
244 28         45 $USING_FIELDS = 1;
245 28         145 fields->import(@fields);
246             }
247             }
248              
249              
250             sub new {
251 461     461 1 2013911 my ExtUtils::ParseXS $self = shift;
252 461 50       2728 unless (ref $self) {
253 461 50       1728 if ($USING_FIELDS) {
254 461         2333 $self = fields::new($self);
255             }
256             else {
257 0         0 $self = bless {} => $self;
258             }
259             }
260 461         87497 return $self;
261             }
262              
263             our $Singleton = __PACKAGE__->new;
264              
265              
266             # The big method which does all the input parsing and output generation
267              
268             sub process_file {
269 433     433 1 27752 my ExtUtils::ParseXS $self;
270             # Allow for $package->process_file(%hash), $obj->process_file, and process_file()
271 433 50       1584 if (@_ % 2) {
272 433         948 my $invocant = shift;
273 433 100       1289 $self = ref($invocant) ? $invocant : $invocant->new;
274             }
275             else {
276 0         0 $self = $Singleton;
277             }
278              
279 433         705 my %Options;
280              
281             {
282 433         629 my %opts = @_;
  433         2036  
283 433         1486 $self->{proto_behaviour_specified} = exists $opts{prototypes};
284              
285             # Set defaults.
286 433         3187 %Options = (
287             argtypes => 1,
288             csuffix => '.c',
289             except => 0,
290             hiertype => 0,
291             inout => 1,
292             linenumbers => 1,
293             optimize => 1,
294             output => \*STDOUT,
295             prototypes => 0,
296             typemap => [],
297             versioncheck => 1,
298             in_fh => Symbol::gensym(),
299             die_on_error => $DIE_ON_ERROR, # if true we die() and not exit()
300             # after errors
301             author_warnings => $AUTHOR_WARNINGS,
302             %opts,
303             );
304             }
305              
306             # Global Constants
307              
308 433         14048 our ($Is_VMS, $VMS_SymSet);
309              
310 433 50       2475 if ($^O eq 'VMS') {
311 0         0 $Is_VMS = 1;
312             # Establish set of global symbols with max length 28, since xsubpp
313             # will later add the 'XS_' prefix.
314 0         0 require ExtUtils::XSSymSet;
315 0         0 $ExtUtils::ParseXS::VMS_SymSet = ExtUtils::XSSymSet->new(28);
316             }
317              
318             # Most of the parser uses these globals. We'll have to clean this up
319             # sometime, probably. For now, we just pull them out of %Options. -Ken
320              
321 433         1182 $self->{config_RetainCplusplusHierarchicalTypes} = $Options{hiertype};
322 433         1157 $self->{PROTOTYPES_value} = $Options{prototypes};
323 433         1067 $self->{VERSIONCHECK_value} = $Options{versioncheck};
324 433         1091 $self->{config_WantLineNumbers} = $Options{linenumbers};
325 433         972 $self->{IncludedFiles} = {};
326              
327 433         1141 $self->{config_die_on_error} = $Options{die_on_error};
328 433         1155 $self->{config_author_warnings} = $Options{author_warnings};
329              
330 433 50       1325 die "Missing required parameter 'filename'" unless $Options{filename};
331              
332              
333             # allow a string ref to be passed as an in-place filehandle
334 433 100       1257 if (ref $Options{filename}) {
335 427         739 my $f = '(input)';
336 427         1098 $self->{in_pathname} = $f;
337 427         883 $self->{in_filename} = $f;
338 427         913 $self->{dir} = '.';
339 427         1270 $self->{IncludedFiles}->{$f}++;
340 427 50       1767 $Options{outfile} = '(output)' unless $Options{outfile};
341             }
342             else {
343             ($self->{dir}, $self->{in_filename}) =
344 6         485 (dirname($Options{filename}), basename($Options{filename}));
345 6         19 $self->{in_pathname} = $Options{filename};
346 6         16 $self->{in_pathname} =~ s/\\/\\\\/g;
347 6         19 $self->{IncludedFiles}->{$Options{filename}}++;
348             }
349              
350             # Open the output file if given as a string. If they provide some
351             # other kind of reference, trust them that we can print to it.
352 433 100       1265 if (not ref $Options{output}) {
353 4 50       868 open my($fh), "> $Options{output}" or die "Can't create $Options{output}: $!";
354 4         22 $Options{outfile} = $Options{output};
355 4         11 $Options{output} = $fh;
356             }
357              
358             # Really, we shouldn't have to chdir() or select() in the first
359             # place. For now, just save and restore.
360 433         2383931 my $orig_cwd = cwd();
361 433         8282 my $orig_fh = select();
362              
363 433         7963 chdir($self->{dir});
364 433         1919642 my $pwd = cwd();
365              
366 433 100       6562 if ($self->{config_WantLineNumbers}) {
367 431         3509 my $csuffix = $Options{csuffix};
368 431         1116 my $cfile;
369 431 100       1781 if ( $Options{outfile} ) {
370 430         2126 $cfile = $Options{outfile};
371             }
372             else {
373 1         6 $cfile = $Options{filename};
374 1 50       23 $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
375             }
376 431         22157 tie(*PSEUDO_STDOUT, 'ExtUtils::ParseXS::CountLines', $cfile, $Options{output});
377 431         4062 select PSEUDO_STDOUT;
378             }
379             else {
380 2         50 select $Options{output};
381             }
382              
383 433         7794 $self->{typemaps_object} = process_typemaps( $Options{typemap}, $pwd );
384              
385 433         1774 $self->{config_strip_c_func_prefix} = $Options{s};
386 433         1658 $self->{config_allow_argtypes} = $Options{argtypes};
387 433         1561 $self->{config_allow_inout} = $Options{inout};
388 433         1627 $self->{config_allow_exceptions} = $Options{except};
389 433         1585 $self->{config_optimize} = $Options{optimize};
390              
391              
392             # Open the input file (using $self->{in_filename} which
393             # is a basename'd $Options{filename} due to chdir above)
394             {
395 433         780 my $fn = $self->{in_filename};
  433         4462  
396 433         1505 my $opfn = $Options{filename};
397 433 100       2011 $fn = $opfn if ref $opfn; # allow string ref as a source of file
398 433 50       11463 open($self->{in_fh}, '<', $fn)
399             or die "cannot open $self->{in_filename}: $!\n";
400             }
401              
402 433         11611 my $AST = $self->{AST} = ExtUtils::ParseXS::Node::XS_file->new();
403 433 50       5588 $AST->parse($self)
404             or $self->death("Failed to parse XS file\n");
405 371         1791 $AST->as_code($self);
406              
407 371         13241 chdir($orig_cwd);
408 371         3007 select($orig_fh);
409 371 100       2182 untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
410 371         1864 close $self->{in_fh};
411              
412 371         12463 return 1;
413             }
414              
415              
416             sub report_error_count {
417 2 100   2 1 860966 if (@_) {
418 1   50     6 return $_[0]->{error_count}||0;
419             }
420             else {
421 1   50     40 return $Singleton->{error_count}||0;
422             }
423             }
424             *errors = \&report_error_count;
425              
426              
427             # ST(): helper function for the various INPUT / OUTPUT code emitting
428             # parts. Generate an "ST(n)" string. This is normally just:
429             #
430             # "ST(". $num - 1 . ")"
431             #
432             # except that in input processing it is legal to have a parameter with a
433             # typemap override, but where the parameter isn't in the signature. People
434             # misuse this to declare other variables which should really be in a
435             # PREINIT section:
436             #
437             # int
438             # foo(a)
439             # int a
440             # int b = 0
441             #
442             # The '= 0' will be interpreted as a local typemap entry, so $arg etc
443             # will be populated and the "typemap" evalled, So $num is undef, but we
444             # shouldn't emit a warning when generating "ST(N-1)".
445             #
446             sub ST {
447 1793     1793 0 3230 my ($self, $num) = @_;
448 1793 100       5985 return "ST(" . ($num-1) . ")" if defined $num;
449 645         1959 return '/* not a parameter */';
450             }
451              
452              
453             # Quote a command-line to be suitable for VMS
454              
455             sub QuoteArgs {
456 0     0 0 0 my $cmd = shift;
457 0         0 my @args = split /\s+/, $cmd;
458 0         0 $cmd = shift @args;
459 0         0 for (@args) {
460 0 0 0     0 $_ = q(").$_.q(") if !/^\"/ && length($_) > 0;
461             }
462 0         0 return join (' ', ($cmd, @args));
463             }
464              
465              
466             # _safe_quote(): quote an executable pathname which includes spaces.
467             #
468             # This code was copied from CPAN::HandleConfig::safe_quote:
469             # that has doc saying leave if start/finish with same quote, but no code
470             # given text, will conditionally quote it to protect from shell
471              
472             {
473             my ($quote, $use_quote) = $^O eq 'MSWin32'
474             ? (q{"}, q{"})
475             : (q{"'}, q{'});
476             sub _safe_quote {
477 3     3   19 my ($self, $command) = @_;
478             # Set up quote/default quote
479 3 50 33     49 if (defined($command)
      33        
480             and $command =~ /\s/
481             and $command !~ /[$quote]/) {
482 0         0 return qq{$use_quote$command$use_quote}
483             }
484 3         17 return $command;
485             }
486             }
487              
488              
489             # Unescape a string (typically a heredoc):
490             # - strip leading ' |' (any number of leading spaces)
491             # - and replace [[ and ]]
492             # with { and }
493             # so that text editors don't see a bare { or } when bouncing around doing
494             # brace level matching.
495              
496             sub Q {
497 4232     4232 0 136990 my ($text) = @_;
498 4232         26044 my @lines = split /^/, $text;
499 4232         5251 my $first;
500 4232         6527 for (@lines) {
501 79653 50       184161 unless (s/^(\s*)\|//) {
502 0         0 die "Internal error: no leading '|' in Q() string:\n$_\n";
503             }
504 79653         100862 my $pre = $1;
505 79653 50       116978 die "Internal error: leading tab char in Q() string:\n$_\n"
506             if $pre =~ /\t/;
507              
508 79653 100       94205 if (defined $first) {
509 75422 50       109326 die "Internal error: leading indents in Q() string don't match:\n$_\n"
510             if $pre ne $first;
511             }
512             else {
513 4231         7025 $first = $pre;
514             }
515             }
516 4232         17895 $text = join "", @lines;
517              
518 4232         6615 $text =~ s/\[\[/{/g;
519 4232         5312 $text =~ s/\]\]/}/g;
520 4232         23902 $text;
521             }
522              
523              
524             # fetch_para(): private helper method for Node::cpp_scope::parse().
525             #
526             # Read in all the lines associated with the next XSUB, BOOT or TYPEMAP,
527             # or associated with the next contiguous block of file-scoped XS or
528             # C-preprocessor directives. The caller relies on the paragraph
529             # demarcation to indicate the end of the XSUB, TYPEMAP or BOOT. For other
530             # types of line, it doesn't matter how they are split.
531             #
532             # More precisely, it reads lines (and their line numbers) up to (but not
533             # including) the start of the next XSUB or similar, into:
534             #
535             # @{ $self->{line} }
536             # @{ $self->{line_no} }
537             #
538             # It skips lines which contain POD or XS comments.
539             #
540             # It assumes that, on entry, $self->{lastline} contains the next line to
541             # process, and that further lines can be read from $self->{in_fh} as
542             # necessary. On return, it leaves the first unprocessed line in
543             # $self->{lastline}: typically the first line of the next XSUB. At EOF,
544             # lastline will be left undef and fetch_para() returns false.
545             #
546             # Multiple lines which are read in that end in '\' are concatenated
547             # together into a single line, whose line number is set to
548             # their first line. The two characters '\' and '\n' are kept in the
549             # concatenated string.
550             #
551             # In general, it stops just before the first line which matches /^\S/ and
552             # which was preceded by a blank line. This line is often the start of the
553             # next XSUB (but there is no guarantee of that).
554             #
555             # For example, given these lines:
556             #
557             # | ....
558             # | stuff
559             # | [blank line]
560             # |PROTOTYPES: ENABLE
561             # |#define FOO 1
562             # |PHASER DISCOMBOBULARISE
563             # |#define BAR 1
564             # | [blank line]
565             # |int
566             # |foo(...)
567             # | ....
568             #
569             # then the first call will return everything up to 'stuff' inclusive
570             # (perhaps it's the last line of an XSUB). The next call will return four
571             # lines containing the XS directives and CPP definitions. The directives
572             # are not interpreted or processed by this function; they're just returned
573             # as unprocessed text for the caller to interpret. A third call will read
574             # in the XSUB starting at 'int'.
575             #
576             # Note that fetch_para() knows almost nothing about C or XS syntax and
577             # keywords, and just blindly reads in lines until it finds a suitable
578             # place to break. It generally relies on the caller to handle most of the
579             # syntax and semantics and error reporting. For example, the block of four
580             # lines above from 'PROTOTYPES:' onwards isn't valid XS, but is blindly
581             # returned by fetch_para().
582             #
583             # It often returns zero lines - the caller will have to handle this.
584             #
585             # The following items are handled specially by fetch_para().
586             #
587             # POD: Discard all lines between /^='/../^=cut/, then continue.
588             #
589             # #comment Discard any line starting with /^\s*#/ which doesn't look
590             # like a C preprocessor directive,
591             #
592             # TYPEMAP: Return the typemap 'heredoc' lines as a paragraph, but with
593             # the final line (e.g. "EOF") missing. Line continuations,
594             # i.e. '\' aren't processed.
595             #
596             # BOOT: BOOT is NOT handled specially; the normal rules for ending
597             # a paragraph will determine where the BOOT code ends.
598             #
599             # #if etc: C preprocessor conditional directives are analysed to
600             # determine whether they are internal or external to the
601             # current paragraph. This allows XSUBs and similar to be
602             # closely cuddled by #if/#endif etc without needing to be
603             # separated by a blank line. Typically, any such directives
604             # immediately preceding an XSUB will be returned as one-line
605             # paragraphs.
606             #
607             # Note that this CPP-line analysis is completely independent
608             # of a similar analysis done in Node::cpp_scope::parse(),
609             # which is concerned with splitting the tree into separate
610             # sections where multiple XSUBs with the same name can appear.
611             #
612             # CPP directives (like #define) which aren't concerned with
613             # conditions are just passed through without any analysis.
614             #
615             # It removes any trailing blank lines from the list of returned lines.
616              
617              
618             sub fetch_para {
619 2050     2050 0 3343 my ExtUtils::ParseXS $self = shift;
620              
621 2050 100       5508 return 0 if not defined $self->{lastline}; # EOF
622              
623 1674         2248 @{ $self->{line} } = ();
  1674         3007  
624 1674         2151 @{ $self->{line_no} } = ();
  1674         3012  
625              
626 1674         2733 my $if_level = 0; # current depth of #if/#endif nesting
627              
628             # Main loop: for each iteration, process the current line,
629             # then maybe read in the next line and continue. Handle some special
630             # cases like POD in their own little loop which may read multiple
631             # lines.
632              
633 1674         1920 for (;;) {
634              
635 4903         5225 my $final; # if true, end loop after reading in the next line
636              
637              
638             # Skip an embedded POD section
639              
640 4903 100       10207 if ($self->{lastline} =~ /^=/) {
641 3         10 while ($self->{lastline} = readline($self->{in_fh})) {
642 6 100       18 last if ($self->{lastline} =~ /^=cut\s*$/);
643             }
644             $self->death("Error: Unterminated pod")
645 3 50       6 unless defined $self->{lastline};
646 3         18 goto read_next_line;
647             }
648              
649              
650             # If present, extract out a TYPEMAP block as a paragraph
651 4900 100       9462 if ($self->{lastline} =~ /^TYPEMAP\s*:/) {
652              
653             # Return what we have already and process this line on the
654             # next call; that way something like a previous BOOT: won't
655             # run on into the TYPEMAP: lines
656 336 100       617 last if @{$self->{line}};
  336         1134  
657              
658             $self->{lastline} =~
659 168 100       1458 /^TYPEMAP\s*:\s*<<\s*(?:(["'])(.+?)\1|([^\s'"]+?))\s*;?\s*$/
660             or $self->death("Error: unparseable TYPEMAP line: '$self->{lastline}'");
661              
662 167 100       2035 my $end_marker = quotemeta(defined($1) ? $2 : $3);
663              
664             # Add the 'TYPEMAP:' line
665 167         321 push @{$self->{line}}, $self->{lastline};
  167         499  
666 167         310 push @{$self->{line_no}}, $.;
  167         506  
667              
668             # Accumulate lines until we find $end_marker alone on a line.
669 167         962 while ($self->{lastline} = readline($self->{in_fh})) {
670 1966 100       6436 last if $self->{lastline} =~ /^$end_marker\s*$/;
671 1799         2305 chomp $self->{lastline};
672 1799         1959 push @{$self->{line}}, $self->{lastline};
  1799         3015  
673 1799         1930 push @{$self->{line_no}}, $.;
  1799         4306  
674             }
675             $self->death("Error: Unterminated TYPEMAP section")
676 167 50       496 unless defined $self->{lastline};
677 167         274 $final = 1;
678 167         1974 goto read_next_line;
679             }
680              
681              
682             # Strip code comment lines
683              
684 4564 100 100     10182 if ($self->{lastline} =~ /^\s*#/
685             # CPP directives:
686             # ANSI: if ifdef ifndef elif else endif define undef
687             # line error pragma
688             # gcc: warning include_next
689             # obj-c: import
690             # others: ident (gcc notes that some cpps have this one)
691             && $self->{lastline} !~ /^\#[ \t]*
692             (?:
693             (?:if|ifn?def|elif|else|endif|elifn?def|
694             define|undef|pragma|error|
695             warning|line\s+\d+|ident)
696             \b
697             | (?:include(?:_next)?|import)
698             \s* ["<] .* [>"]
699             )
700             /x
701             ) {
702             # A line starting with # but not a CPP directive?
703             # Must be a code comment. Skip it.
704 7         33 goto read_next_line;
705             }
706              
707              
708             # Blank line followed by char in column 1. Start of next XSUB?
709              
710             last if $self->{lastline} =~ /^\S/
711 2769         10747 && @{ $self->{line} }
712 4557 100 100     12899 && $self->{line}->[-1] eq "";
      100        
713              
714              
715             # Must be a general line (e.g. file-scoped keyword or CPP directive):
716             # process it.
717              
718             # Analyse a CPP conditional line and if appropriate, make this line
719             # the last line of the current paragraph, or the first line of the
720             # next paragraph.
721              
722 3687 100       6812 if ($self->{lastline}
723             =~/^#[ \t]*(if|ifn?def|elif|else|endif|elifn?def)\b/)
724             {
725             # Allow a CPP conditional to directly precede or follow an XSUB
726             # without the usual required blank line, e.g.
727             #
728             # #if X
729             # void foo()
730             # CODE:
731             # ...
732             # # if Y
733             # ...
734             # # endif
735             # ...
736             # #else
737             # ...
738             #
739             # This is achieved by keeping track of CPP conditional nesting, to
740             # determine whether the conditional (e.g. the #else above) is part
741             # of the current paragraph, or is paired with something outside it.
742             # In this example, the #if Y / #endif are internal to the paragraph,
743             # while the #else is external and therefore indicates the end of the
744             # current paragraph and so we should stop, even though "\n\n\S"
745             # hasn't been encountered.
746             #
747             # Similarly we stop at the external '#if X', although here it is
748             # trickier to distinguish internal from external. For #if's, we
749             # achieve this by stopping if the #if is the first line in the
750             # putative paragraph; otherwise treat it as internal.
751              
752 50         116 my $type = $1;
753              
754 50 100       92 if (!@{$self->{line}}) {
  50         115  
755             # Treat a conditional starting the paragraph as a one-line
756             # paragraph
757 40         96 $final = 1;
758             }
759             else {
760             # Handle conditionals appearing in, or just after, an XSUB
761              
762 10 50       38 $if_level++ if $type =~ /^if/; # if, ifdef, ifndef
763             # If we're in a conditional that didn't start in this paragraph,
764             # return everything up to, but not including, this line, which
765             # will instead form the first line of the *next* paragraph
766 10 50       48 return 1 if !$if_level;
767 0 0       0 $if_level-- if $type eq "endif";
768             }
769             }
770              
771 3677         4132 push(@{ $self->{line} }, $self->{lastline});
  3677         7308  
772 3677         4375 push(@{ $self->{line_no} }, $self->{lastline_no});
  3677         5925  
773              
774              
775             read_next_line:
776             # Read next line and any continuation lines into $self->{lastline_no},
777             # ready for the next iteration, or if $final, to be ready for the next
778             # call to fetch_para().
779              
780 3854 100       17477 last unless defined($self->{lastline} = readline($self->{in_fh}));
781 3425         5838 $self->{lastline_no} = $.;
782 3425         4092 my $tmp_line;
783             $self->{lastline} .= $tmp_line
784 3425   66     7867 while ($self->{lastline} =~ /\\$/ && defined($tmp_line = readline($self->{in_fh})));
785              
786 3425         4612 chomp $self->{lastline};
787 3425         7272 $self->{lastline} =~ s/^\s+$//;
788 3425 100       5810 if ($final) {
789 196         336 last;
790             }
791             } # end for (;;)
792              
793             # Nuke trailing "line" entries until there's one that's not empty
794 1084         2020 pop(@{ $self->{line} }), pop(@{ $self->{line_no} })
  1084         2315  
795 1663   100     2448 while @{ $self->{line} } && $self->{line}->[-1] eq "";
  2747         9981  
796              
797 1663         5814 return 1;
798             }
799              
800              
801             # These two subs just delegate to a method in a clean package, where there
802             # are as few lexical variables in scope as possible and the ones which are
803             # accessible (such as $arg) are the ones documented to be available when
804             # eval()ing (in double-quoted context) the initialiser on an INPUT or
805             # OUTPUT line such as 'int foo = SvIV($arg)'
806              
807             sub eval_output_typemap_code {
808 282     282 0 464 my ExtUtils::ParseXS $self = shift;
809 282         580 my ($code, $other) = @_;
810 282         1018 return ExtUtils::ParseXS::Eval::eval_output_typemap_code($self, $code, $other);
811             }
812              
813             sub eval_input_typemap_code {
814 435     435 0 625 my ExtUtils::ParseXS $self = shift;
815 435         790 my ($code, $other) = @_;
816 435         1762 return ExtUtils::ParseXS::Eval::eval_input_typemap_code($self, $code, $other);
817             }
818              
819             1;
820              
821             # vim: ts=2 sw=2 et: