This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Lose now obsolete process_single_typemap()
authorSteffen Mueller <smueller@cpan.org>
Fri, 11 Feb 2011 17:35:31 +0000 (18:35 +0100)
committerSteffen Mueller <smueller@cpan.org>
Tue, 12 Jul 2011 18:54:49 +0000 (20:54 +0200)
This was the actual typemap parser. It is now parsed by
ExtUtils::Typemaps, so we don't need it any more!

dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
dist/ExtUtils-ParseXS/t/106-process_typemaps.t

index eb3ba17..4889d29 100644 (file)
@@ -393,88 +393,6 @@ sub process_typemaps {
   );
 }
 
-=head2 C<process_single_typemap()>
-
-=over 4
-
-=item * Purpose
-
-Process a single typemap within C<process_typemaps()>.
-
-=item * Arguments
-
-    ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
-      process_single_typemap( $typemap,
-        $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
-
-List of five elements:  The individual typemap needing processing and four
-references.
-
-=item * Return Value
-
-List of four references -- modified versions of those passed in as arguments.
-
-=back
-
-=cut
-
-sub process_single_typemap {
-  my ($typemap,
-    $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) = @_;
-  open my $TYPEMAP, '<', $typemap
-    or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
-  my $mode = 'Typemap';
-  my $junk = "";
-  my $current = \$junk;
-  while (<$TYPEMAP>) {
-    # skip comments
-    next if /^\s*#/;
-    if (/^INPUT\s*$/) {
-      $mode = 'Input';   $current = \$junk;  next;
-    }
-    if (/^OUTPUT\s*$/) {
-      $mode = 'Output';  $current = \$junk;  next;
-    }
-    if (/^TYPEMAP\s*$/) {
-      $mode = 'Typemap'; $current = \$junk;  next;
-    }
-    if ($mode eq 'Typemap') {
-      chomp;
-      my $logged_line = $_;
-      trim_whitespace($_);
-      # skip blank lines
-      next if /^$/;
-      my($type,$kind, $proto) =
-        m/^\s*(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)\s*$/
-          or warn(
-            "Warning: File '$typemap' Line $.  '$logged_line' " .
-            "TYPEMAP entry needs 2 or 3 columns\n"
-          ),
-          next;
-      $type = tidy_type($type);
-      $type_kind_ref->{$type} = $kind;
-      # prototype defaults to '$'
-      $proto = "\$" unless $proto;
-      $proto_letter_ref->{$type} = C_string($proto);
-    }
-    elsif (/^\s/) {
-      $$current .= $_;
-    }
-    elsif ($mode eq 'Input') {
-      s/\s+$//;
-      $input_expr_ref->{$_} = '';
-      $current = \$input_expr_ref->{$_};
-    }
-    else {
-      s/\s+$//;
-      $output_expr_ref->{$_} = '';
-      $current = \$output_expr_ref->{$_};
-    }
-  }
-  close $TYPEMAP;
-  return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
-}
-
 =head2 C<make_targetable()>
 
 =over 4
index 520f0b5..55a7acb 100644 (file)
@@ -5,11 +5,10 @@ use Carp;
 use Cwd;
 use File::Spec;
 use File::Temp qw( tempdir );
-use Test::More tests =>  7;
+use Test::More tests =>  2;
 use lib qw( lib );
 use ExtUtils::ParseXS::Utilities qw(
   process_typemaps
-  process_single_typemap
 );
 
 my $startdir  = cwd();
@@ -44,25 +43,3 @@ my $startdir  = cwd();
     chdir $startdir;
 }
 
-{
-    my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
-    my $typemap = File::Spec->catfile( qw| t pseudotypemap1 | );
-    my @capture = ();
-    local $SIG{__WARN__} = sub { push @capture, $_[0] };
-    ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref)
-            = process_single_typemap( $typemap, {}, {}, {}, {}  );
-    like( $capture[0],
-        qr/TYPEMAP entry needs 2 or 3 columns/,
-        "Got expected warning for insufficient columns"
-    );
-    my $t = 'unsigned long';
-    is( $type_kind_ref->{$t}, 'T_UV',
-        "type_kind:  got expected value for <$t>" );
-    is( $proto_letter_ref->{$t}, '$',
-        "proto_letter:  got expected value for <$t>" );
-    is( scalar keys %{ $input_expr_ref }, 0,
-        "Nothing assigned to input_expr" );
-    is( scalar keys %{ $output_expr_ref }, 0,
-        "Nothing assigned to output_expr" );
-}
-