r39289 - in /branches/upstream/libextutils-parsexs-perl/current: Build.PL Changes MANIFEST META.yml Makefile.PL README lib/ExtUtils/ParseXS.pm lib/ExtUtils/xsubpp t/XSUsage.pm t/XSUsage.xs t/basic.t t/usage.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Jul 3 23:52:27 UTC 2009


Author: jawnsy-guest
Date: Fri Jul  3 23:52:21 2009
New Revision: 39289

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39289
Log:
[svn-upgrade] Integrating new upstream version, libextutils-parsexs-perl (2.20)

Added:
    branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.pm
    branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.xs
    branches/upstream/libextutils-parsexs-perl/current/t/usage.t
Modified:
    branches/upstream/libextutils-parsexs-perl/current/Build.PL
    branches/upstream/libextutils-parsexs-perl/current/Changes
    branches/upstream/libextutils-parsexs-perl/current/MANIFEST
    branches/upstream/libextutils-parsexs-perl/current/META.yml
    branches/upstream/libextutils-parsexs-perl/current/Makefile.PL
    branches/upstream/libextutils-parsexs-perl/current/README
    branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/ParseXS.pm
    branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/xsubpp
    branches/upstream/libextutils-parsexs-perl/current/t/basic.t

Modified: branches/upstream/libextutils-parsexs-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/Build.PL?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/Build.PL (original)
+++ branches/upstream/libextutils-parsexs-perl/current/Build.PL Fri Jul  3 23:52:21 2009
@@ -6,19 +6,24 @@
    module_name => 'ExtUtils::ParseXS',
    license => 'perl',
    installdirs => 'core',
+   auto_configure_requires => 0,
    requires => {
-		'Cwd' => 0,
-		'Config' => 0,
-		'File::Basename' => 0,
-		'File::Spec' => 0,
-		'Exporter' => 0,
-	       },
+     'Cwd' => 0,
+     'Exporter' => 0,
+     'File::Basename' => 0,
+     'File::Spec' => 0,
+     'Symbol' => 0,
+   },
    build_requires => {
-		      'ExtUtils::CBuilder' => 0,
-		     },
+     'Carp' => 0,
+     'DynaLoader' => 0,
+     'ExtUtils::CBuilder' => 0,
+     'Test::More' => 0.47,
+   },
    add_to_cleanup => ["t/XSTest.c", "t/XSTest$Config{obj_ext}", "t/XSTest.$Config{dlext}"],
    create_makefile_pl => 'traditional',
    create_readme => 1,
   );
 
 $build->create_build_script;
+

Modified: branches/upstream/libextutils-parsexs-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/Changes?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/Changes (original)
+++ branches/upstream/libextutils-parsexs-perl/current/Changes Fri Jul  3 23:52:21 2009
@@ -1,4 +1,35 @@
 Revision history for Perl extension ExtUtils::ParseXS.
+
+2.20 - Wed Jul  1 13:42:11 EDT 2009
+
+ - No changes from 2.19_04
+
+2.19_04 - Mon Jun 29 11:49:12 EDT 2009
+
+ - Changed tests to use Test::More and added it to prereqs
+
+ - Some tests skip if no compiler or if no dynamic loading
+
+ - INTERFACE keyword tests skipped for perl < 5.8
+
+2.19_03 - Sat Jun 27 22:51:18 EDT 2009
+
+ - Released to see updated results from smoke testers
+
+ - Fix minor doc typo pulled from blead
+
+2.19_02 - Wed Aug  6 22:18:33 2008
+
+ - Fix the usage reports to consistently report package name as well
+   as sub name across ALIAS, INTERFACE and regular XSUBS. [Robert May]
+
+ - Cleaned up a warning with -Wwrite-strings that gets passed into
+   every parsed XS file. [Steve Peters]
+
+ - Allow (pedantically correct) C pre-processor comments in the code
+   snippets of typemap files. [Nicholas Clark]
+
+2.19 - Sun Feb 17 14:27:40 2008
 
  - Fixed the treatment of the OVERLOAD: keyword, which was causing a C
    compile error. [Toshiyuki Yamato]

Modified: branches/upstream/libextutils-parsexs-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/MANIFEST?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/MANIFEST (original)
+++ branches/upstream/libextutils-parsexs-perl/current/MANIFEST Fri Jul  3 23:52:21 2009
@@ -6,7 +6,10 @@
 Makefile.PL
 MANIFEST
 META.yml			Module meta-data (added by MakeMaker)
+README
 t/basic.t
+t/usage.t
 t/XSTest.pm
 t/XSTest.xs
-README
+t/XSUsage.pm
+t/XSUsage.xs

Modified: branches/upstream/libextutils-parsexs-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/META.yml?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/META.yml (original)
+++ branches/upstream/libextutils-parsexs-perl/current/META.yml Fri Jul  3 23:52:21 2009
@@ -1,25 +1,28 @@
 ---
 name: ExtUtils-ParseXS
-version: 2.19
+version: 2.20
 author:
   - 'Maintained by Ken Williams, <ken at mathforum.org>'
 abstract: converts Perl XS code into C code
 license: perl
 resources:
   license: http://dev.perl.org/licenses/
+build_requires:
+  Carp: 0
+  DynaLoader: 0
+  ExtUtils::CBuilder: 0
+  Test::More: 0.47
 requires:
-  Config: 0
   Cwd: 0
   Exporter: 0
   File::Basename: 0
   File::Spec: 0
-build_requires:
-  ExtUtils::CBuilder: 0
+  Symbol: 0
 provides:
   ExtUtils::ParseXS:
     file: lib/ExtUtils/ParseXS.pm
-    version: 2.19
-generated_by: Module::Build version 0.2808
+    version: 2.20
+generated_by: Module::Build version 0.3305
 meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.2.html
-  version: 1.2
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4

Modified: branches/upstream/libextutils-parsexs-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/Makefile.PL?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/Makefile.PL (original)
+++ branches/upstream/libextutils-parsexs-perl/current/Makefile.PL Fri Jul  3 23:52:21 2009
@@ -1,19 +1,22 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
+# Note: this file was auto-generated by Module::Build::Compat version 0.33_05
 use ExtUtils::MakeMaker;
 WriteMakefile
 (
+          'PL_FILES' => {},
+          'INSTALLDIRS' => 'perl',
           'NAME' => 'ExtUtils::ParseXS',
+          'EXE_FILES' => [],
           'VERSION_FROM' => 'lib/ExtUtils/ParseXS.pm',
           'PREREQ_PM' => {
-                           'Config' => '0',
-                           'Cwd' => '0',
-                           'Exporter' => '0',
-                           'ExtUtils::CBuilder' => '0',
-                           'File::Basename' => '0',
-                           'File::Spec' => '0'
-                         },
-          'INSTALLDIRS' => 'perl',
-          'EXE_FILES' => [],
-          'PL_FILES' => {}
+                           'File::Spec' => 0,
+                           'Symbol' => 0,
+                           'Exporter' => 0,
+                           'Carp' => 0,
+                           'Test::More' => '0.47',
+                           'File::Basename' => 0,
+                           'DynaLoader' => 0,
+                           'ExtUtils::CBuilder' => 0,
+                           'Cwd' => 0
+                         }
         )
 ;

Modified: branches/upstream/libextutils-parsexs-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/README?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/README (original)
+++ branches/upstream/libextutils-parsexs-perl/current/README Fri Jul  3 23:52:21 2009
@@ -3,8 +3,8 @@
 
 SYNOPSIS
       use ExtUtils::ParseXS qw(process_file);
-  
-      process_file( filename => 'foo.xs' );
+      
+  process_file( filename => 'foo.xs' );
 
       process_file( filename => 'foo.xs',
                     output => 'bar.c',
@@ -20,7 +20,7 @@
                   );
     =head1 DESCRIPTION
 
-    `ExtUtils::ParseXS' will compile XS code into C code by embedding the
+    "ExtUtils::ParseXS" will compile XS code into C code by embedding the
     constructs necessary to let C functions manipulate Perl values and
     creates the glue necessary to let Perl access those functions. The
     compiler uses typemaps to determine how to map C function parameters and
@@ -33,7 +33,7 @@
             ../../../typemap:../../typemap:../typemap:typemap
 
 EXPORT
-    None by default. `process_file()' may be exported upon request.
+    None by default. "process_file()" may be exported upon request.
 
 FUNCTIONS
     process_xs()
@@ -41,10 +41,10 @@
         Named parameters control how the processing is done. The following
         parameters are accepted:
 
-        C++ Adds `extern "C"' to the C code. Default is false.
+        C++ Adds "extern "C"" to the C code. Default is false.
 
         hiertype
-            Retains `::' in type names so that C++ hierachical types can be
+            Retains "::" in type names so that C++ hierachical types can be
             mapped. Default is false.
 
         except
@@ -61,11 +61,11 @@
 
         versioncheck
             Makes sure at run time that the object file (derived from the
-            `.xs' file) and the `.pm' files have the same version number.
+            ".xs" file) and the ".pm" files have the same version number.
             Default is true.
 
         linenumbers
-            Adds `#line' directives to the C output so error messages will
+            Adds "#line" directives to the C output so error messages will
             look like they came from the original XS file. Default is true.
 
         optimize
@@ -76,7 +76,7 @@
             operated. Default is to optimize.
 
         inout
-            Enable recognition of `IN', `OUT_LIST' and `INOUT_LIST'
+            Enable recognition of "IN", "OUT_LIST" and "INOUT_LIST"
             declarations. Default is true.
 
         argtypes

Modified: branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/ParseXS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/ParseXS.pm?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/ParseXS.pm (original)
+++ branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/ParseXS.pm Fri Jul  3 23:52:21 2009
@@ -18,7 +18,7 @@
 my($XSS_work_idx, $cpp_next_tmp);
 
 use vars qw($VERSION);
-$VERSION = '2.19';
+$VERSION = '2.20';
 
 use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
 	    $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
@@ -193,8 +193,15 @@
     close(TYPEMAP);
   }
 
-  foreach my $key (keys %input_expr) {
-    $input_expr{$key} =~ s/;*\s+\z//;
+  foreach my $value (values %input_expr) {
+    $value =~ s/;*\s+\z//;
+    # Move C pre-processor instructions to column 1 to be strictly ANSI
+    # conformant. Some pre-processors are fussy about this.
+    $value =~ s/^\s+#/#/mg;
+  }
+  foreach my $value (values %output_expr) {
+    # And again.
+    $value =~ s/^\s+#/#/mg;
   }
 
   my ($cast, $size);
@@ -298,9 +305,52 @@
     exit 0; # Not a fatal error for the caller process
   }
 
-    print <<"EOF";
+  print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+
+  print <<"EOF";
 #ifndef PERL_UNUSED_VAR
 #  define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+EOF
+
+  print <<"EOF";
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+
+/* prototype to pass -Wmissing-prototypes */
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
+
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+{
+    const GV *const gv = CvGV(cv);
+
+    PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+    if (gv) {
+        const char *const gvname = GvNAME(gv);
+        const HV *const stash = GvSTASH(gv);
+        const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+        if (hvname)
+            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
+        else
+            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
+    } else {
+        /* Pants. I don't think that it should be possible to get here. */
+        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+    }
+}
+#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#define croak_xs_usage(a,b)	S_croak_xs_usage(aTHX_ a,b)
+#else
+#define croak_xs_usage		S_croak_xs_usage
+#endif
+
 #endif
 
 EOF
@@ -360,7 +410,7 @@
 	   ." followed by a statement on column one?)")
       if $line[0] =~ /^\s/;
     
-    my ($class, $externC, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
+    my ($class, $externC, $static, $ellipsis, $wantRETVAL, $RETVAL_no_return);
     my (@fake_INPUT_pre);	# For length(s) generated variables
     my (@fake_INPUT);
     
@@ -513,7 +563,7 @@
     my $report_args = '';
     foreach my $i (0 .. $#args) {
       if ($args[$i] =~ s/\.\.\.//) {
-	$elipsis = 1;
+	$ellipsis = 1;
 	if ($args[$i] eq '' && $i == $#args) {
 	  $report_args .= ", ...";
 	  pop(@args);
@@ -577,7 +627,7 @@
     print Q(<<"EOF") if $INTERFACE ;
 #    dXSFUNCTION($ret_type);
 EOF
-    if ($elipsis) {
+    if ($ellipsis) {
       $cond = ($min_args ? qq(items < $min_args) : 0);
     } elsif ($min_args == $num_args) {
       $cond = qq(items != $min_args);
@@ -590,22 +640,17 @@
 #    *errbuf = '\0';
 EOF
 
-    if ($ALIAS)
-      { print Q(<<"EOF") if $cond }
+    if($cond) {
+    print Q(<<"EOF");
 #    if ($cond)
-#       Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "$report_args");
-EOF
-    else
-      { print Q(<<"EOF") if $cond }
-#    if ($cond)
-#       Perl_croak(aTHX_ "Usage: %s(%s)", "$pname", "$report_args");
-EOF
-    
-     # cv doesn't seem to be used, in most cases unless we go in 
-     # the if of this else
-     print Q(<<"EOF");
+#       croak_xs_usage(cv,  "$report_args");
+EOF
+    } else {
+    # cv likely to be unused
+    print Q(<<"EOF");
 #    PERL_UNUSED_VAR(cv); /* -W */
 EOF
+    }
 
     #gcc -Wall: if an xsub has PPCODE is used
     #it is possible none of ST, XSRETURN or XSprePUSH macros are used
@@ -842,7 +887,7 @@
 	  $proto_arg[$min_args] .= ";" ;
 	}
 	push @proto_arg, "$s\@"
-	  if $elipsis ;
+	  if $ellipsis ;
 	
 	$proto = join ("", grep defined, @proto_arg);
       }
@@ -934,7 +979,7 @@
   #-Wall: if there is no $Full_func_name there are no xsubs in this .xs
   #so `file' is unused
   print Q(<<"EOF") if $Full_func_name;
-#    char* file = __FILE__;
+#    const char* file = __FILE__;
 EOF
 
   print Q("#\n");

Modified: branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/xsubpp
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/xsubpp?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/xsubpp (original)
+++ branches/upstream/libextutils-parsexs-perl/current/lib/ExtUtils/xsubpp Fri Jul  3 23:52:21 2009
@@ -76,7 +76,7 @@
 
 =item B<-hiertype>
 
-Retains '::' in type names so that C++ hierachical types can be mapped.
+Retains '::' in type names so that C++ hierarchical types can be mapped.
 
 =item B<-except>
 

Added: branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.pm?rev=39289&op=file
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.pm (added)
+++ branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.pm Fri Jul  3 23:52:21 2009
@@ -1,0 +1,6 @@
+package XSUsage;
+
+require DynaLoader;
+ at ISA = qw(Exporter DynaLoader);
+$VERSION = '0.01';
+bootstrap XSUsage $VERSION;

Added: branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.xs?rev=39289&op=file
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.xs (added)
+++ branches/upstream/libextutils-parsexs-perl/current/t/XSUsage.xs Fri Jul  3 23:52:21 2009
@@ -1,0 +1,37 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int xsusage_one()   { return 1; } 
+int xsusage_two()   { return 2; }
+int xsusage_three() { return 3; }
+int xsusage_four()  { return 4; }
+int xsusage_five()  { return 5; }
+int xsusage_six()   { return 6; }
+
+MODULE = XSUsage         PACKAGE = XSUsage	PREFIX = xsusage_
+
+PROTOTYPES: DISABLE
+
+int
+xsusage_one()
+
+int
+xsusage_two()
+    ALIAS:
+        two_x = 1
+        FOO::two = 2
+
+int
+interface_v_i()
+    INTERFACE:
+        xsusage_three
+
+int
+xsusage_four(...)
+
+int
+xsusage_five(int i, ...)
+
+int
+xsusage_six(int i = 0)

Modified: branches/upstream/libextutils-parsexs-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/t/basic.t?rev=39289&op=diff
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/t/basic.t (original)
+++ branches/upstream/libextutils-parsexs-perl/current/t/basic.t Fri Jul  3 23:52:21 2009
@@ -9,12 +9,17 @@
   }
 }
 use strict;
-use Test;
-BEGIN { plan tests => 10 };
+use Test::More;
+use Config;
 use DynaLoader;
-use ExtUtils::ParseXS qw(process_file);
 use ExtUtils::CBuilder;
-ok(1); # If we made it this far, we're loaded.
+
+plan tests => 10;
+
+my ($source_file, $obj_file, $lib_file);
+
+require_ok( 'ExtUtils::ParseXS' );
+ExtUtils::ParseXS->import('process_file');
 
 chdir 't' or die "Can't chdir to t/, $!";
 
@@ -25,32 +30,35 @@
 # Try sending to filehandle
 tie *FH, 'Foo';
 process_file( filename => 'XSTest.xs', output => \*FH, prototypes => 1 );
-ok tied(*FH)->content, '/is_even/', "Test that output contains some text";
+like tied(*FH)->content, '/is_even/', "Test that output contains some text";
 
-my $source_file = 'XSTest.c';
+$source_file = 'XSTest.c';
 
 # Try sending to file
 process_file(filename => 'XSTest.xs', output => $source_file, prototypes => 0);
-ok -e $source_file, 1, "Create an output file";
+ok -e $source_file, "Create an output file";
 
-# TEST doesn't like extraneous output
 my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
 
-# Try to compile the file!  Don't get too fancy, though.
-my $b = ExtUtils::CBuilder->new(quiet => $quiet);
-if ($b->have_compiler) {
+SKIP: {
+  skip "no compiler available", 2
+    if ! $b->have_compiler;
+  $obj_file = $b->compile( source => $source_file );
+  ok $obj_file;
+  ok -e $obj_file, "Make sure $obj_file exists";
+}
+
+SKIP: {
+  skip "no dynamic loading", 5
+    if !$b->have_compiler || !$Config{usedl};
   my $module = 'XSTest';
-
-  my $obj_file = $b->compile( source => $source_file );
-  ok $obj_file;
-  ok -e $obj_file, 1, "Make sure $obj_file exists";
-
-  my $lib_file = $b->link( objects => $obj_file, module_name => $module );
+  $lib_file = $b->link( objects => $obj_file, module_name => $module );
   ok $lib_file;
-  ok -e $lib_file, 1, "Make sure $lib_file exists";
+  ok -e $lib_file,  "Make sure $lib_file exists";
 
   eval {require XSTest};
-  ok $@, '';
+  is $@, '';
   ok  XSTest::is_even(8);
   ok !XSTest::is_even(9);
 
@@ -64,13 +72,14 @@
       }
     }
   }
-  1 while unlink $obj_file;
-  1 while unlink $lib_file;
-} else {
-  skip "Skipped can't find a C compiler & linker", 1 for 1..7;
 }
 
-1 while unlink $source_file;
+unless ($ENV{PERL_NO_CLEANUP}) {
+  for ( $obj_file, $lib_file, $source_file) {
+    next unless defined $_;
+    1 while unlink $_;
+  }
+}
 
 #####################################################################
 

Added: branches/upstream/libextutils-parsexs-perl/current/t/usage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libextutils-parsexs-perl/current/t/usage.t?rev=39289&op=file
==============================================================================
--- branches/upstream/libextutils-parsexs-perl/current/t/usage.t (added)
+++ branches/upstream/libextutils-parsexs-perl/current/t/usage.t Fri Jul  3 23:52:21 2009
@@ -1,0 +1,125 @@
+#!/usr/bin/perl
+
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    chdir 't' if -d 't';
+    chdir '../lib/ExtUtils/ParseXS'
+      or die "Can't chdir to lib/ExtUtils/ParseXS: $!";
+    @INC = qw(../.. ../../.. .);
+  }
+}
+use strict;
+use Test::More;
+use Config;
+use DynaLoader;
+use ExtUtils::CBuilder;
+
+if ( $] < 5.008 ) {
+  plan skip_all => "INTERFACE keyword support broken before 5.8";
+}
+else {
+  plan tests => 24;
+}
+
+my ($source_file, $obj_file, $lib_file, $module);
+
+require_ok( 'ExtUtils::ParseXS' );
+ExtUtils::ParseXS->import('process_file');
+
+chdir 't' or die "Can't chdir to t/, $!";
+
+use Carp; $SIG{__WARN__} = \&Carp::cluck;
+
+#########################
+
+$source_file = 'XSUsage.c';
+
+# Try sending to file
+process_file(filename => 'XSUsage.xs', output => $source_file);
+ok -e $source_file, "Create an output file";
+
+# TEST doesn't like extraneous output
+my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+
+# Try to compile the file!  Don't get too fancy, though.
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
+
+SKIP: {
+  skip "no compiler available", 2
+    if ! $b->have_compiler;
+  $module = 'XSUsage';
+
+  $obj_file = $b->compile( source => $source_file );
+  ok $obj_file;
+  ok -e $obj_file, "Make sure $obj_file exists";
+}
+SKIP: {
+  skip "no dynamic loading", 20 
+    if !$b->have_compiler || !$Config{usedl};
+
+  $lib_file = $b->link( objects => $obj_file, module_name => $module );
+  ok $lib_file;
+  ok -e $lib_file, "Make sure $lib_file exists";
+
+  eval {require XSUsage};
+  is $@, '';
+
+  # The real tests here - for each way of calling the functions, call with the
+  # wrong number of arguments and check the Usage line is what we expect
+
+  eval { XSUsage::one(1) };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::one/;
+
+  eval { XSUsage::two(1) };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::two/;
+
+  eval { XSUsage::two_x(1) };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::two_x/;
+
+  eval { FOO::two(1) };
+  ok $@;
+  ok $@ =~ /^Usage: FOO::two/;
+
+  eval { XSUsage::three(1) };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::three/;
+
+  eval { XSUsage::four(1) };
+  ok !$@;
+
+  eval { XSUsage::five() };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::five/;
+
+  eval { XSUsage::six() };
+  ok !$@;
+
+  eval { XSUsage::six(1) };
+  ok !$@;
+
+  eval { XSUsage::six(1,2) };
+  ok $@;
+  ok $@ =~ /^Usage: XSUsage::six/;
+
+  # Win32 needs to close the DLL before it can unlink it, but unfortunately
+  # dl_unload_file was missing on Win32 prior to perl change #24679!
+  if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) {
+    for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) {
+      if ($DynaLoader::dl_modules[$i] eq $module) {
+        DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]);
+        last;
+      }
+    }
+  }
+}
+
+unless ($ENV{PERL_NO_CLEANUP}) {
+  for ( $obj_file, $lib_file, $source_file) {
+    next unless defined $_;
+    1 while unlink $_;
+  }
+}
+




More information about the Pkg-perl-cvs-commits mailing list