This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid conflicting static / dllexport on legacy perls too
[perl5.git] / dist / ExtUtils-ParseXS / lib / ExtUtils / ParseXS / Utilities.pm
CommitLineData
a65c06db
SM
1package ExtUtils::ParseXS::Utilities;
2use strict;
3use warnings;
4use Exporter;
f3aadd09 5use File::Spec;
547742ac
JK
6use lib qw( lib );
7use ExtUtils::ParseXS::Constants ();
8226b442 8
e3ec0a15 9our $VERSION = '3.06';
71a65ad3 10
a65c06db
SM
11our (@ISA, @EXPORT_OK);
12@ISA = qw(Exporter);
13@EXPORT_OK = qw(
14 standard_typemap_locations
1d40e528 15 trim_whitespace
73e91d5a 16 tidy_type
c1e43162 17 C_string
547742ac 18 valid_proto_string
50b96cc2 19 process_typemaps
af4112ab 20 make_targetable
0ec7450c 21 map_type
6c2c48aa 22 standard_XS_defs
362926c8 23 assign_func_args
361d4be6 24 analyze_preprocessor_statements
40a3ae2f 25 set_cond
2a09a23f 26 Warn
21edc85a 27 current_line_number
2a09a23f
JK
28 blurt
29 death
30 check_conditional_preprocessor_statements
a65c06db
SM
31);
32
f3aadd09
SM
33=head1 NAME
34
35ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
36
37=head1 SYNOPSIS
38
39 use ExtUtils::ParseXS::Utilities qw(
40 standard_typemap_locations
1d40e528 41 trim_whitespace
73e91d5a 42 tidy_type
3f0c8333
JK
43 C_string
44 valid_proto_string
45 process_typemaps
46 make_targetable
e70aab19
JK
47 map_type
48 standard_XS_defs
49 assign_func_args
50 analyze_preprocessor_statements
51 set_cond
52 Warn
53 blurt
54 death
55 check_conditional_preprocessor_statements
f3aadd09
SM
56 );
57
58=head1 SUBROUTINES
59
60The following functions are not considered to be part of the public interface.
61They are documented here for the benefit of future maintainers of this module.
62
63=head2 C<standard_typemap_locations()>
64
65=over 4
66
67=item * Purpose
68
69Provide a list of filepaths where F<typemap> files may be found. The
70filepaths -- relative paths to files (not just directory paths) -- appear in this list in lowest-to-highest priority.
71
72The highest priority is to look in the current directory.
73
74 'typemap'
75
76The second and third highest priorities are to look in the parent of the
77current directory and a directory called F<lib/ExtUtils> underneath the parent
78directory.
79
80 '../typemap',
81 '../lib/ExtUtils/typemap',
82
83The fourth through ninth highest priorities are to look in the corresponding
84grandparent, great-grandparent and great-great-grandparent directories.
85
86 '../../typemap',
87 '../../lib/ExtUtils/typemap',
88 '../../../typemap',
89 '../../../lib/ExtUtils/typemap',
90 '../../../../typemap',
91 '../../../../lib/ExtUtils/typemap',
92
93The tenth and subsequent priorities are to look in directories named
94F<ExtUtils> which are subdirectories of directories found in C<@INC> --
95I<provided> a file named F<typemap> actually exists in such a directory.
96Example:
97
98 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
99
100However, these filepaths appear in the list returned by
101C<standard_typemap_locations()> in reverse order, I<i.e.>, lowest-to-highest.
102
103 '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
104 '../../../../lib/ExtUtils/typemap',
105 '../../../../typemap',
106 '../../../lib/ExtUtils/typemap',
107 '../../../typemap',
108 '../../lib/ExtUtils/typemap',
109 '../../typemap',
110 '../lib/ExtUtils/typemap',
111 '../typemap',
112 'typemap'
113
114=item * Arguments
115
116 my @stl = standard_typemap_locations( \@INC );
117
118Reference to C<@INC>.
119
120=item * Return Value
121
122Array holding list of directories to be searched for F<typemap> files.
123
124=back
125
126=cut
127
a65c06db
SM
128sub standard_typemap_locations {
129 my $include_ref = shift;
a65c06db
SM
130 my @tm = qw(typemap);
131
f3aadd09
SM
132 my $updir = File::Spec->updir();
133 foreach my $dir (
134 File::Spec->catdir(($updir) x 1),
135 File::Spec->catdir(($updir) x 2),
136 File::Spec->catdir(($updir) x 3),
137 File::Spec->catdir(($updir) x 4),
138 ) {
a65c06db
SM
139 unshift @tm, File::Spec->catfile($dir, 'typemap');
140 unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
141 }
142 foreach my $dir (@{ $include_ref}) {
143 my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
144 unshift @tm, $file if -e $file;
145 }
146 return @tm;
147}
148
1d40e528
JK
149=head2 C<trim_whitespace()>
150
151=over 4
152
153=item * Purpose
154
155Perform an in-place trimming of leading and trailing whitespace from the
156first argument provided to the function.
157
158=item * Argument
159
160 trim_whitespace($arg);
161
162=item * Return Value
163
164None. Remember: this is an I<in-place> modification of the argument.
165
166=back
167
168=cut
169
170sub trim_whitespace {
171 $_[0] =~ s/^\s+|\s+$//go;
172}
173
73e91d5a
JK
174=head2 C<tidy_type()>
175
176=over 4
177
178=item * Purpose
179
180Rationalize any asterisks (C<*>) by joining them into bunches, removing
181interior whitespace, then trimming leading and trailing whitespace.
182
183=item * Arguments
184
185 ($ret_type) = tidy_type($_);
186
187String to be cleaned up.
188
189=item * Return Value
190
191String cleaned up.
192
193=back
194
195=cut
196
197sub tidy_type {
198 local ($_) = @_;
199
200 # rationalise any '*' by joining them into bunches and removing whitespace
201 s#\s*(\*+)\s*#$1#g;
202 s#(\*+)# $1 #g;
203
204 # change multiple whitespace into a single space
205 s/\s+/ /g;
206
207 # trim leading & trailing whitespace
208 trim_whitespace($_);
209
210 $_;
211}
212
c1e43162
JK
213=head2 C<C_string()>
214
215=over 4
216
217=item * Purpose
218
219Escape backslashes (C<\>) in prototype strings.
220
221=item * Arguments
222
223 $ProtoThisXSUB = C_string($_);
224
225String needing escaping.
226
227=item * Return Value
228
229Properly escaped string.
230
231=back
232
233=cut
234
235sub C_string {
236 my($string) = @_;
237
238 $string =~ s[\\][\\\\]g;
239 $string;
240}
241
547742ac
JK
242=head2 C<valid_proto_string()>
243
244=over 4
245
246=item * Purpose
247
248Validate prototype string.
249
250=item * Arguments
251
252String needing checking.
253
254=item * Return Value
255
256Upon success, returns the same string passed as argument.
257
258Upon failure, returns C<0>.
259
260=back
261
262=cut
263
264sub valid_proto_string {
265 my($string) = @_;
266
0a4f6920 267 if ( $string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/ ) {
547742ac
JK
268 return $string;
269 }
270
271 return 0;
272}
50b96cc2
JK
273
274=head2 C<process_typemaps()>
275
276=over 4
277
278=item * Purpose
279
280Process all typemap files.
281
282=item * Arguments
283
147664ce 284 my $typemaps_object = process_typemaps( $args{typemap}, $pwd );
50b96cc2
JK
285
286List of two elements: C<typemap> element from C<%args>; current working
287directory.
288
289=item * Return Value
290
69b19f32 291Upon success, returns an L<ExtUtils::Typemaps> object.
50b96cc2
JK
292
293=back
294
295=cut
296
297sub process_typemaps {
298 my ($tmap, $pwd) = @_;
299
300 my @tm = ref $tmap ? @{$tmap} : ($tmap);
301
302 foreach my $typemap (@tm) {
303 die "Can't find $typemap in $pwd\n" unless -r $typemap;
304 }
305
306 push @tm, standard_typemap_locations( \@INC );
307
5a784a65 308 require ExtUtils::Typemaps;
7b40ff23
SM
309 my $typemap = ExtUtils::Typemaps->new;
310 foreach my $typemap_loc (@tm) {
311 next unless -f $typemap_loc;
50b96cc2 312 # skip directories, binary files etc.
7b40ff23
SM
313 warn("Warning: ignoring non-text typemap file '$typemap_loc'\n"), next
314 unless -T $typemap_loc;
315
316 $typemap->merge(file => $typemap_loc, replace => 1);
bb5e8eb4 317 }
7b40ff23 318
69b19f32 319 return $typemap;
bb5e8eb4
JK
320}
321
af4112ab
JK
322=head2 C<make_targetable()>
323
324=over 4
325
326=item * Purpose
327
ddf4d752
JK
328Populate C<%targetable>. This constitutes a refinement of the output of
329C<process_typemaps()> with respect to its fourth output, C<$output_expr_ref>.
af4112ab
JK
330
331=item * Arguments
332
ddf4d752 333 %targetable = make_targetable($output_expr_ref);
af4112ab 334
ddf4d752 335Single hash reference: the fourth such ref returned by C<process_typemaps()>.
af4112ab
JK
336
337=item * Return Value
338
339Hash.
340
341=back
342
343=cut
344
345sub make_targetable {
346 my $output_expr_ref = shift;
59732b25
SM
347
348 our $bal; # ()-balanced
349 $bal = qr[
350 (?:
351 (?>[^()]+)
352 |
353 \( (??{ $bal }) \)
354 )*
355 ]x;
356
357 # matches variations on (SV*)
358 my $sv_cast = qr[
359 (?:
360 \( \s* SV \s* \* \s* \) \s*
361 )?
362 ]x;
363
364 my $size = qr[ # Third arg (to setpvn)
365 , \s* (??{ $bal })
366 ]x;
af4112ab
JK
367
368 my %targetable;
369 foreach my $key (keys %{ $output_expr_ref }) {
370 # We can still bootstrap compile 're', because in code re.pm is
371 # available to miniperl, and does not attempt to load the XS code.
372 use re 'eval';
373
59732b25 374 my ($type, $with_size, $arg, $sarg) =
af4112ab 375 ($output_expr_ref->{$key} =~
59732b25
SM
376 m[^
377 \s+
378 sv_set([iunp])v(n)? # Type, is_setpvn
379 \s*
380 \( \s*
381 $sv_cast \$arg \s* , \s*
382 ( (??{ $bal }) ) # Set from
af4112ab
JK
383 ( (??{ $size }) )? # Possible sizeof set-from
384 \) \s* ; \s* $
385 ]x
386 );
59732b25 387 $targetable{$key} = [$type, $with_size, $arg, $sarg] if $type;
af4112ab
JK
388 }
389 return %targetable;
390}
391
361d4be6
JK
392=head2 C<map_type()>
393
394=over 4
395
396=item * Purpose
397
398Performs a mapping at several places inside C<PARAGRAPH> loop.
399
400=item * Arguments
401
402 $type = map_type($self, $type, $varname);
403
404List of three arguments.
405
406=item * Return Value
407
408String holding augmented version of second argument.
409
410=back
411
412=cut
413
0ec7450c 414sub map_type {
361d4be6 415 my ($self, $type, $varname) = @_;
0ec7450c
JK
416
417 # C++ has :: in types too so skip this
361d4be6 418 $type =~ tr/:/_/ unless $self->{hiertype};
0ec7450c
JK
419 $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
420 if ($varname) {
421 if ($type =~ / \( \s* \* (?= \s* \) ) /xg) {
422 (substr $type, pos $type, 0) = " $varname ";
423 }
424 else {
425 $type .= "\t$varname";
426 }
427 }
428 return $type;
429}
430
361d4be6
JK
431=head2 C<standard_XS_defs()>
432
433=over 4
434
435=item * Purpose
436
437Writes to the C<.c> output file certain preprocessor directives and function
438headers needed in all such files.
439
440=item * Arguments
441
442None.
443
444=item * Return Value
445
31d4f0b1 446Returns true.
361d4be6
JK
447
448=back
449
450=cut
451
6c2c48aa
JK
452sub standard_XS_defs {
453 print <<"EOF";
454#ifndef PERL_UNUSED_VAR
455# define PERL_UNUSED_VAR(var) if (0) var = var
456#endif
457
98e61122
NC
458#ifndef dVAR
459# define dVAR dNOOP
460#endif
461
a62da8e6
SM
462
463/* This stuff is not part of the API! You have been warned. */
464#ifndef PERL_VERSION_DECIMAL
465# define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
466#endif
467#ifndef PERL_DECIMAL_VERSION
468# define PERL_DECIMAL_VERSION \\
469 PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
470#endif
471#ifndef PERL_VERSION_GE
472# define PERL_VERSION_GE(r,v,s) \\
473 (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
474#endif
475#ifndef PERL_VERSION_LE
476# define PERL_VERSION_LE(r,v,s) \\
477 (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
478#endif
479
480/* XS_INTERNAL is the explicit static-linkage variant of the default
481 * XS macro.
482 *
483 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
484 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
485 * for anything but the BOOT XSUB.
486 *
487 * See XSUB.h in core!
488 */
489
490
491/* TODO: This might be compatible further back than 5.10.0. */
492#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
493# undef XS_EXTERNAL
494# undef XS_INTERNAL
495# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
496# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
3928a66a 497# define XS_INTERNAL(name) STATIC XSPROTO(name)
a62da8e6
SM
498# endif
499# if defined(__SYMBIAN32__)
500# define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
501# define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
502# endif
503# ifndef XS_EXTERNAL
504# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
505# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
506# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
507# else
508# ifdef __cplusplus
509# define XS_EXTERNAL(name) extern "C" XSPROTO(name)
510# define XS_INTERNAL(name) static XSPROTO(name)
511# else
512# define XS_EXTERNAL(name) XSPROTO(name)
513# define XS_INTERNAL(name) STATIC XSPROTO(name)
514# endif
515# endif
516# endif
517#endif
518
519/* perl >= 5.10.0 && perl <= 5.15.1 */
520
521
522/* The XS_EXTERNAL macro is used for functions that must not be static
e9510e8f
SM
523 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
524 * macro defined, the best we can do is assume XS is the same.
a62da8e6 525 * Dito for XS_INTERNAL.
e9510e8f
SM
526 */
527#ifndef XS_EXTERNAL
528# define XS_EXTERNAL(name) XS(name)
529#endif
a62da8e6
SM
530#ifndef XS_INTERNAL
531# define XS_INTERNAL(name) XS(name)
532#endif
533
534/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
535 * internal macro that we're free to redefine for varying linkage due
536 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
537 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
538 */
539
a62da8e6 540#undef XS_EUPXS
ca0e6506
SM
541#if defined(PERL_EUPXS_ALWAYS_EXPORT)
542# define XS_EUPXS(name) XS_EXTERNAL(name)
543#else
544 /* default to internal */
545# define XS_EUPXS(name) XS_INTERNAL(name)
546#endif
a62da8e6 547
6c2c48aa
JK
548EOF
549
550 print <<"EOF";
551#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
552#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
553
554/* prototype to pass -Wmissing-prototypes */
555STATIC void
556S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
557
558STATIC void
559S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
560{
561 const GV *const gv = CvGV(cv);
562
563 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
564
565 if (gv) {
566 const char *const gvname = GvNAME(gv);
567 const HV *const stash = GvSTASH(gv);
568 const char *const hvname = stash ? HvNAME(stash) : NULL;
569
570 if (hvname)
571 Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
572 else
573 Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
574 } else {
575 /* Pants. I don't think that it should be possible to get here. */
576 Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
577 }
578}
579#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
580
581#ifdef PERL_IMPLICIT_CONTEXT
582#define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b)
583#else
584#define croak_xs_usage S_croak_xs_usage
585#endif
586
587#endif
588
589/* NOTE: the prototype of newXSproto() is different in versions of perls,
590 * so we define a portable version of newXSproto()
591 */
592#ifdef newXS_flags
593#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
594#else
595#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
596#endif /* !defined(newXS_flags) */
597
598EOF
31d4f0b1 599 return 1;
6c2c48aa
JK
600}
601
361d4be6
JK
602=head2 C<assign_func_args()>
603
604=over 4
605
606=item * Purpose
607
608Perform assignment to the C<func_args> attribute.
609
610=item * Arguments
611
612 $string = assign_func_args($self, $argsref, $class);
613
614List of three elements. Second is an array reference; third is a string.
615
616=item * Return Value
617
618String.
619
620=back
621
622=cut
623
362926c8
JK
624sub assign_func_args {
625 my ($self, $argsref, $class) = @_;
626 my @func_args = @{$argsref};
627 shift @func_args if defined($class);
628
361d4be6
JK
629 for my $arg (@func_args) {
630 $arg =~ s/^/&/ if $self->{in_out}->{$arg};
362926c8
JK
631 }
632 return join(", ", @func_args);
633}
634
361d4be6
JK
635=head2 C<analyze_preprocessor_statements()>
636
637=over 4
638
639=item * Purpose
640
641Within each function inside each Xsub, print to the F<.c> output file certain
642preprocessor statements.
643
644=item * Arguments
645
646 ( $self, $XSS_work_idx, $BootCode_ref ) =
647 analyze_preprocessor_statements(
648 $self, $statement, $XSS_work_idx, $BootCode_ref
649 );
650
651List of four elements.
652
653=item * Return Value
654
655Modifed values of three of the arguments passed to the function. In
656particular, the C<XSStack> and C<InitFileCode> attributes are modified.
657
658=back
659
660=cut
661
662sub analyze_preprocessor_statements {
663 my ($self, $statement, $XSS_work_idx, $BootCode_ref) = @_;
1d3d7190 664
1d3d7190
JK
665 if ($statement eq 'if') {
666 $XSS_work_idx = @{ $self->{XSStack} };
667 push(@{ $self->{XSStack} }, {type => 'if'});
668 }
669 else {
55bee391 670 $self->death("Error: '$statement' with no matching 'if'")
1d3d7190
JK
671 if $self->{XSStack}->[-1]{type} ne 'if';
672 if ($self->{XSStack}->[-1]{varname}) {
673 push(@{ $self->{InitFileCode} }, "#endif\n");
674 push(@{ $BootCode_ref }, "#endif");
675 }
676
677 my(@fns) = keys %{$self->{XSStack}->[-1]{functions}};
678 if ($statement ne 'endif') {
679 # Hide the functions defined in other #if branches, and reset.
680 @{$self->{XSStack}->[-1]{other_functions}}{@fns} = (1) x @fns;
681 @{$self->{XSStack}->[-1]}{qw(varname functions)} = ('', {});
682 }
683 else {
684 my($tmp) = pop(@{ $self->{XSStack} });
685 0 while (--$XSS_work_idx
686 && $self->{XSStack}->[$XSS_work_idx]{type} ne 'if');
687 # Keep all new defined functions
688 push(@fns, keys %{$tmp->{other_functions}});
689 @{$self->{XSStack}->[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
690 }
691 }
692 return ($self, $XSS_work_idx, $BootCode_ref);
693}
694
361d4be6
JK
695=head2 C<set_cond()>
696
697=over 4
698
699=item * Purpose
700
701=item * Arguments
702
703=item * Return Value
704
705=back
706
707=cut
708
40a3ae2f
JK
709sub set_cond {
710 my ($ellipsis, $min_args, $num_args) = @_;
711 my $cond;
712 if ($ellipsis) {
713 $cond = ($min_args ? qq(items < $min_args) : 0);
714 }
715 elsif ($min_args == $num_args) {
716 $cond = qq(items != $min_args);
717 }
718 else {
719 $cond = qq(items < $min_args || items > $num_args);
720 }
721 return $cond;
722}
723
21edc85a 724=head2 C<current_line_number()>
5a784a65
SM
725
726=over 4
727
728=item * Purpose
729
730Figures out the current line number in the XS file.
731
732=item * Arguments
733
734C<$self>
735
736=item * Return Value
737
738The current line number.
739
740=back
741
742=cut
743
21edc85a 744sub current_line_number {
5a784a65
SM
745 my $self = shift;
746 my $line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
747 return $line_number;
748}
749
361d4be6
JK
750=head2 C<Warn()>
751
752=over 4
753
754=item * Purpose
755
756=item * Arguments
757
758=item * Return Value
759
760=back
761
762=cut
763
2a09a23f
JK
764sub Warn {
765 my $self = shift;
21edc85a 766 my $warn_line_number = $self->current_line_number();
2a09a23f
JK
767 print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
768}
769
361d4be6
JK
770=head2 C<blurt()>
771
772=over 4
773
774=item * Purpose
775
776=item * Arguments
777
778=item * Return Value
779
780=back
781
782=cut
783
2a09a23f
JK
784sub blurt {
785 my $self = shift;
5a784a65 786 $self->Warn(@_);
2a09a23f
JK
787 $self->{errors}++
788}
789
361d4be6
JK
790=head2 C<death()>
791
792=over 4
793
794=item * Purpose
795
796=item * Arguments
797
798=item * Return Value
799
800=back
801
802=cut
803
2a09a23f
JK
804sub death {
805 my $self = shift;
5a784a65 806 $self->Warn(@_);
2a09a23f
JK
807 exit 1;
808}
809
361d4be6
JK
810=head2 C<check_conditional_preprocessor_statements()>
811
812=over 4
813
814=item * Purpose
815
816=item * Arguments
817
818=item * Return Value
819
820=back
821
822=cut
823
2a09a23f
JK
824sub check_conditional_preprocessor_statements {
825 my ($self) = @_;
826 my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} });
827 if (@cpp) {
828 my $cpplevel;
829 for my $cpp (@cpp) {
830 if ($cpp =~ /^\#\s*if/) {
831 $cpplevel++;
832 }
833 elsif (!$cpplevel) {
5a784a65 834 $self->Warn("Warning: #else/elif/endif without #if in this function");
2a09a23f
JK
835 print STDERR " (precede it with a blank line if the matching #if is outside the function)\n"
836 if $self->{XSStack}->[-1]{type} eq 'if';
837 return;
838 }
839 elsif ($cpp =~ /^\#\s*endif/) {
840 $cpplevel--;
841 }
842 }
5a784a65 843 $self->Warn("Warning: #if without #endif in this function") if $cpplevel;
2a09a23f
JK
844 }
845}
e6de4093 846
a65c06db 8471;
27b7514f
JK
848
849# vim: ts=2 sw=2 et: