t/lib/MakeMaker/Test/Setup/XS.pm

   1 package MakeMaker::Test::Setup::XS;
   2
   3 @ISA = qw(Exporter);
   4 require Exporter;
   5 @EXPORT = qw(setup_xs teardown_xs);
   6
   7 use strict;
   8 use File::Path;
   9 use File::Basename;
  10 use MakeMaker::Test::Utils;
  11
  12 my $Is_VMS = $^O eq 'VMS';
  13
  14 my %Files = (
  15              'XS-Test/lib/XS/Test.pm'     => <<'END',
  16 package XS::Test;
  17
  18 require Exporter;
  19 require DynaLoader;
  20
  21 $VERSION = 1.01;
  22 @ISA    = qw(Exporter DynaLoader);
  23 @EXPORT = qw(is_even);
  24
  25 bootstrap XS::Test $VERSION;
  26
  27 1;
  28 END
  29
  30              'XS-Test/Makefile.PL'          => <<'END',
  31 use ExtUtils::MakeMaker;
  32
  33 WriteMakefile(
  34     NAME          => 'XS::Test',
  35     VERSION_FROM  => 'lib/XS/Test.pm',
  36 );
  37 END
  38
  39              'XS-Test/Test.xs'              => <<'END',
  40 #include "EXTERN.h";
  41 #include "perl.h";
  42 #include "XSUB.h";
  43
  44 MODULE = XS::Test       PACKAGE = XS::Test
  45
  46 int
  47 is_even(input)
  48        int     input
  49    CODE:
  50        RETVAL = (input % 2 == 0);
  51    OUTPUT:
  52        RETVAL
  53 END
  54
  55              'XS-Test/t/is_even.t'          => <<'END',
  56 #!/usr/bin/perl -w
  57
  58 use Test::More tests => 3;
  59
  60 use_ok "XS::Test";
  61 ok !is_even(1);
  62 ok is_even(2);
  63 END
  64             );
  65
  66
  67 sub setup_xs {
  68     setup_mm_test_root();
  69     chdir 'MM_TEST_ROOT:[t]' if $Is_VMS;
  70
  71     while(my($file, $text) = each %Files) {
  72         # Convert to a relative, native file path.
  73         $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
  74
  75         my $dir = dirname($file);
  76         mkpath $dir;
  77         open(FILE, ">$file") || die "Can't create $file: $!";
  78         print FILE $text;
  79         close FILE;
  80     }
  81
  82     return 1;
  83 }
  84
  85 sub teardown_xs {
  86     foreach my $file (keys %Files) {
  87         my $dir = dirname($file);
  88         if( -e $dir ) {
  89             rmtree($dir) || return;
  90         }
  91     }
  92     return 1;
  93 }
  94
  95 1;