From e6de40936eb8d0ce01b0a0bdac9dd0fd31c8130e Mon Sep 17 00:00:00 2001 From: "James E. Keenan" Date: Sun, 11 Apr 2010 10:35:40 -0400 Subject: [PATCH] Change check_cpp() to check_conditional_preprocessor_statements() ... to be more self-documenting. Also: Explicitly pass $self to Warn(), blurt() and death(). Add skeletons of files to test functions moved (or planned to be moved) to Utilities.pm. --- MANIFEST | 7 ++ dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 120 +++++++++++---------- .../lib/ExtUtils/ParseXS/Utilities.pm | 24 +++++ dist/ExtUtils-ParseXS/t/107-make_targetable.t | 14 +++ dist/ExtUtils-ParseXS/t/108-map_type.t | 14 +++ dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t | 14 +++ dist/ExtUtils-ParseXS/t/110-assign_func_args.t | 14 +++ .../t/111-print_preprocessor_statements.t | 14 +++ dist/ExtUtils-ParseXS/t/112-set_cond.t | 14 +++ .../t/113-check_cond_preproc_statements.t | 78 ++++++++++++++ 10 files changed, 256 insertions(+), 57 deletions(-) create mode 100644 dist/ExtUtils-ParseXS/t/107-make_targetable.t create mode 100644 dist/ExtUtils-ParseXS/t/108-map_type.t create mode 100644 dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t create mode 100644 dist/ExtUtils-ParseXS/t/110-assign_func_args.t create mode 100644 dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t create mode 100644 dist/ExtUtils-ParseXS/t/112-set_cond.t create mode 100644 dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t diff --git a/MANIFEST b/MANIFEST index 90796b0..577eb58 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2988,6 +2988,13 @@ dist/ExtUtils-ParseXS/t/103-tidy_type.t ExtUtils::ParseXS tests dist/ExtUtils-ParseXS/t/104-map_type.t ExtUtils::ParseXS tests dist/ExtUtils-ParseXS/t/105-valid_proto_string.t ExtUtils::ParseXS tests dist/ExtUtils-ParseXS/t/106-process_typemaps.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/107-make_targetable.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/108-map_type.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/110-assign_func_args.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/112-set_cond.t ExtUtils::ParseXS tests +dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t ExtUtils::ParseXS tests dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm ExtUtils::ParseXS testing utility dist/ExtUtils-ParseXS/t/pseudotypemap1 A test-typemap dist/ExtUtils-ParseXS/t/typemap Standard typemap for controlled testing diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index d65051e..f6b3333 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -24,6 +24,7 @@ use ExtUtils::ParseXS::Utilities qw( print_preprocessor_statements set_cond ); +# check_conditional_preprocessor_statements our @ISA = qw(Exporter); our @EXPORT_OK = qw( @@ -283,9 +284,10 @@ EOM $self->{XSStack}->[$XSS_work_idx]{varname} = $cpp_next_tmp++; } - death ("Code is not inside a function" - ." (maybe last function was ended by a blank line " - ." followed by a statement on column one?)") + death( $self, + "Code is not inside a function" + ." (maybe last function was ended by a blank line " + ." followed by a statement on column one?)") if $self->{line}->[0] =~ /^\s/; # initialize info arrays @@ -317,7 +319,7 @@ EOM } if (check_keyword("BOOT")) { - check_cpp($self); + check_conditional_preprocessor_statements($self); push (@{ $BootCode_ref }, "#line $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} }] \"$self->{filepathname}\"") if $self->{WantLineNumbers} && $self->{line}->[0] !~ /^\s*#\s*line\b/; push (@{ $BootCode_ref }, @{ $self->{line} }, ""); @@ -334,14 +336,14 @@ EOM and $self->{ret_type} =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s; # a function definition needs at least 2 lines - blurt ("Error: Function definition too short '$self->{ret_type}'"), next PARAGRAPH + blurt( $self, "Error: Function definition too short '$self->{ret_type}'"), next PARAGRAPH unless @{ $self->{line} }; my $externC = 1 if $self->{ret_type} =~ s/^extern "C"\s+//; my $static = 1 if $self->{ret_type} =~ s/^static\s+//; my $func_header = shift(@{ $self->{line} }); - blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH + blurt( $self, "Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s; my ($class, $orig_args); @@ -358,7 +360,7 @@ EOM # Check for duplicate function definition for my $tmp (@{ $self->{XSStack} }) { next unless defined $tmp->{functions}{$Full_func_name}; - Warn("Warning: duplicate function definition '$clean_func_name' detected"); + Warn( $self, "Warning: duplicate function definition '$clean_func_name' detected"); last; } $self->{XSStack}->[$XSS_work_idx]{functions}{$Full_func_name}++; @@ -419,7 +421,7 @@ EOM } else { @args = split(/\s*,\s*/, $orig_args); - Warn("Warning: cannot parse argument list '$orig_args', fallback to split"); + Warn( $self, "Warning: cannot parse argument list '$orig_args', fallback to split"); } } else { @@ -563,7 +565,7 @@ EOF push(@{ $self->{line} }, "$END:"); push(@{ $self->{line_no} }, $self->{line_no}->[-1]); $_ = ''; - check_cpp($self); + check_conditional_preprocessor_statements($self); while (@{ $self->{line} }) { CASE_handler() if check_keyword("CASE"); print Q(<<"EOF"); @@ -636,7 +638,7 @@ EOF if (check_keyword("PPCODE")) { print_section(); - death ("PPCODE must be last thing") if @{ $self->{line} }; + death( $self, "PPCODE must be last thing") if @{ $self->{line} }; print "\tLEAVE;\n" if $self->{ScopeThisXSUB}; print "\tPUTBACK;\n\treturn;\n"; } @@ -777,13 +779,14 @@ EOF # ENDHANDLERS EOF if (check_keyword("CASE")) { - blurt ("Error: No `CASE:' at top of function") + blurt( $self, "Error: No `CASE:' at top of function") unless $self->{condnum}; $_ = "CASE: $_"; # Restore CASE: label next; } last if $_ eq "$END:"; - death(/^$self->{BLOCK_re}/o ? "Misplaced `$1:'" : "Junk at end of function ($_)"); + death( $self, + /^$self->{BLOCK_re}/o ? "Misplaced `$1:'" : "Junk at end of function ($_)"); } print Q(<<"EOF") if $self->{except}; @@ -1037,7 +1040,7 @@ sub process_keyword($) { } sub CASE_handler { - blurt ("Error: `CASE:' after unconditional `CASE:'") + blurt( $self, "Error: `CASE:' after unconditional `CASE:'") if $self->{condnum} && $self->{cond} eq ''; $self->{cond} = $_; trim_whitespace($self->{cond}); @@ -1070,10 +1073,10 @@ sub INPUT_handler { s/\s+/ /g; my ($var_type, $var_addr, $var_name) = /^(.*?[^&\s])\s*(\&?)\s*\b(\w+)$/s - or blurt("Error: invalid argument declaration '$ln'"), next; + or blurt( $self, "Error: invalid argument declaration '$ln'"), next; # Check for duplicate definitions - blurt ("Error: duplicate definition of argument '$var_name' ignored"), next + blurt( $self, "Error: duplicate definition of argument '$var_name' ignored"), next if $self->{arg_list}->{$var_name}++ or defined $self->{argtype_seen}->{$var_name} and not $self->{processing_arg_with_types}; @@ -1140,7 +1143,7 @@ sub OUTPUT_handler { next; } my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s; - blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next + blurt( $self, "Error: duplicate OUTPUT argument '$outarg' ignored"), next if $self->{outargs}->{$outarg}++; if (!$self->{gotRETVAL} and $outarg eq 'RETVAL') { # deal with RETVAL last @@ -1148,9 +1151,9 @@ sub OUTPUT_handler { $self->{gotRETVAL} = 1; next; } - blurt ("Error: OUTPUT $outarg not an argument"), next + blurt( $self, "Error: OUTPUT $outarg not an argument"), next unless defined($self->{args_match}->{$outarg}); - blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next + blurt( $self, "Error: No input definition for OUTPUT argument '$outarg' - ignored"), next unless defined $self->{var_types}->{$outarg}; $self->{var_num} = $self->{args_match}->{$outarg}; if ($outcode) { @@ -1231,10 +1234,10 @@ sub GetAliases { $alias = $self->{Packprefix} . $alias if $alias !~ /::/; # check for duplicate alias name & duplicate value - Warn("Warning: Ignoring duplicate alias '$orig_alias'") + Warn( $self, "Warning: Ignoring duplicate alias '$orig_alias'") if defined $self->{XsubAliases}->{$alias}; - Warn("Warning: Aliases '$orig_alias' and '$self->{XsubAliasValues}->{$value}' have identical values") + Warn( $self, "Warning: Aliases '$orig_alias' and '$self->{XsubAliasValues}->{$value}' have identical values") if $self->{XsubAliasValues}->{$value}; $self->{xsubaliases} = 1; @@ -1242,7 +1245,7 @@ sub GetAliases { $self->{XsubAliasValues}->{$value} = $orig_alias; } - blurt("Error: Cannot parse ALIAS definitions from '$orig'") + blurt( $self, "Error: Cannot parse ALIAS definitions from '$orig'") if $line; } @@ -1287,7 +1290,7 @@ sub FALLBACK_handler() { ); # check for valid FALLBACK value - death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_}; + death( $self, "Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_}; $self->{Fallback} = $map{uc $_}; } @@ -1299,14 +1302,14 @@ sub REQUIRE_handler () { trim_whitespace($Ver); - death ("Error: REQUIRE expects a version number") + death( $self, "Error: REQUIRE expects a version number") unless $Ver; # check that the version number is of the form n.n - death ("Error: REQUIRE: expected a number, got '$Ver'") + death( $self, "Error: REQUIRE: expected a number, got '$Ver'") unless $Ver =~ /^\d+(\.\d*)?/; - death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.") + death( $self, "Error: xsubpp $Ver (or better) required--this is only $VERSION.") unless $VERSION >= $Ver; } @@ -1317,7 +1320,7 @@ sub VERSIONCHECK_handler () { trim_whitespace($_); # check for ENABLE/DISABLE - death ("Error: VERSIONCHECK: ENABLE/DISABLE") + death( $self, "Error: VERSIONCHECK: ENABLE/DISABLE") unless /^(ENABLE|DISABLE)/i; $self->{WantVersionChk} = 1 if $1 eq 'ENABLE'; @@ -1328,7 +1331,7 @@ sub VERSIONCHECK_handler () { sub PROTOTYPE_handler () { my $specified; - death("Error: Only 1 PROTOTYPE definition allowed per xsub") + death( $self, "Error: Only 1 PROTOTYPE definition allowed per xsub") if $self->{proto_in_this_xsub}++; for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { @@ -1344,7 +1347,7 @@ sub PROTOTYPE_handler () { else { # remove any whitespace s/\s+//g; - death("Error: Invalid prototype '$_'") + death( $self, "Error: Invalid prototype '$_'") unless valid_proto_string($_); $self->{ProtoThisXSUB} = C_string($_); } @@ -1357,7 +1360,7 @@ sub PROTOTYPE_handler () { } sub SCOPE_handler () { - death("Error: Only 1 SCOPE declaration allowed per xsub") + death( $self, "Error: Only 1 SCOPE declaration allowed per xsub") if $self->{scope_in_this_xsub}++; trim_whitespace($_); @@ -1405,25 +1408,25 @@ sub INCLUDE_handler () { trim_whitespace($_); - death("INCLUDE: filename missing") + death( $self, "INCLUDE: filename missing") unless $_; - death("INCLUDE: output pipe is illegal") + death( $self, "INCLUDE: output pipe is illegal") if /^\s*\|/; # simple minded recursion detector - death("INCLUDE loop detected") + death( $self, "INCLUDE loop detected") if $self->{IncludedFiles}->{$_}; ++$self->{IncludedFiles}->{$_} unless /\|\s*$/; if (/\|\s*$/ && /^\s*perl\s/) { - Warn("The INCLUDE directive with a command is discouraged." . - " Use INCLUDE_COMMAND instead! In particular using 'perl'" . - " in an 'INCLUDE: ... |' directive is not guaranteed to pick" . - " up the correct perl. The INCLUDE_COMMAND directive allows" . - " the use of \$^X as the currently running perl, see" . - " 'perldoc perlxs' for details."); + Warn( $self, "The INCLUDE directive with a command is discouraged." . + " Use INCLUDE_COMMAND instead! In particular using 'perl'" . + " in an 'INCLUDE: ... |' directive is not guaranteed to pick" . + " up the correct perl. The INCLUDE_COMMAND directive allows" . + " the use of \$^X as the currently running perl, see" . + " 'perldoc perlxs' for details."); } PushXSStack(); @@ -1431,7 +1434,7 @@ sub INCLUDE_handler () { $FH = Symbol::gensym(); # open the new file - open ($FH, "$_") or death("Cannot open '$_': $!"); + open ($FH, "$_") or death( $self, "Cannot open '$_': $!"); print Q(<<"EOF"); # @@ -1471,10 +1474,10 @@ sub INCLUDE_COMMAND_handler () { $_ = QuoteArgs($_) if $^O eq 'VMS'; - death("INCLUDE_COMMAND: command missing") + death( $self, "INCLUDE_COMMAND: command missing") unless $_; - death("INCLUDE_COMMAND: pipes are illegal") + death( $self, "INCLUDE_COMMAND: pipes are illegal") if /^\s*\|/ or /\|\s*$/; PushXSStack( IsPipe => 1 ); @@ -1487,7 +1490,7 @@ sub INCLUDE_COMMAND_handler () { # open the new file open ($FH, "-|", "$_") - or death("Cannot run command '$_' to include its output: $!"); + or death( $self, "Cannot run command '$_' to include its output: $!"); print Q(<<"EOF"); # @@ -1549,17 +1552,17 @@ EOF return 1; } -sub check_cpp { +sub check_conditional_preprocessor_statements { my ($self) = @_; my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} }); if (@cpp) { - my ($cpp, $cpplevel); - for $cpp (@cpp) { + my $cpplevel; + for my $cpp (@cpp) { if ($cpp =~ /^\#\s*if/) { $cpplevel++; } elsif (!$cpplevel) { - Warn("Warning: #else/elif/endif without #if in this function"); + Warn( $self, "Warning: #else/elif/endif without #if in this function"); print STDERR " (precede it with a blank line if the matching #if is outside the function)\n" if $self->{XSStack}->[-1]{type} eq 'if'; return; @@ -1568,7 +1571,7 @@ sub check_cpp { $cpplevel--; } } - Warn("Warning: #if without #endif in this function") if $cpplevel; + Warn( $self, "Warning: #if without #endif in this function") if $cpplevel; } } @@ -1696,7 +1699,7 @@ sub generate_init { $argoff = $num - 1; $type = tidy_type($type); - blurt("Error: '$type' not in typemap"), return + blurt( $self, "Error: '$type' not in typemap"), return unless defined($self->{type_kind}->{$type}); ($ntype = $type) =~ s/\s*\*/Ptr/g; @@ -1712,13 +1715,13 @@ sub generate_init { return; } $type =~ tr/:/_/ unless $self->{hiertype}; - blurt("Error: No INPUT definition for type '$type', typekind '$self->{type_kind}->{$type}' found"), return + blurt( $self, "Error: No INPUT definition for type '$type', typekind '$self->{type_kind}->{$type}' found"), return unless defined $self->{input_expr}->{$tk}; my $expr = $self->{input_expr}->{$tk}; if ($expr =~ /DO_ARRAY_ELEM/) { - blurt("Error: '$subtype' not in typemap"), return + blurt( $self, "Error: '$subtype' not in typemap"), return unless defined($self->{type_kind}->{$subtype}); - blurt("Error: No INPUT definition for type '$subtype', typekind '$self->{type_kind}->{$subtype}' found"), return + blurt( $self, "Error: No INPUT definition for type '$subtype', typekind '$self->{type_kind}->{$subtype}' found"), return unless defined $self->{input_expr}->{$self->{type_kind}->{$subtype}}; my $subexpr = $self->{input_expr}->{$self->{type_kind}->{$subtype}}; $subexpr =~ s/\$type/\$subtype/g; @@ -1788,9 +1791,9 @@ sub generate_output { print "\tSvSETMAGIC($arg);\n" if $do_setmagic; } else { - blurt("Error: '$type' not in typemap"), return + blurt( $self, "Error: '$type' not in typemap"), return unless defined($self->{type_kind}->{$type}); - blurt("Error: No OUTPUT definition for type '$type', typekind '$self->{type_kind}->{$type}' found"), return + blurt( $self, "Error: No OUTPUT definition for type '$type', typekind '$self->{type_kind}->{$type}' found"), return unless defined $self->{output_expr}->{$self->{type_kind}->{$type}}; ($ntype = $type) =~ s/\s*\*/Ptr/g; $ntype =~ s/\(\)//g; @@ -1798,9 +1801,9 @@ sub generate_output { ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; my $expr = $self->{output_expr}->{$self->{type_kind}->{$type}}; if ($expr =~ /DO_ARRAY_ELEM/) { - blurt("Error: '$subtype' not in typemap"), return + blurt( $self, "Error: '$subtype' not in typemap"), return unless defined($self->{type_kind}->{$subtype}); - blurt("Error: No OUTPUT definition for type '$subtype', typekind '$self->{type_kind}->{$subtype}' found"), return + blurt( $self, "Error: No OUTPUT definition for type '$subtype', typekind '$self->{type_kind}->{$subtype}' found"), return unless defined $self->{output_expr}->{$self->{type_kind}->{$subtype}}; my $subexpr = $self->{output_expr}->{$self->{type_kind}->{$subtype}}; $subexpr =~ s/ntype/subtype/g; @@ -1856,6 +1859,7 @@ sub generate_output { } sub Warn { + my $self = shift; # work out the line number my $warn_line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1]; @@ -1863,12 +1867,14 @@ sub Warn { } sub blurt { - Warn @_; + my $self = shift; + Warn($self, @_); $self->{errors}++ } sub death { - Warn @_; + my $self = shift; + Warn($self, @_); exit 1; } diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 942863e..3af5e5f 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -22,6 +22,7 @@ our (@ISA, @EXPORT_OK); print_preprocessor_statements set_cond ); +# check_conditional_preprocessor_statements =head1 NAME @@ -553,6 +554,29 @@ sub set_cond { return $cond; } +#sub check_conditional_preprocessor_statements { +# my ($self) = @_; +# my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} }); +# if (@cpp) { +# my $cpplevel; +# for my $cpp (@cpp) { +# if ($cpp =~ /^\#\s*if/) { +# $cpplevel++; +# } +# elsif (!$cpplevel) { +# Warn("Warning: #else/elif/endif without #if in this function"); +# print STDERR " (precede it with a blank line if the matching #if is outside the function)\n" +# if $self->{XSStack}->[-1]{type} eq 'if'; +# return; +# } +# elsif ($cpp =~ /^\#\s*endif/) { +# $cpplevel--; +# } +# } +# Warn("Warning: #if without #endif in this function") if $cpplevel; +# } +#} + 1; # vim: ts=2 sw=2 et: diff --git a/dist/ExtUtils-ParseXS/t/107-make_targetable.t b/dist/ExtUtils-ParseXS/t/107-make_targetable.t new file mode 100644 index 0000000..20615f7 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/107-make_targetable.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + make_targetable +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/108-map_type.t b/dist/ExtUtils-ParseXS/t/108-map_type.t new file mode 100644 index 0000000..7414e54 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/108-map_type.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + map_type +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t new file mode 100644 index 0000000..e5594ae --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + standard_XS_defs +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/110-assign_func_args.t b/dist/ExtUtils-ParseXS/t/110-assign_func_args.t new file mode 100644 index 0000000..64e9c8f --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/110-assign_func_args.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + assign_func_args +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t b/dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t new file mode 100644 index 0000000..fdb1210 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/111-print_preprocessor_statements.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + print_preprocessor_statements +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/112-set_cond.t b/dist/ExtUtils-ParseXS/t/112-set_cond.t new file mode 100644 index 0000000..d657877 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/112-set_cond.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( + set_cond +); + +pass("Passed all tests in $0"); diff --git a/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t b/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t new file mode 100644 index 0000000..dd2e7b9 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/113-check_cond_preproc_statements.t @@ -0,0 +1,78 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Carp; +use Cwd; +use File::Spec; +use File::Temp qw( tempdir ); +use Test::More qw(no_plan); # tests => 7; +use lib qw( lib ); +use ExtUtils::ParseXS::Utilities qw( +); +# check_conditional_preprocessor_statements + +my $self = {}; +$self->{line} = []; +$self->{XSStack} = []; +$self->{XSStack}->[0] = {}; +my @capture = (); +sub capture { push @capture, $_[0] }; + +#{ +# $self->{line} = [ +# "#if this_is_an_if_statement", +# "Alpha this is not an if/elif/elsif/endif", +# "#elif this_is_an_elif_statement", +# "Beta this is not an if/elif/elsif/endif", +# "#else this_is_an_else_statement", +# "Gamma this is not an if/elif/elsif/endif", +# "#endif this_is_an_endif_statement", +# ]; +# $self->{XSStack}->[-1]{type} = 'if'; +# +# @capture = (); +# local $SIG{__WARN__} = \&capture; +# is( check_conditional_preprocessor_statements($self), 0, +# "basic case: returned 0: all ifs resolved" ); +# ok( ! @capture, "No warnings captured, as expected" ); +#} +# +#{ +# $self->{line} = [ +# "#if this_is_an_if_statement", +# "Alpha this is not an if/elif/elsif/endif", +# "#if this_is_a_different_if_statement", +# "Beta this is not an if/elif/elsif/endif", +# "#endif this_is_a_different_endif_statement", +# "Gamma this is not an if/elif/elsif/endif", +# "#endif this_is_an_endif_statement", +# ]; +# $self->{XSStack}->[-1]{type} = 'if'; +# +# @capture = (); +# local $SIG{__WARN__} = \&capture; +# is( check_conditional_preprocessor_statements($self), 0, +# "one nested if case: returned 0: all ifs resolved" ); +# ok( ! @capture, "No warnings captured, as expected" ); +#} +# +#{ +# $self->{line} = [ +# "Alpha this is not an if/elif/elsif/endif", +# "#elif this_is_an_elif_statement", +# "Beta this is not an if/elif/elsif/endif", +# "#else this_is_an_else_statement", +# "Gamma this is not an if/elif/elsif/endif", +# "#endif this_is_an_endif_statement", +# ]; +# $self->{XSStack}->[-1]{type} = 'if'; +# +# @capture = (); +# local $SIG{__WARN__} = \&capture; +# is( check_conditional_preprocessor_statements($self), undef, +# "missing 'if' case: returned undef: all ifs resolved" ); +# ok( @capture, "Warning captured, as expected" ); +#} + + +pass("Passed all tests in $0"); -- 2.7.4