Move ExtUtils::MakeMaker from ext/ to cpan/
[perl.git] / cpan / ExtUtils-MakeMaker / 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 PROTOTYPES: DISABLE
47
48 int
49 is_even(input)
50        int     input
51    CODE:
52        RETVAL = (input % 2 == 0);
53    OUTPUT:
54        RETVAL        
55 END
56
57              'XS-Test/t/is_even.t'          => <<'END',
58 #!/usr/bin/perl -w
59
60 use Test::More tests => 3;
61
62 use_ok "XS::Test";
63 ok !is_even(1);
64 ok is_even(2);
65 END
66             );
67
68
69 sub setup_xs {
70     setup_mm_test_root();
71     chdir 'MM_TEST_ROOT:[t]' if $Is_VMS;
72
73     while(my($file, $text) = each %Files) {
74         # Convert to a relative, native file path.
75         $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
76
77         my $dir = dirname($file);
78         mkpath $dir;
79         open(FILE, ">$file") || die "Can't create $file: $!";
80         print FILE $text;
81         close FILE;
82     }
83
84     return 1;
85 }
86
87 sub teardown_xs { 
88     foreach my $file (keys %Files) {
89         my $dir = dirname($file);
90         if( -e $dir ) {
91             rmtree($dir) || return;
92         }
93     }
94     return 1;
95 }
96
97 1;