| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Test::XT; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =pod | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 NAME | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | Test::XT - Generate best practice release-only tests | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | use Test::XT 'WriteXT'; | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | # Write some specific tests: | 
| 14 |  |  |  |  |  |  | WriteXT( | 
| 15 |  |  |  |  |  |  | # Generally safe and recommended for most distributions | 
| 16 |  |  |  |  |  |  | 'Test::Pod'            => 'xt/pod.t', | 
| 17 |  |  |  |  |  |  | 'Test::CPAN::Meta'     => 'xt/meta.t', | 
| 18 |  |  |  |  |  |  | 'Test::MinimumVersion' => 'xt/minimumversion.t', | 
| 19 |  |  |  |  |  |  | 'Test::HasVersion'     => 'xt/hasversion.t', | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # Controversial history and methodology, does not install reliably. | 
| 22 |  |  |  |  |  |  | # Forced use leads to cargo cult of worse-than-nothing empty method stubs. | 
| 23 |  |  |  |  |  |  | 'Test::Pod::Coverage'  => 'xt/podcoverage.t', | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | # May become unreliable over time as PPI and Perl::Critic change. | 
| 26 |  |  |  |  |  |  | # Safe when BOTH distribution and policy file are active and maintained. | 
| 27 |  |  |  |  |  |  | 'Test::Perl::Critic'   => 'xt/critic.t', | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | # Should only be used if you hand-maintain your MANIFEST file. | 
| 30 |  |  |  |  |  |  | # Can be presumptive about MANIFEST.SKIP in some situations. | 
| 31 |  |  |  |  |  |  | 'Test::DistManifest'   => 'xt/distmanifest.t', | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | # Does not install reliably, does not install AT ALL on Windows. | 
| 34 |  |  |  |  |  |  | 'Test::CheckChanges'   => 'xt/changes.t', | 
| 35 |  |  |  |  |  |  | ); | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | A number of Test modules have been written over the years to support | 
| 40 |  |  |  |  |  |  | authors. Typically, these modules have standard short test scripts | 
| 41 |  |  |  |  |  |  | documented in them that you can cut and paste into your distribution. | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | Unfortunately almost all of these cut-and-paste test scripts are wrong. | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | Either the test script runs during install time, or it runs with an | 
| 46 |  |  |  |  |  |  | out-of-date version of the test module, or the author adds the test | 
| 47 |  |  |  |  |  |  | modules as an (unnecesary) dependency at install time, or for automated | 
| 48 |  |  |  |  |  |  | testing. | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | B is a module intended for use in code generators, release | 
| 51 |  |  |  |  |  |  | automation and other ancillary systems. It generates an appropriate test | 
| 52 |  |  |  |  |  |  | script for various testing modules that runs in the appropriate mode for | 
| 53 |  |  |  |  |  |  | each type of execution environment. | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | 1. End User Install | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | At installation time, test scripts should never ever run, even if the | 
| 58 |  |  |  |  |  |  | test modules are installed and available. | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | 2. Automated Testing | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | # Enable automated testing | 
| 63 |  |  |  |  |  |  | $ENV{AUTOMATED_TESTING} = 1 | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | During automated testing we should run the tests, but only if the testing | 
| 66 |  |  |  |  |  |  | module are already installed and at the current/latest version. | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | However, we should not install dependencies during automated testing, | 
| 69 |  |  |  |  |  |  | because failing to install a testing dependency means B runs | 
| 70 |  |  |  |  |  |  | on your code when the entire point of the author tests is to improve | 
| 71 |  |  |  |  |  |  | the standard of testing, not reduce it. | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | 3. Release/Author Testing | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | # Enable author tests | 
| 76 |  |  |  |  |  |  | $ENV{RELEASE_TESTING} = 1; | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | All tests should be run at release time by the author. Despite this, the | 
| 79 |  |  |  |  |  |  | dependencies should NEVER be added to your F or F, | 
| 80 |  |  |  |  |  |  | because it is far too easy to accidentally have these extra | 
| 81 |  |  |  |  |  |  | dependencies bleed through into your published META.yml. | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | This would cause inaccuracies in tools that track dependencies | 
| 84 |  |  |  |  |  |  | across the entire repository via the META.yml files. | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | =cut | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 10 |  |  | 10 |  | 32558 | use 5.008; | 
|  | 10 |  |  |  |  | 28 |  | 
| 89 | 10 |  |  | 10 |  | 46 | use strict; | 
|  | 10 |  |  |  |  | 13 |  | 
|  | 10 |  |  |  |  | 223 |  | 
| 90 | 10 |  |  | 10 |  | 48 | use warnings; | 
|  | 10 |  |  |  |  | 19 |  | 
|  | 10 |  |  |  |  | 419 |  | 
| 91 | 10 |  |  | 10 |  | 49 | use Exporter (); | 
|  | 10 |  |  |  |  | 14 |  | 
|  | 10 |  |  |  |  | 182 |  | 
| 92 | 10 |  |  | 10 |  | 38 | use Carp     (); | 
|  | 10 |  |  |  |  | 12 |  | 
|  | 10 |  |  |  |  | 199 |  | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 10 |  |  | 10 |  | 44 | use vars qw{$VERSION @ISA @EXPORT_OK}; | 
|  | 10 |  |  |  |  | 18 |  | 
|  | 10 |  |  |  |  | 982 |  | 
| 95 |  |  |  |  |  |  | BEGIN { | 
| 96 | 10 |  |  | 10 |  | 20 | $VERSION   = '0.03_02'; | 
| 97 | 10 |  |  |  |  | 549 | $VERSION   = eval $VERSION; # For dev release only | 
| 98 | 10 |  |  |  |  | 134 | @ISA       = 'Exporter'; | 
| 99 | 10 |  |  |  |  | 7875 | @EXPORT_OK = qw{ | 
| 100 |  |  |  |  |  |  | WriteTest | 
| 101 |  |  |  |  |  |  | WriteXT | 
| 102 |  |  |  |  |  |  | }; | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | =pod | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | =head1 SUPPORTED TEST MODULES | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | =over | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | =item * L | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | =item * L | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =item * L | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | =item * L | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | =item * L | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =item * L | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =item * L | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | =item * L | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | =back | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | To programmatically extract a list of the relevant module files, or to get | 
| 130 |  |  |  |  |  |  | informtion about supported modules, you may directly access the underlying | 
| 131 |  |  |  |  |  |  | hash: | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | %Test::XT::STANDARD | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | Please note that this interface is experimental and subject to change. | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | =cut | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | # Data for standard tests | 
| 140 |  |  |  |  |  |  | our %STANDARD = ( | 
| 141 |  |  |  |  |  |  | 'Test::Pod' => { | 
| 142 |  |  |  |  |  |  | test    => 'all_pod_files_ok', | 
| 143 |  |  |  |  |  |  | release => 0, # is this a RELEASE test only? | 
| 144 |  |  |  |  |  |  | comment => 'Test that the syntax of our POD documentation is valid', | 
| 145 |  |  |  |  |  |  | modules => { | 
| 146 |  |  |  |  |  |  | 'Pod::Simple' => '3.07', | 
| 147 |  |  |  |  |  |  | 'Test::Pod'   => '1.26', | 
| 148 |  |  |  |  |  |  | }, | 
| 149 |  |  |  |  |  |  | default => 'pod.t', | 
| 150 |  |  |  |  |  |  | }, | 
| 151 |  |  |  |  |  |  | 'Test::CPAN::Meta' => { | 
| 152 |  |  |  |  |  |  | test    => 'meta_yaml_ok', | 
| 153 |  |  |  |  |  |  | release => 0, | 
| 154 |  |  |  |  |  |  | comment => 'Test that our META.yml file matches the specification', | 
| 155 |  |  |  |  |  |  | modules => { | 
| 156 |  |  |  |  |  |  | 'Test::CPAN::Meta' => '0.12', | 
| 157 |  |  |  |  |  |  | }, | 
| 158 |  |  |  |  |  |  | default => 'meta.t', | 
| 159 |  |  |  |  |  |  | }, | 
| 160 |  |  |  |  |  |  | 'Test::HasVersion' => { | 
| 161 |  |  |  |  |  |  | test    => 'all_pm_version_ok', | 
| 162 |  |  |  |  |  |  | release => 0, | 
| 163 |  |  |  |  |  |  | comment => 'Test that all modules have a version number', | 
| 164 |  |  |  |  |  |  | modules => { | 
| 165 |  |  |  |  |  |  | 'Test::HasVersion' => '0.012', | 
| 166 |  |  |  |  |  |  | }, | 
| 167 |  |  |  |  |  |  | default => 'hasversion.t', | 
| 168 |  |  |  |  |  |  | }, | 
| 169 |  |  |  |  |  |  | 'Test::MinimumVersion' => { | 
| 170 |  |  |  |  |  |  | test    => 'all_minimum_version_from_metayml_ok', | 
| 171 |  |  |  |  |  |  | release => 0, | 
| 172 |  |  |  |  |  |  | comment => 'Test that our declared minimum Perl version matches our syntax', | 
| 173 |  |  |  |  |  |  | modules => { | 
| 174 |  |  |  |  |  |  | 'Perl::MinimumVersion' => '1.20', | 
| 175 |  |  |  |  |  |  | 'Test::MinimumVersion' => '0.008', | 
| 176 |  |  |  |  |  |  | }, | 
| 177 |  |  |  |  |  |  | default => 'minimumversion.t', | 
| 178 |  |  |  |  |  |  | }, | 
| 179 |  |  |  |  |  |  | 'Test::Perl::Critic' => { | 
| 180 |  |  |  |  |  |  | test    => 'all_critic_ok', | 
| 181 |  |  |  |  |  |  | release => 1, | 
| 182 |  |  |  |  |  |  | comment => 'Test that the module passes perlcritic', | 
| 183 |  |  |  |  |  |  | modules => { | 
| 184 |  |  |  |  |  |  | 'Perl::Critic'       => '1.098', | 
| 185 |  |  |  |  |  |  | 'Test::Perl::Critic' => '1.01', | 
| 186 |  |  |  |  |  |  | }, | 
| 187 |  |  |  |  |  |  | default => 'critic.t', | 
| 188 |  |  |  |  |  |  | }, | 
| 189 |  |  |  |  |  |  | 'Test::DistManifest' => { | 
| 190 |  |  |  |  |  |  | test    => 'manifest_ok', | 
| 191 |  |  |  |  |  |  | release => 1, | 
| 192 |  |  |  |  |  |  | comment => 'Test that the module MANIFEST is up-to-date', | 
| 193 |  |  |  |  |  |  | modules => { | 
| 194 |  |  |  |  |  |  | 'Test::DistManifest' => '1.003', | 
| 195 |  |  |  |  |  |  | }, | 
| 196 |  |  |  |  |  |  | default => 'distmanifest.t', | 
| 197 |  |  |  |  |  |  | }, | 
| 198 |  |  |  |  |  |  | 'Test::Pod::Coverage' => { | 
| 199 |  |  |  |  |  |  | test    => 'all_pod_coverage_ok', | 
| 200 |  |  |  |  |  |  | release => 1, | 
| 201 |  |  |  |  |  |  | comment => 'Ensure pod coverage in your distribution', | 
| 202 |  |  |  |  |  |  | modules => { | 
| 203 |  |  |  |  |  |  | 'Test::Pod::Coverage' => '1.08', | 
| 204 |  |  |  |  |  |  | }, | 
| 205 |  |  |  |  |  |  | default => 'podcoverage.t', | 
| 206 |  |  |  |  |  |  | }, | 
| 207 |  |  |  |  |  |  | 'Test::CheckChanges' => { | 
| 208 |  |  |  |  |  |  | test    => 'ok_changes', | 
| 209 |  |  |  |  |  |  | release => 0, | 
| 210 |  |  |  |  |  |  | comment => 'Test that Changes has an entry for current version', | 
| 211 |  |  |  |  |  |  | modules => { | 
| 212 |  |  |  |  |  |  | 'Test::CheckChanges' => '0.08', | 
| 213 |  |  |  |  |  |  | }, | 
| 214 |  |  |  |  |  |  | default => 'changes.t', | 
| 215 |  |  |  |  |  |  | }, | 
| 216 |  |  |  |  |  |  | ); | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | ##################################################################### | 
| 223 |  |  |  |  |  |  | # Exportable Functions | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | =pod | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | =head1 FUNCTIONS | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | =head2 WriteTest | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | WriteTest( | 
| 232 |  |  |  |  |  |  | 'xt/something.t', | 
| 233 |  |  |  |  |  |  | test    => 'ok_changes', | 
| 234 |  |  |  |  |  |  | release => 0, | 
| 235 |  |  |  |  |  |  | comment => 'Test that Changes has an entry for current version', | 
| 236 |  |  |  |  |  |  | modules => { | 
| 237 |  |  |  |  |  |  | 'Test::CheckChanges' => '0.08', | 
| 238 |  |  |  |  |  |  | }, | 
| 239 |  |  |  |  |  |  | ); | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | This function provides a simple way to write a single test to a file, | 
| 242 |  |  |  |  |  |  | following the usual template. The test data is a hash (Note: it's NOT a | 
| 243 |  |  |  |  |  |  | hash reference). | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  | The example above writes a test to B that loads L if | 
| 246 |  |  |  |  |  |  | available, calling the C function if it is. A few knobs | 
| 247 |  |  |  |  |  |  | control how this works: | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | =over | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | =item * B is the name of the subroutine to run, which has to be | 
| 252 |  |  |  |  |  |  | exported from the test module. | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | =item * B determines whether this is a release-only test, which | 
| 255 |  |  |  |  |  |  | means it is not executed during automated testing, even if the needed | 
| 256 |  |  |  |  |  |  | prerequisites are available. | 
| 257 |  |  |  |  |  |  |  | 
| 258 |  |  |  |  |  |  | =item * B is the default comment which briefly describes the test. | 
| 259 |  |  |  |  |  |  |  | 
| 260 |  |  |  |  |  |  | =item * B is a hash reference containing pairs of modules and | 
| 261 |  |  |  |  |  |  | their required versions. If no particular version is required, use 0. | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | =back | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | =cut | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | sub WriteTest { | 
| 268 | 0 |  |  | 0 | 1 | 0 | my $file = shift; | 
| 269 | 0 |  |  |  |  | 0 | Test::XT->new( @_ )->write( $file ); | 
| 270 |  |  |  |  |  |  | } | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | =pod | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | =head2 WriteXT | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | WriteXT( | 
| 277 |  |  |  |  |  |  | 'Test::Pod'            => 'xt/pod.t', | 
| 278 |  |  |  |  |  |  | 'Test::CPAN::Meta'     => 'xt/meta.t', | 
| 279 |  |  |  |  |  |  | 'Test::MinimumVersion' => 'xt/minimumversion.t', | 
| 280 |  |  |  |  |  |  | 'Test::Perl::Critic'   => 'xt/critic.t', | 
| 281 |  |  |  |  |  |  | ); | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | This provides a convenient way to write multiple test files using the default | 
| 284 |  |  |  |  |  |  | profile settings (such as which modules to require, what subroutine to call, | 
| 285 |  |  |  |  |  |  | whether this is a release-only test, and so on). | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | Example code: | 
| 288 |  |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  | =cut | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | sub WriteXT { | 
| 292 | 9 |  |  | 9 | 1 | 1115 | while ( @_ ) { | 
| 293 | 9 |  |  |  |  | 21 | my $module = shift; | 
| 294 | 9 |  |  |  |  | 16 | my $file   = shift; | 
| 295 |  |  |  |  |  |  |  | 
| 296 | 9 | 50 |  |  |  | 44 | unless ( $STANDARD{$module} ) { | 
| 297 | 0 |  |  |  |  | 0 | Carp::croak('Unknown standard test script ' . $module); | 
| 298 |  |  |  |  |  |  | } | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | Test::XT->new( | 
| 301 | 9 |  |  |  |  | 18 | %{$STANDARD{$module}} | 
|  | 9 |  |  |  |  | 96 |  | 
| 302 |  |  |  |  |  |  | )->write( $file ); | 
| 303 |  |  |  |  |  |  | } | 
| 304 |  |  |  |  |  |  | } | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  |  | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | ##################################################################### | 
| 311 |  |  |  |  |  |  | # Object Form | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | =pod | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | =head1 OBJECT ORIENTED INTERFACE | 
| 316 |  |  |  |  |  |  |  | 
| 317 |  |  |  |  |  |  | =head2 new | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | my $test = Test::XT->new( | 
| 320 |  |  |  |  |  |  | test    => 'all_pod_files_ok', | 
| 321 |  |  |  |  |  |  | release => 0, # is this a RELEASE test only? | 
| 322 |  |  |  |  |  |  | comment => 'Test that the syntax of our POD documentation is valid', | 
| 323 |  |  |  |  |  |  | modules => { | 
| 324 |  |  |  |  |  |  | 'Pod::Simple' => '3.07', | 
| 325 |  |  |  |  |  |  | 'Test::Pod'   => '1.26', | 
| 326 |  |  |  |  |  |  | }, | 
| 327 |  |  |  |  |  |  | default => 'pod.t', | 
| 328 |  |  |  |  |  |  | ); | 
| 329 |  |  |  |  |  |  |  | 
| 330 |  |  |  |  |  |  | This produces a new object that stores information about a given test module. | 
| 331 |  |  |  |  |  |  | It can then be transformed into output suitable for use in a stream (via | 
| 332 |  |  |  |  |  |  | C, which returns the test script as a string) or for writing | 
| 333 |  |  |  |  |  |  | directly to a file (using C). | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | For details on the available options, see B | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  | =cut | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | sub new { | 
| 340 | 9 |  |  | 9 | 1 | 16 | my $class = shift; | 
| 341 | 9 |  |  |  |  | 50 | my $self  = bless { @_ }, $class; | 
| 342 | 9 |  |  |  |  | 40 | return $self; | 
| 343 |  |  |  |  |  |  | } | 
| 344 |  |  |  |  |  |  |  | 
| 345 |  |  |  |  |  |  | =head2 module | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | $test->module( 'Foo::Bar' => '1.23' ); | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | Add a module dependency for the test script. | 
| 350 |  |  |  |  |  |  |  | 
| 351 |  |  |  |  |  |  | =cut | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | sub module { | 
| 354 | 0 |  |  | 0 | 1 | 0 | $_[0]->{modules}->{$_[1]} = $_[2]; | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | =head2 test | 
| 358 |  |  |  |  |  |  |  | 
| 359 |  |  |  |  |  |  | $test->test( $command ); | 
| 360 |  |  |  |  |  |  |  | 
| 361 |  |  |  |  |  |  | Change the name of the subroutine which is called to actually run the test. | 
| 362 |  |  |  |  |  |  |  | 
| 363 |  |  |  |  |  |  | Code example: | 
| 364 |  |  |  |  |  |  |  | 
| 365 |  |  |  |  |  |  | $test->test('all_pod_coverage_ok'); | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | =cut | 
| 368 |  |  |  |  |  |  |  | 
| 369 |  |  |  |  |  |  | sub test { | 
| 370 | 0 |  |  | 0 | 1 | 0 | $_[0]->{test} = $_[1]; | 
| 371 |  |  |  |  |  |  | } | 
| 372 |  |  |  |  |  |  |  | 
| 373 |  |  |  |  |  |  | =head2 write | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | $test->write( $path ) | 
| 376 |  |  |  |  |  |  |  | 
| 377 |  |  |  |  |  |  | This method writes the test file to the provided path. | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | Note that this method throws an exception upon failure to open the file. | 
| 380 |  |  |  |  |  |  |  | 
| 381 |  |  |  |  |  |  | Code example: | 
| 382 |  |  |  |  |  |  |  | 
| 383 |  |  |  |  |  |  | eval { | 
| 384 |  |  |  |  |  |  | $test->write('t/file.t'); | 
| 385 |  |  |  |  |  |  | }; | 
| 386 |  |  |  |  |  |  | print "Failure writing file" if $@; | 
| 387 |  |  |  |  |  |  |  | 
| 388 |  |  |  |  |  |  | =cut | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | sub write { | 
| 391 | 9 |  |  | 9 | 1 | 17 | my $self   = shift; | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  | # Write the file | 
| 394 | 9 | 50 |  |  |  | 847 | open( FILE, '>', $_[0 ] ) or Carp::croak("Failed to open file: $!"); | 
| 395 | 9 |  |  |  |  | 42 | print FILE $self->write_string; | 
| 396 | 9 |  |  |  |  | 399 | close FILE; | 
| 397 |  |  |  |  |  |  |  | 
| 398 | 9 |  |  |  |  | 128 | return 1; | 
| 399 |  |  |  |  |  |  | } | 
| 400 |  |  |  |  |  |  |  | 
| 401 |  |  |  |  |  |  | =head2 write_string | 
| 402 |  |  |  |  |  |  |  | 
| 403 |  |  |  |  |  |  | $test->write_string() | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  | This method writes the test script as a chunk of text and returns it. Note | 
| 406 |  |  |  |  |  |  | that this is the exact script written out to file via C. | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | Code example: | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  | print "Test script:\n"; | 
| 411 |  |  |  |  |  |  | print $test->write_string; | 
| 412 |  |  |  |  |  |  |  | 
| 413 |  |  |  |  |  |  | =cut | 
| 414 |  |  |  |  |  |  |  | 
| 415 |  |  |  |  |  |  | sub write_string { | 
| 416 | 9 |  |  | 9 | 1 | 18 | my $self    = shift; | 
| 417 | 9 | 50 |  |  |  | 93 | my $comment = $self->{comment} ? "\n# $self->{comment}" : ''; | 
| 418 |  |  |  |  |  |  | my $modules = join "\n", map { | 
| 419 | 14 |  |  |  |  | 61 | "\t'$_ $self->{modules}->{$_}'," | 
| 420 | 9 |  |  |  |  | 20 | } sort keys %{$self->{modules}}; | 
|  | 9 |  |  |  |  | 55 |  | 
| 421 | 9 |  |  |  |  | 39 | my $o       = << "END_HEADER"; | 
| 422 |  |  |  |  |  |  | #!/usr/bin/perl | 
| 423 |  |  |  |  |  |  | $comment | 
| 424 |  |  |  |  |  |  | use strict; | 
| 425 |  |  |  |  |  |  | BEGIN { | 
| 426 |  |  |  |  |  |  | \$|  = 1; | 
| 427 |  |  |  |  |  |  | \$^W = 1; | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | my \@MODULES = ( | 
| 431 |  |  |  |  |  |  | $modules | 
| 432 |  |  |  |  |  |  | ); | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | # Don't run tests during end-user installs | 
| 435 |  |  |  |  |  |  | use Test::More; | 
| 436 |  |  |  |  |  |  | END_HEADER | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | # See if this is RELEASE_TESTING only | 
| 439 | 9 |  |  |  |  | 36 | $o .= "plan( skip_all => 'Author tests not required for installation' )\n"; | 
| 440 | 9 |  |  |  |  | 18 | $o .= q|	unless ( $ENV{RELEASE_TESTING}|; | 
| 441 | 9 | 100 |  |  |  | 32 | unless ( $self->{release} ) { | 
| 442 | 7 |  |  |  |  | 12 | $o .= ' or $ENV{AUTOMATED_TESTING}'; | 
| 443 |  |  |  |  |  |  | } | 
| 444 | 9 |  |  |  |  | 14 | $o .= " );\n\n"; | 
| 445 |  |  |  |  |  |  |  | 
| 446 | 9 |  |  |  |  | 21 | $o .= << 'END_MODULES'; | 
| 447 |  |  |  |  |  |  | # Load the testing modules | 
| 448 |  |  |  |  |  |  | foreach my $MODULE ( @MODULES ) { | 
| 449 |  |  |  |  |  |  | eval "use $MODULE"; | 
| 450 |  |  |  |  |  |  | if ( $@ ) { | 
| 451 |  |  |  |  |  |  | $ENV{RELEASE_TESTING} | 
| 452 |  |  |  |  |  |  | ? die( "Failed to load required release-testing module $MODULE" ) | 
| 453 |  |  |  |  |  |  | : plan( skip_all => "$MODULE not available for testing" ); | 
| 454 |  |  |  |  |  |  | } | 
| 455 |  |  |  |  |  |  | } | 
| 456 |  |  |  |  |  |  |  | 
| 457 |  |  |  |  |  |  | END_MODULES | 
| 458 |  |  |  |  |  |  |  | 
| 459 | 9 |  |  |  |  | 24 | $o .= $self->{test} . "();\n\n"; | 
| 460 | 9 |  |  |  |  | 15 | $o .= "1;\n"; | 
| 461 | 9 |  |  |  |  | 135 | return $o; | 
| 462 |  |  |  |  |  |  | } | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | 1; | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | =pod | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  | =head1 LIMITATIONS | 
| 469 |  |  |  |  |  |  |  | 
| 470 |  |  |  |  |  |  | This module is still missing support for lots of other author tests. | 
| 471 |  |  |  |  |  |  |  | 
| 472 |  |  |  |  |  |  | =head1 SUPPORT | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | This module is stored in an Open Repository at the following address: | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  | L | 
| 477 |  |  |  |  |  |  |  | 
| 478 |  |  |  |  |  |  | Write access to the repository is made available automatically to any | 
| 479 |  |  |  |  |  |  | published CPAN author, and to most other volunteers on request. | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | If you are able to submit your bug report in the form of new (failing) unit | 
| 482 |  |  |  |  |  |  | tests, or can apply your fix directly instead of submitting a patch, you are | 
| 483 |  |  |  |  |  |  | B encouraged to do so. The author currently maintains over 100 | 
| 484 |  |  |  |  |  |  | modules and it may take some time to deal with non-critical bug reports or | 
| 485 |  |  |  |  |  |  | patches. | 
| 486 |  |  |  |  |  |  |  | 
| 487 |  |  |  |  |  |  | This will guarantee that your issue will be addressed in the next release of | 
| 488 |  |  |  |  |  |  | the module. | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | If you cannot provide a direct test or fix, or don't have time to do so, then | 
| 491 |  |  |  |  |  |  | regular bug reports are still accepted and appreciated via the CPAN bug | 
| 492 |  |  |  |  |  |  | tracker. | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | L | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  | For other issues, for commercial enhancement and support, or to have your | 
| 497 |  |  |  |  |  |  | write access enabled for the repository, contact the author at the email | 
| 498 |  |  |  |  |  |  | address above. | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | =head1 AUTHORS | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | Adam Kennedy Eadamk@cpan.orgE | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | Jonathan Yu Ejawnsy@cpan.orgE | 
| 505 |  |  |  |  |  |  |  | 
| 506 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | L, which explains why this style | 
| 509 |  |  |  |  |  |  | of testing is beneficial to you and the CPAN-at-large. | 
| 510 |  |  |  |  |  |  |  | 
| 511 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 512 |  |  |  |  |  |  |  | 
| 513 |  |  |  |  |  |  | Copyright 2009-2011 Adam Kennedy | 
| 514 |  |  |  |  |  |  |  | 
| 515 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 516 |  |  |  |  |  |  | under the same terms as Perl itself. | 
| 517 |  |  |  |  |  |  |  | 
| 518 |  |  |  |  |  |  | The full text of the license can be found in the LICENSE file included | 
| 519 |  |  |  |  |  |  | with this module. | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | =cut |