dist/ExtUtils-ParseXS/t/003-usage.t ExtUtils::ParseXS tests
dist/ExtUtils-ParseXS/t/101-standard_typemap_locations.t ExtUtils::ParseXS tests
dist/ExtUtils-ParseXS/t/102-trim_whitespace.t ExtUtils::ParseXS tests
+dist/ExtUtils-ParseXS/t/103-tidy_type.t ExtUtils::ParseXS tests
dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm ExtUtils::ParseXS testing utility
dist/ExtUtils-ParseXS/t/typemap Standard typemap for controlled testing
dist/ExtUtils-ParseXS/t/XSInclude.xsh Test file for ExtUtils::ParseXS tests
use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
+ tidy_type
);
our (@ISA, @EXPORT_OK, $VERSION);
next if /^$/ or /^#/;
my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
- $type = TidyType($type);
+ $type = tidy_type($type);
$type_kind{$type} = $kind;
# prototype defaults to '$'
$proto = "\$" unless $proto;
}
# extract return type, function name and arguments
- ($ret_type) = TidyType($_);
+ ($ret_type) = tidy_type($_);
$RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//;
# Allow one-line ANSI-like declaration
sub errors { $errors }
-sub TidyType {
- local ($_) = @_;
-
- # rationalise any '*' by joining them into bunches and removing whitespace
- s#\s*(\*+)\s*#$1#g;
- s#(\*+)# $1 #g;
-
- # change multiple whitespace into a single space
- s/\s+/ /g;
-
- # trim leading & trailing whitespace
- trim_whitespace($_);
-
- $_;
-}
-
# Input: ($_, @line) == unparsed input.
# Output: ($_, @line) == (rest of line, following lines).
# Return: the matched keyword if found, otherwise 0
local($ntype);
local($tk);
- $type = TidyType($type);
+ $type = tidy_type($type);
blurt("Error: '$type' not in typemap"), return
unless defined($type_kind{$type});
local($argoff) = $num - 1;
local($ntype);
- $type = TidyType($type);
+ $type = tidy_type($type);
if ($type =~ /^array\(([^,]*),(.*)\)/) {
print "\t$arg = sv_newmortal();\n";
print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
@EXPORT_OK = qw(
standard_typemap_locations
trim_whitespace
+ tidy_type
);
=head1 NAME
use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
+ tidy_type
);
=head1 SUBROUTINES
$_[0] =~ s/^\s+|\s+$//go;
}
+=head2 C<tidy_type()>
+
+=over 4
+
+=item * Purpose
+
+Rationalize any asterisks (C<*>) by joining them into bunches, removing
+interior whitespace, then trimming leading and trailing whitespace.
+
+=item * Arguments
+
+ ($ret_type) = tidy_type($_);
+
+String to be cleaned up.
+
+=item * Return Value
+
+String cleaned up.
+
+=back
+
+=cut
+
+sub tidy_type {
+ local ($_) = @_;
+
+ # rationalise any '*' by joining them into bunches and removing whitespace
+ s#\s*(\*+)\s*#$1#g;
+ s#(\*+)# $1 #g;
+
+ # change multiple whitespace into a single space
+ s/\s+/ /g;
+
+ # trim leading & trailing whitespace
+ trim_whitespace($_);
+
+ $_;
+}
+
1;
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+ tidy_type
+);
+
+my $input;
+
+$input = ' * ** ';
+is( tidy_type($input), '***',
+ "Got expected value for '$input'" );
+
+$input = ' * ** ';
+is( tidy_type($input), '***',
+ "Got expected value for '$input'" );
+
+$input = ' * ** foobar * ';
+is( tidy_type($input), '*** foobar *',
+ "Got expected value for '$input'" );
+