Commit | Line | Data |
a7d1454b |
1 | package MakeMaker::Test::Setup::BFD; |
45bc4d3a |
2 | |
a7d1454b |
3 | @ISA = qw(Exporter); |
4 | require Exporter; |
5 | @EXPORT = qw(setup_recurs teardown_recurs); |
45bc4d3a |
6 | |
7 | use strict; |
d5d4ec93 |
8 | use File::Path; |
a7d1454b |
9 | use File::Basename; |
431b0fc4 |
10 | |
11 | |
45bc4d3a |
12 | my %Files = ( |
d5d4ec93 |
13 | 'Big-Dummy/lib/Big/Dummy.pm' => <<'END', |
45bc4d3a |
14 | package Big::Dummy; |
15 | |
16 | $VERSION = 0.01; |
17 | |
479d2113 |
18 | =head1 NAME |
19 | |
20 | Big::Dummy - Try "our" hot dog's |
21 | |
22 | =cut |
23 | |
45bc4d3a |
24 | 1; |
25 | END |
26 | |
d5d4ec93 |
27 | 'Big-Dummy/Makefile.PL' => <<'END', |
45bc4d3a |
28 | use ExtUtils::MakeMaker; |
29 | |
2c91f887 |
30 | # This will interfere with the PREREQ_PRINT tests. |
31 | printf "Current package is: %s\n", __PACKAGE__ unless "@ARGV" =~ /PREREQ/; |
45bc4d3a |
32 | |
33 | WriteMakefile( |
34 | NAME => 'Big::Dummy', |
35 | VERSION_FROM => 'lib/Big/Dummy.pm', |
479d2113 |
36 | PREREQ_PM => { strict => 0 }, |
37 | ABSTRACT_FROM => 'lib/Big/Dummy.pm', |
38 | AUTHOR => 'Michael G Schwern <schwern@pobox.com>', |
45bc4d3a |
39 | ); |
40 | END |
41 | |
d5d4ec93 |
42 | 'Big-Dummy/t/compile.t' => <<'END', |
57b1a898 |
43 | print "1..2\n"; |
44 | |
45 | print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; |
46 | print "ok 2 - TEST_VERBOSE\n"; |
47 | END |
48 | |
d5d4ec93 |
49 | 'Big-Dummy/Liar/t/sanity.t' => <<'END', |
57b1a898 |
50 | print "1..3\n"; |
51 | |
52 | print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; |
53 | print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; |
54 | print "ok 3 - TEST_VERBOSE\n"; |
55 | END |
56 | |
d5d4ec93 |
57 | 'Big-Dummy/Liar/lib/Big/Liar.pm' => <<'END', |
45bc4d3a |
58 | package Big::Liar; |
59 | |
60 | $VERSION = 0.01; |
61 | |
62 | 1; |
63 | END |
64 | |
d5d4ec93 |
65 | 'Big-Dummy/Liar/Makefile.PL' => <<'END', |
45bc4d3a |
66 | use ExtUtils::MakeMaker; |
67 | |
68 | my $mm = WriteMakefile( |
69 | NAME => 'Big::Liar', |
70 | VERSION_FROM => 'lib/Big/Liar.pm', |
71 | _KEEP_AFTER_FLUSH => 1 |
72 | ); |
73 | |
74 | print "Big::Liar's vars\n"; |
75 | foreach my $key (qw(INST_LIB INST_ARCHLIB)) { |
76 | print "$key = $mm->{$key}\n"; |
77 | } |
78 | END |
79 | |
a7d1454b |
80 | ); |
45bc4d3a |
81 | |
45bc4d3a |
82 | |
a7d1454b |
83 | sub _setup_bfd_test_root { |
84 | if( $^O eq 'VMS' ) { |
85 | # On older systems we might exceed the 8-level directory depth limit |
86 | # imposed by RMS. We get around this with a rooted logical, but we |
87 | # can't create logical names with attributes in Perl, so we do it |
88 | # in a DCL subprocess and put it in the job table so the parent sees it. |
89 | open( BFDTMP, '>bfdtesttmp.com' ) || |
90 | die "Error creating command file; $!"; |
91 | print BFDTMP <<'COMMAND'; |
92 | $ BFD_TEST_ROOT = F$PARSE("SYS$DISK:[-]",,,,"NO_CONCEAL")-".][000000"-"]["-"].;"+".]" |
93 | $ DEFINE/JOB/NOLOG/TRANSLATION=CONCEALED BFD_TEST_ROOT 'BFD_TEST_ROOT' |
94 | COMMAND |
95 | close BFDTMP; |
45bc4d3a |
96 | |
a7d1454b |
97 | system '@bfdtesttmp.com'; |
98 | 1 while unlink 'bfdtesttmp.com'; |
99 | } |
100 | } |
45bc4d3a |
101 | |
a7d1454b |
102 | sub setup_recurs { |
103 | _setup_bfd_test_root(); |
104 | |
105 | while(my($file, $text) = each %Files) { |
106 | # Convert to a relative, native file path. |
107 | $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); |
45bc4d3a |
108 | |
a7d1454b |
109 | my $dir = dirname($file); |
110 | mkpath $dir; |
111 | open(FILE, ">$file") || die "Can't create $file: $!"; |
112 | print FILE $text; |
113 | close FILE; |
114 | } |
d5d4ec93 |
115 | |
a7d1454b |
116 | return 1; |
117 | } |
45bc4d3a |
118 | |
a7d1454b |
119 | sub teardown_recurs { |
120 | foreach my $file (keys %Files) { |
121 | my $dir = dirname($file); |
122 | if( -e $dir ) { |
123 | rmtree($dir) || return; |
124 | } |
125 | } |
126 | return 1; |
45bc4d3a |
127 | } |
128 | |
129 | |
a7d1454b |
130 | 1; |