Test-Cmd-1.09/000755 000765 000024 00000000000 12613140643 013317 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/Changes000644 000765 000024 00000014302 12613140642 014611 0ustar00neilbstaff000000 000000 Revision history for Perl module Test::Cmd 1.09 2015-10-25 NEILB - README updated with current location of Aegis project. Thanks to @SparkeyG for the pull request - Updated github repo URL after changing my github username - Switched to Dist::Zilla 1.08 2015-01-25 NEILB - Documentation improvements from JMATES++. 1.07 2015-01-07 NEILB - Linkify external module references. JMATES++ - Added Test::Pod as a release test. JMATES++ 1.06 2014-04-09 - First non-developer release by NEILB - Fixed RT#41504 - Fixed RT#92082 - Fixed RT#92081 - Fixed RT#53619 - Noted in the pod that I'm now maintaining it. 1.05_02 2014-04-08 - If the constructor failed part way, it would sometimes leave cruft behind in TMPDIR. RT#41504 - thanks ANDK. 1.05_01 2014-04-02 - Specified min perl version 5.6.0 in metadata and in code - Moved the modules into lib/Test/ - Added PREREQ_PM, TEST_REQUIRES and CONFIGURE_REQUIRES to Makefile.PL - Added github repo to metadata and the pod - Reformatted Changes file as per CPAN::Changes::Spec - Specified license as 'perl' in metadata, to match doc - Fixed pod error RT#92082 - Pod spelling mistake RT#92081 - Clarification in doc for new(), that it returns undef on failure, and not false. RT#53619 1.05 2001-09-07 - Fix the subdir(), read(), and write() methods to handle the case when the first element in an array-reference file name is an absolute path name. - Fix writable() so that it only records errors from chmod() on files, not exit with no_result(). - Doc changes to make some of the variables in the SYNOPSIS look like Perl variables. - Add a Test::Cmd::Common module that sub-classes Test::Cmd to provide common exception-handling, eliminating the need for everyone to roll their own fail()/no_result() logic for common errors. - Update Test::Cmd documentation to add explicit examples of using Test::Cmd in conjunction with Test::Harness, Test::Unit, and Aegis. Mention that Test::Cmd::Common is available. 1.04 2001-06-16 - If the run() method is given an explicit 'prog' argument, don't use the test environment's 'interpreter' attribute to run it. This loses if you're trying to run some other executable that isn't in the same scripting language as the program under test. 1.03 2001-06-11 - Make specification of an 'interpreter' to the run() method independent of whether a 'prog' has been specified. - Actually store the absolute path to a workdir specified as a relative path, as advertised. (Thanks to Jonathan Ross for finding this bug and contributing a patch.) 1.02 2001-05-26 - Small fix to make match() backwards compatible to Perl 5.003. - Add diff_exact() and diff_regex() methods for returning UNIX diff(1)-like output from file comparisons. - Accomodate $TMPDIR specifications that vary from Cwd::cwd() due to symbolic links or omission of NT drive letters. 1.01 200-08-29 - Add a match_exact() method for non-regex matches. - Change the name of the match() method to match_regex(). - Add a new match() method that calls a registered line-matching subroutine to do the match. By default, this is match_regex(), so the external interface stays backwards-compatible. - Add a match_sub() method that allows an arbitrary line-matching subroutine to be registered. - EXPORT_OK the match_exact() and match_regex() methods to make it easier to register them. 1.00 2000-05-26 - The early versions have been out there long enough, so promote the version number to 1.00. - White space cleanup. - Small fixes for Perl 5.003: put quotes around hash index strings; don't use "my" on the same line as "foreach". - Add copyright statements to appropriate files. 0.04 2000-02-09 - Removed unnecessary t0001a.pl file (internal testing glue for the change management system). - In the run() method, add the ability to pipe input into a command. - Add a match() method that matches input lines one-for-one against an equal number of of regular expressions. - Have the run() method support 'prog' and 'interpreter' arguments, for one-shot execution of a program. - Remove direct exception throws (calls to $self->no_result) by the run() and workdir() methods. Exceptions should be handled by the test itself or a subclass specific to the program under test. 0.03 2000-02-01 - Minor white space cleanup. - Allow the write() method to take an absolute path name. - Documentation cleanup. - Add a read() method as a companion to write(). - Directories were still removed on fail/no result if PRESERVE_FAIL and PRESERVE_NO_RESULT were set. Fixed. - Where possible, use array assignment, not shift, for method arguments. 0.02 2000-01-13 - Add a string() method to arrange for printing info about specific functionality under test upon failure or no result. - Add a basename() method to return the basename of the program under test (the prog() method returns the full path). - Add a workpath() method to catfile its arguments to the end of the temporary working directory; this pushes more of the OS-dependent gunk into the module. - Allow the write() method to take an array reference as a file name argument, in which case the arguments are concatenated using File::Spec->catfile(). - Allow the subdir() method to take a array references as arguments, in which case the elements are concatenated using File::Spec->catfile(). - Change the run() method to take named-keyword arguments like $test->run(args => '1 2 3', chdir => 'sub/dir') instead of the old positional arguments. - Add $caller arguments to the fail() and no_result() methods which specify how many levels back to print a trace of the exiting line. This allows nested packages to get back to the original caller. 0.01 1999-11-11 - Original version; created by h2xs 1.19 - Not released to CPAN Test-Cmd-1.09/dist.ini000644 000765 000024 00000000437 12613140642 014766 0ustar00neilbstaff000000 000000 name = Test-Cmd author = Steven Knight license = Perl_5 copyright_holder = Steven Knight copyright_year = 1999 version = 1.09 [@Filter] -bundle = @Basic -remove = Readme [PkgVersion] [AutoPrereqs] [MetaJSON] [GithubMeta] [Git::Tag] tag_message= [Git::Push] Test-Cmd-1.09/lib/000755 000765 000024 00000000000 12613140643 014065 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/LICENSE000644 000765 000024 00000043660 12613140642 014334 0ustar00neilbstaff000000 000000 This software is copyright (c) 1999 by Steven Knight. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 1999 by Steven Knight. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 1999 by Steven Knight. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Test-Cmd-1.09/Makefile.PL000644 000765 000024 00000002630 12613140643 015272 0ustar00neilbstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.037. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl module for portable testing of commands and scripts", "AUTHOR" => "Steven Knight ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Test-Cmd", "EXE_FILES" => [], "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006", "NAME" => "Test::Cmd", "PREREQ_PM" => { "Cwd" => 0, "Exporter" => 0, "File::Basename" => 0, "File::Copy" => 0, "File::Find" => 0, "File::Spec" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Test" => 0, "Test::More" => 0 }, "VERSION" => "1.09", "test" => { "TESTS" => "t/*.t t/Common/*.t" } ); my %FallbackPrereqs = ( "Cwd" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Copy" => 0, "File::Find" => 0, "File::Spec" => 0, "Test" => 0, "Test::More" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Test-Cmd-1.09/MANIFEST000644 000765 000024 00000001410 12613140642 014443 0ustar00neilbstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.037. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Test/Cmd.pm lib/Test/Cmd/Common.pm t/Common/chmod.t t/Common/copy.t t/Common/f_matches.t t/Common/m_exist.t t/Common/m_n_exist.t t/Common/read.t t/Common/run.t t/Common/sleep.t t/Common/subdir.t t/Common/touch.t t/Common/unlink.t t/Common/write.t t/ENV_PRESERVE.t t/EXPORT_OK.t t/TMPDIR.t t/basename.t t/cleanup.t t/diff_exact.t t/diff_regex.t t/exit.t t/fail.t t/interpreter.t t/match.t t/match_exact.t t/match_regex.t t/match_sub.t t/no_result.t t/pass.t t/pod.t t/preserve.t t/prog.t t/read.t t/run.t t/stderr.t t/stdin.t t/stdout.t t/string.t t/subdir.t t/workdir.t t/workdirs.t t/workpath.t t/writable.t t/write.t Test-Cmd-1.09/META.json000644 000765 000024 00000002445 12613140642 014744 0ustar00neilbstaff000000 000000 { "abstract" : "Perl module for portable testing of commands and scripts", "author" : [ "Steven Knight " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test-Cmd", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Cwd" : "0", "Exporter" : "0", "File::Basename" : "0", "File::Copy" : "0", "File::Find" : "0", "File::Spec" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Test" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://github.com/neilb/Test-Cmd", "repository" : { "type" : "git", "url" : "https://github.com/neilb/Test-Cmd.git", "web" : "https://github.com/neilb/Test-Cmd" } }, "version" : "1.09" } Test-Cmd-1.09/META.yml000644 000765 000024 00000001316 12613140642 014570 0ustar00neilbstaff000000 000000 --- abstract: 'Perl module for portable testing of commands and scripts' author: - 'Steven Knight ' build_requires: Test: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Cmd requires: Cwd: '0' Exporter: '0' File::Basename: '0' File::Copy: '0' File::Find: '0' File::Spec: '0' perl: '5.006' strict: '0' warnings: '0' resources: homepage: https://github.com/neilb/Test-Cmd repository: https://github.com/neilb/Test-Cmd.git version: '1.09' Test-Cmd-1.09/README000644 000765 000024 00000006135 12613140642 014203 0ustar00neilbstaff000000 000000 THE Test::Cmd MODULE The Test::Cmd module provides a framework for portable automated testing of executable commands and scripts (in any language, not just Perl), especially commands and scripts that interace with the file system. In addition to running tests and evaluating conditions, the Test::Cmd module manages and cleans up one or more temporary workspace directories, and provides methods for creating files and directories in those workspace directories from in-line data (that is, here-documents), allowing tests to be completely self-contained. The Test::Cmd module inherits File::Spec methods (file_name_is_absolute(), catfile(), etc.) to support writing tests portably across a variety of operating and file systems. The Test::Cmd module may be used with the Test module to report test results for use with the Test::Harness module. Alternatively, the Test::Cmd module provides pass(), fail(), and no_result() methods that report test results for use with the Aegis change management system. It is not a good idea to intermix these two reporting models. INSTALLATION Installation is via the usual incantation: # perl Makefile.PL # make # make test # make install Let me know if you have any problems. RESOURCES A rudimentary page for the Test::Cmd module is available at: http://www.baldmt.com/Test-Cmd/ The most involved example of using the Test::Cmd package to test a real-world application is the "cons-test" testing suite for the Cons software construction utility. The suite sub-classes Test::Cmd to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons TO DO The t/run.t test jumps through some complicated (but reasonably documented) hoops to generate an executable Perl script on Windows NT systems. I have no doubt that someone with a better knowledge of NT than mine could do this more simply, and would love to hear of a better solution than what I came up with. Adding a timeout() method would provide better test automation for applications that run the risk of hanging. A feature to time tests would be good. COPYRIGHT Copyright 1999-2001 Steven Knight. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ACKNOWLEDGEMENTS Thanks to Greg Spencer for the inspiration to create this package and the initial draft of its implementation as a specific testing package for the Cons software construction utility. Information about Cons is available at: http://www.dsmit.com/cons/ The general idea of managing temporary working directories in this way, as well as the test reporting of the pass(), fail() and no_result() methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://aegis.sourceforge.net/ AUTHOR Steven Knight, knight@baldmt.com Test-Cmd-1.09/t/000755 000765 000024 00000000000 12613140643 013562 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/t/basename.t000644 000765 000024 00000001342 12613140643 015522 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test); $test = Test::Cmd->new; ok($test); ok(! $test->basename); $test->prog('foo'); ok($test->basename eq 'foo'); $test->prog('foo.pl'); ok($test->basename eq 'foo.pl'); ok($test->basename('.pl') eq 'foo'); ok($test->basename('.xyzzy', '.pl', '.zark') eq 'foo'); Test-Cmd-1.09/t/cleanup.t000644 000765 000024 00000001710 12613140643 015375 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file1', <cleanup; ok(! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file2', <cleanup; ok(! -d $wdir); Test-Cmd-1.09/t/Common/000755 000765 000024 00000000000 12613140643 015012 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/t/diff_exact.t000644 000765 000024 00000005531 12613140643 016047 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; eval "use Algorithm::DiffOld"; $diffold = ! $@; plan tests => 24, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes, @diff); $ret = Test::Cmd->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 2 3 _EOF_ ok($ret); ok(@diff == 0); $ret = Test::Cmd->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 222 3 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2c2 < 222 --- > 2 _EOF_ Expected ===== 1 2 3 Actual ===== 1 222 3 _EOF_ $test = Test::Cmd->new; ok($test); $ret = $test->diff_exact("abcde\n", "a.*e\n", \@diff); ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1c1 < a.*e --- > abcde _EOF_ Expected ===== abcde Actual ===== a.*e _EOF_ $ret = $test->diff_exact("abcde\n", "abcde\n", \@diff); ok($ret); ok(! @diff); $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1,2c1,2 < 1\d+5 < a.*e --- > 12345 > abcde _EOF_ Expected ===== 1\d+5 a.*e Actual ===== 12345 abcde _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); ok(! @diff); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->diff_exact(\@lines, \@regexes, \@diff); ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1,2c1,2 < v[^a-u]*z < 6\S+0 --- > vwxyz > 67890 _EOF_ Expected ===== v[^a-u]*z 6\S+0 Actual ===== vwxyz 67890 _EOF_ $ret = $test->diff_exact(\@lines, \@lines, \@diff); ok($ret); ok(! @diff); $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 a b 2 3 c 4 5 _EOF_ 1 2 x 3 4 y z 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1a2,3 > a > b 3d4 < x 4a6 > c 6,7d7 < y < z _EOF_ Expected ===== 1 2 x 3 4 y z 5 Actual ===== 1 a b 2 3 c 4 5 _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 a 3 4 b c 5 _EOF_ 1 x y 2 3 z 4 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2,3d1 < x < y 4a3 > a 6d4 < z 7a6,7 > b > c _EOF_ Expected ===== 1 x y 2 3 z 4 5 Actual ===== 1 2 a 3 4 b c 5 _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); a b c e h j l m n p _EOF_ b c d e f j k l m r s t _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 0a1 > a 3d3 < d 5c5 < f --- > h 7d6 < k 10,12c9,10 < r < s < t --- > n > p _EOF_ Expected ===== b c d e f j k l m r s t Actual ===== a b c e h j l m n p _EOF_ Test-Cmd-1.09/t/diff_regex.t000644 000765 000024 00000004226 12613140643 016055 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; eval "use Algorithm::DiffOld"; $diffold = ! $@; plan tests => 18, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes, @diff); $ret = Test::Cmd->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 2 3 _EOF_ ok($ret); ok(@diff == 0); $ret = Test::Cmd->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 222 3 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2c2 < 222 --- > 2 _EOF_ Expected ===== 1 2 3 Actual ===== 1 222 3 _EOF_ $test = Test::Cmd->new; ok($test); $ret = $test->diff_regex("abcde\n", "a.*e\n", \@diff); ok($ret); ok(! @diff); $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); ok(! @diff); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->diff_regex(\@lines, \@regexes, \@diff); ok($ret); ok(! @diff); $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 a b 2 3 c 4 5 _EOF_ 1 2 x 3 4 y z 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1a2,3 > a > b 3d4 < x 4a6 > c 6,7d7 < y < z _EOF_ Expected ===== 1 2 x 3 4 y z 5 Actual ===== 1 a b 2 3 c 4 5 _EOF_ $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 a 3 4 b c 5 _EOF_ 1 x y 2 3 z 4 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2,3d1 < x < y 4a3 > a 6d4 < z 7a6,7 > b > c _EOF_ Expeced ===== 1 x y 2 3 z 4 5 Actual ===== 1 2 a 3 4 b c 5 _EOF_ $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); a b c e h j l m n p _EOF_ b c d e f j k l m r s t _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 0a1 > a 3d3 < d 5c5 < f --- > h 7d6 < k 10,12c9,10 < r < s < t --- > n > p _EOF_ Expected ===== b c d e f j k l m r s t Actual ===== a b c e h j l m n p _EOF_ Test-Cmd-1.09/t/ENV_PRESERVE.t000644 000765 000024 00000006031 12613140643 015712 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 28, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file1', <fail(! $ret); $test->cleanup; $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.1"); ok(defined $string); ok($string eq "PASSED\n"); $ENV{PRESERVE_PASS} = '1'; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.2 2>perl.stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file2', <fail(! $ret); $test->cleanup('pass'); $test->fail(! -d $wdir); $test->cleanup('fail'); $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.2"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.2"); ok(defined $string); ok($string eq "PASSED\n"); delete $ENV{PRESERVE_PASS}; $ENV{PRESERVE_FAIL} = '1'; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.3 2>perl.stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file3', <fail(! $ret); $test->cleanup('fail'); $test->fail(! -d $wdir); $test->cleanup('pass'); $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.3"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.3"); ok(defined $string); ok($string eq "PASSED\n"); Test-Cmd-1.09/t/exit.t000644 000765 000024 00000007624 12613140642 014730 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 19, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $wd, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source directory." my @cleanup; END { foreach my $dir (@cleanup) { rmdir $dir if -d $dir; } } sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } sub test_it { my($condition, $preserved) = @_; my %close_true = ( 'pass' => 1, 'fail' => 0, 'no_result' => 0, ); my %exit_status = ( 'pass' => 0, 'fail' => 1, 'no_result' => 2, ); my %result_string = ( 'pass' => "PASSED\n", 'fail' => "FAILED test at line 5 of -.\n", 'no_result' => "NO RESULT for test at line 5 of -.\n", ); if (! open(PERL, "|$^X @I_FLAGS >perl.stdout 2>perl.stderr")) { print STDOUT "# Could not open $^X: $!\n"; return undef; } my $ret = print PERL <new(workdir => ''); Test::Cmd->fail(! \$test); print STDOUT \$test->workdir; \$test->$condition; EOF if (! $ret) { print STDOUT "# Could not write to $^X: $!\n"; return undef; } $ret = close(PERL); if ($close_true{$condition} ? ! $ret : $ret) { print STDOUT "# Unexpected return from close(): $!\n"; $wd = contents("perl.stdout"); push @cleanup, $wd if defined $wd; return undef; } if (($?>>8) != $exit_status{$condition}) { print STDOUT "# Expected exit status ", $exit_status{$condition}, " got ", $?>>8, "\n"; $wd = contents("perl.stdout"); push @cleanup, $wd if defined $wd; return undef; } $wd = contents("perl.stdout"); if (! defined $wd) { print STDOUT "# no working directory path name on standard output\n"; return undef; } push @cleanup, $wd; $string = contents("perl.stderr"); if ($string ne $result_string{$condition}) { print STDOUT "# Expected error output:\n"; print STDOUT "# ", $result_string{$condition}; print STDOUT "# Got error output:\n"; print STDOUT "# ", $string; return undef; } return ($preserved ? -d $wd : ! -d $wd); } delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 0); ok($ret); $ENV{PRESERVE} = '1'; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 1); ok($ret); $ret = test_it('fail', 1); ok($ret); $ret = test_it('no_result', 1); ok($ret); delete $ENV{PRESERVE}; $ENV{PRESERVE_PASS} = '1'; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 1); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 0); ok($ret); delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; $ENV{PRESERVE_FAIL} = '1'; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 1); ok($ret); $ret = test_it('no_result', 0); ok($ret); delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; $ENV{PRESERVE_NO_RESULT} = '1'; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 1); ok($ret); Test-Cmd-1.09/t/EXPORT_OK.t000644 000765 000024 00000001435 12613140643 015364 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd qw(match_exact match_regex); $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $test->match_sub(\&match_exact); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $test->match_sub(\&match_regex); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); Test-Cmd-1.09/t/fail.t000644 000765 000024 00000006764 12613140642 014676 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 35, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $wdir, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.1 2>stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); Test::Cmd->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.1"); ok($string eq ""); $string = contents("stderr.1"); ok($string eq "FAILED test at line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.2 2>stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.2"); ok($string eq ""); $string = contents("stderr.2"); ok($string eq "FAILED test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.3 2>stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", string => 'xyzzy', workdir => ''); $test->run(); $test->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.3"); ok($string eq ""); $string = contents("stderr.3"); ok($string eq "FAILED test of run [xyzzy]\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.4 2>stderr.4"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->fail($? == 0 => sub {print STDERR "Printed on failure.\n"}); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.4"); ok($string eq ""); $string = contents("stderr.4"); ok($string eq "Printed on failure.\nFAILED test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.5 2>stderr.5"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; sub test_it { my $self = shift; $self->run(); $self->fail($? == 0 => undef, 1); } $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); &test_it($test); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.5"); ok($string eq ""); $string = contents("stderr.5"); ok($string eq "FAILED test of run\n\tat line 5 of - (main::test_it)\n\tfrom line 8 of -.\n"); Test-Cmd-1.09/t/interpreter.t000644 000765 000024 00000001732 12613140643 016315 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 8, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); ok(! -x 'run'); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(prog => 'run', workdir => ''); ok($test); $test->interpreter($^X); $test->run(); ok($? == 0); Test-Cmd-1.09/t/match.t000644 000765 000024 00000005315 12613140642 015046 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 31, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test = Test::Cmd->new(match_sub => \&Test::Cmd::match_exact); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @orig_lines = ( "vwxyz\n", "67890\n" ); @orig_regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); @lines = @orig_lines; @regexes = @orig_regexes; $ret = $test->match(\@lines, \@regexes); ok(! $ret); ok($lines[0] eq $orig_lines[0]); ok($lines[1] eq $orig_lines[1]); ok($regexes[0] eq $orig_regexes[0]); ok($regexes[1] eq $orig_regexes[1]); @lines = @orig_lines; @regexes = @orig_regexes; $ret = $test->match(\@lines, \@lines); ok($ret); ok($lines[0] eq $orig_lines[0]); ok($lines[1] eq $orig_lines[1]); ok($regexes[0] eq $orig_regexes[0]); ok($regexes[1] eq $orig_regexes[1]); eval "use Algorithm::DiffOld"; if ($@) { for ($i = 0; $i < 11; $i++) { skip(1, 0); } } else { $test = Test::Cmd->new(match_sub => \&Test::Cmd::diff_regex); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test = Test::Cmd->new(match_sub => \&Test::Cmd::diff_exact); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok(! $ret); $ret = $test->match(\@lines, \@lines); ok($ret); } Test-Cmd-1.09/t/match_exact.t000644 000765 000024 00000002227 12613140643 016232 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $ret = Test::Cmd->match_exact("abcde\n", "a.*e\n"); ok(! $ret); $ret = Test::Cmd->match_exact("abcde\n", "abcde\n"); ok($ret); $test = Test::Cmd->new; ok($test); $ret = $test->match_exact("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match_exact("abcde\n", "abcde\n"); ok($ret); $ret = $test->match_exact(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match_exact(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match_exact(\@lines, \@regexes); ok(! $ret); $ret = $test->match_exact(\@lines, \@lines); ok($ret); Test-Cmd-1.09/t/match_regex.t000644 000765 000024 00000001572 12613140643 016242 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 6, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $ret = Test::Cmd->match_regex("abcde\n", "a.*e\n"); ok($ret); $test = Test::Cmd->new; ok($test); $ret = $test->match_regex("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match_regex(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match_regex(\@lines, \@regexes); ok($ret); Test-Cmd-1.09/t/match_sub.t000644 000765 000024 00000002756 12613140643 015726 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $test->match_sub(\&Test::Cmd::match_exact); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok(! $ret); $ret = $test->match(\@lines, \@lines); ok($ret); $test->match_sub(\&Test::Cmd::match_regex); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test->match_sub(sub { $_[1] eq $_[2] }); $ret = $test->match("foo\n", "foo\n"); ok($ret); $ret = $test->match("foo\n", "bar\n"); ok(! $ret); Test-Cmd-1.09/t/no_result.t000644 000765 000024 00000007055 12613140643 015770 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 35, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.1 2>stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); Test::Cmd->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.1"); ok($string eq ""); $string = contents("stderr.1"); ok($string eq "NO RESULT for test at line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.2 2>stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.2"); ok($string eq ""); $string = contents("stderr.2"); ok($string eq "NO RESULT for test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.3 2>stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", string => 'xyzzy', workdir => ''); $test->run(); $test->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.3"); ok($string eq ""); $string = contents("stderr.3"); ok($string eq "NO RESULT for test of run [xyzzy]\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.4 2>stderr.4"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->no_result($? == 0 => sub {print STDERR "Printed on no result.\n"}); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.4"); ok($string eq ""); $string = contents("stderr.4"); ok($string eq "Printed on no result.\nNO RESULT for test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.5 2>stderr.5"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; sub test_it { my $self = shift; $self->run(); $self->no_result($? == 0 => undef, 1); } $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); &test_it($test); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.5"); ok($string eq ""); $string = contents("stderr.5"); ok($string eq "NO RESULT for test of run\n\tat line 5 of - (main::test_it)\n\tfrom line 8 of -.\n"); Test-Cmd-1.09/t/pass.t000644 000765 000024 00000003116 12613140642 014715 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 11, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $wdir, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->pass($? == 0); EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok($string eq ""); $string = contents("perl.stderr.1"); ok($string eq "PASSED\n"); Test-Cmd-1.09/t/pod.t000644 000765 000024 00000000472 12613140642 014533 0ustar00neilbstaff000000 000000 BEGIN { unless ( $ENV{RELEASE_TESTING} ) { require Test::More; Test::More::plan( skip_all => 'these tests are for release candidate testing' ); } } use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Test-Cmd-1.09/t/preserve.t000644 000765 000024 00000002737 12613140643 015613 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 21, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file1', <cleanup; ok(! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file2', <preserve('pass'); $test->cleanup('pass'); ok (-d $wdir); $test->cleanup('fail'); ok (! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file3', <preserve('fail'); $test->cleanup('fail'); ok (-d $wdir); $test->cleanup('pass'); ok (! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file3', <preserve('fail', 'no_result'); $test->cleanup('fail'); ok (-d $wdir); $test->cleanup('no_result'); ok (-d $wdir); $test->cleanup('pass'); ok (! -d $wdir); Test-Cmd-1.09/t/prog.t000644 000765 000024 00000002174 12613140642 014721 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 9, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); $test->prog('run1'); $test->run(); ok($? == 0); $test->prog('run2'); $test->run(); ok($? == 0); Test-Cmd-1.09/t/read.t000644 000765 000024 00000005352 12613140642 014666 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 44, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir, $wdir_file2, $wdir_foo_file1); my @lines; $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $wdir = $test->workdir; ok($wdir); $wdir_file1 = $test->catfile($wdir, 'file1'); ok($wdir_file1); $wdir_file2 = $test->catfile($wdir, 'file2'); ok($wdir_file2); $wdir_foo_file3 = $test->catfile($wdir, 'foo', 'file3'); ok($wdir_foo_file3); $wdir_foo_file4 = $test->catfile($wdir, 'foo', 'file4'); ok($wdir_foo_file4); $wdir_foo_file5 = $test->catfile($wdir, 'foo', 'file5'); ok($wdir_foo_file5); $ret = open(OUT, ">$wdir_file1"); ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_file2"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #2. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file3"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #3. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file4"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #4. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file5"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #5. _EOF_ ok($ret); $ret = close(OUT); ok($ret); # $ret = $test->read(\@lines, 'no_file'); ok(! $ret); $ret = $test->read(\$contents, 'no_file'); ok(! $ret); $ret = $test->read(\@lines, 'file1'); ok($ret); ok(! $lines[0]); $ret = $test->read(\$contents, 'file1'); ok($ret); ok(! $contents); $ret = $test->read(\@lines, 'file2'); ok($ret); ok(join('', @lines) eq "Test\nfile\n#2.\n"); $ret = $test->read(\$contents, 'file2'); ok($ret); ok($contents eq "Test\nfile\n#2.\n"); $ret = $test->read(\@lines, ['foo', 'file3']); ok($ret); ok(join('', @lines) eq "Test\nfile\n#3.\n"); $ret = $test->read(\$contents, ['foo', 'file3']); ok($ret); ok($contents eq "Test\nfile\n#3.\n"); $ret = $test->read(\@lines, $wdir_foo_file4); ok($ret); ok(join('', @lines) eq "Test\nfile\n#4.\n"); $ret = $test->read(\$contents, $wdir_foo_file4); ok($ret); ok($contents eq "Test\nfile\n#4.\n"); $ret = $test->read(\@lines, [$wdir, 'foo', 'file5']); ok($ret); ok(join('', @lines) eq "Test\nfile\n#5.\n"); $ret = $test->read(\$contents, [$wdir, 'foo', 'file5']); ok($ret); ok($contents eq "Test\nfile\n#5.\n"); Test-Cmd-1.09/t/run.t000644 000765 000024 00000015316 12613140642 014560 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 53, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $testx, $test, $subdir); # # The following complicated dance attempts to ensure we can create # an executable Perl script named "scriptx" on both UNIX and Win32 # systems. We want it to be Perl since it's about the only thing # that we can rely on in common between the systems. # # The UNIX side is easy; we just put our desired Perl script in # the file name with $Config{startperl} at the top, chmod it # executable, and away we go. # # For Win32, we go the route of creating a "scriptx.bat" file with # the magic header that reads as both an NT and a Perl script. # The hassle is that we want this .bat file to be executable # regardless of where we are at the moment, and the only way I # could figure out how to do this was to put the absolute path # name to the file in the .bat file as the first argument to # the perl.exe invocation. This means that we have to create our # initial running environments up front, so we know where the # "scriptx.bat" file will end up and can put its path name in # itself. # # If anyone cares to suggest an easier way to do this, I'd be # thrilled to hear about it. # $My_Config{_bat} = $iswin32 ? '.bat' : ''; $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); my $script = "script"; my $scriptx = "scriptx$My_Config{_bat}"; if ($iswin32) { my $workpath_scriptx = $run_env->workpath($scriptx); $My_Config{startperl} = <write($script, <write('xxx.pm', <write('yyy.pm', <write($scriptx, <new(prog => 'script', interpreter => "$^X -I$wdir -Mxxx", workdir => '', subdir => 'script_subdir'); ok($test); $ret = $test->run(); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $wdir: ''\n"); ok($test->stderr eq "script: xxx: STDERR: $wdir: ''\n"); $ret = $test->run(args => 'arg1 arg2 arg3'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $wdir: 'arg1 arg2 arg3'\n"); # Execute "scriptx" in the middle of the run here, # so we know it doesn't affect the $test->prog value. # Note that it should not pick up the test environment's # interpreter value with "-Mxxx" in it. $ret = $test->run(prog => 'scriptx', args => 'foo'); ok($ret == 0); ok($test->stdout eq "$scriptx: : STDOUT: $wdir: 'foo'\n"); ok($test->stderr eq "$scriptx: : STDERR: $wdir: 'foo'\n"); $ret = $test->run(chdir => $test->curdir, args => 'x y z'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: ${\$test->workdir}: 'x y z'\n"); ok($test->stderr eq "script: xxx: STDERR: ${\$test->workdir}: 'x y z'\n"); $subdir = $test->workpath('script_subdir'); $ret = $test->run(chdir => 'script_subdir'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $subdir: ''\n"); ok($test->stderr eq "script: xxx: STDERR: $subdir: ''\n"); $ret = $test->run(chdir => 'no_subdir'); ok(! defined $ret); $ret = $test->run(prog => 'no_script', interpreter => $^X); ok($ret != 0); $ret = $test->run(prog => 'script'); ok($ret != 0); $ret = $test->run(prog => 'script', interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(prog => 'no_script', interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(interpreter => "$^X -I$wdir -Myyy", args => 'zzz'); ok($ret == 0); ok($test->stdout eq "script: yyy: STDOUT: $wdir: 'zzz'\n"); ok($test->stderr eq "script: yyy: STDERR: $wdir: 'zzz'\n"); # $testx = Test::Cmd->new(prog => 'scriptx', workdir => '', subdir => 'scriptx_subdir'); ok($testx); $ret = $testx->run(); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $wdir: ''\n"); ok($testx->stderr eq "$scriptx: : STDERR: $wdir: ''\n"); $ret = $testx->run(args => 'foo bar'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $wdir: 'foo bar'\n"); ok($testx->stderr eq "$scriptx: : STDERR: $wdir: 'foo bar'\n"); # Execute "script" in the middle of the run here, # so we know it doesn't affect the $test->prog value. $ret = $testx->run(prog => 'script', interpreter => "$^X -I$wdir -Mxxx", args => 'bar'); ok($ret == 0); ok($testx->stdout eq "script: xxx: STDOUT: $wdir: 'bar'\n"); ok($testx->stderr eq "script: xxx: STDERR: $wdir: 'bar'\n"); $ret = $testx->run(chdir => $testx->curdir, args => 'baz'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: ${\$testx->workdir}: 'baz'\n"); ok($testx->stderr eq "$scriptx: : STDERR: ${\$testx->workdir}: 'baz'\n"); $subdir = $testx->workpath('scriptx_subdir'); $ret = $testx->run(chdir => 'scriptx_subdir'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $subdir: ''\n"); ok($testx->stderr eq "$scriptx: : STDERR: $subdir: ''\n"); $ret = $testx->run(chdir => 'no_subdir'); ok(! defined $ret); $ret = $testx->run(prog => 'no_prog'); ok($ret != 0); Test-Cmd-1.09/t/stderr.t000644 000765 000024 00000003027 12613140642 015253 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stderr); $test->prog('run1'); $test->run('args' => 'foo bar'); ok($? == 0); $test->prog('run2'); $test->run('args' => 'snafu'); ok($? == 0); ok($test->stderr eq "run2 STDERR snafu\nrun2 STDERR second line\n"); ok($test->stderr(1) eq "run1 STDERR foo bar\nrun1 STDERR second line\n"); Test-Cmd-1.09/t/stdin.t000644 000765 000024 00000002703 12613140642 015071 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 16, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test, @lines); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <) { s/X/Y/g; print; } exit 0; EOF ok($ret); $ret = $run_env->write('input', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stdout); $test->run('args' => 'input'); ok($? == 0); ok($test->stdout eq "Y on Y this Y line Y\n"); $test->run('stdin' => "X is X here X tooX\n"); ok($? == 0); ok($test->stdout eq "Y is Y here Y tooY\n"); $test->run('stdin' => <<_EOF_); X here X X there X _EOF_ ok($? == 0); ok($test->stdout eq "Y here Y\nY there Y\n"); @lines = qq( X line X X another X ); $test->run('stdin' => \@lines); ok($? == 0); ok($test->stdout eq "\nY line Y\nY another Y\n"); Test-Cmd-1.09/t/stdout.t000644 000765 000024 00000003027 12613140642 015272 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stdout); $test->prog('run1'); $test->run('args' => 'foo bar'); ok($? == 0); $test->prog('run2'); $test->run('args' => 'snafu'); ok($? == 0); ok($test->stdout eq "run2 STDOUT snafu\nrun2 STDOUT second line\n"); ok($test->stdout(1) eq "run1 STDOUT foo bar\nrun1 STDOUT second line\n"); Test-Cmd-1.09/t/string.t000644 000765 000024 00000001220 12613140643 015250 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test); $test = Test::Cmd->new; ok($test); ok(! $test->string); $test->string('foo'); ok($test->string eq 'foo'); $test = Test::Cmd->new(string => 'bar'); ok($test->string eq 'bar'); Test-Cmd-1.09/t/subdir.t000644 000765 000024 00000003504 12613140643 015241 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 21, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => ['no', 'such', 'subdir']); ok(! $test); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->subdir('bar'); ok($ret == 1); $wdir = $test->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); $ret = $test->subdir([qw(foo succeed)]); ok($ret == 1); # I don't understand why, but setting read-only on a Windows NT # directory on Windows NT still allows you to create a file. # That doesn't make sense to my UNIX-centric brain, but it does # mean we need to skip the related tests on Win32 platforms. $ret = chmod(0500, 'foo'); skip($iswin32, $ret == 1); $ret = $test->subdir([qw(foo fail)]); skip($iswin32 || $> == 0, ! $ret); $ret = $test->subdir([qw(sub dir ectory)], 'sub'); ok($ret == 1); $ret = $test->subdir('one', ['one', 'two'], [qw(one two three)]); ok($ret == 3); $ret = $test->subdir([$wdir, 'a'], [$wdir, 'a', 'b']); ok($ret == 2); ok(-d 'foo'); ok(-d 'bar'); ok(-d $test->workpath('foo', 'succeed')); skip($iswin32 || $> == 0, ! -d $test->workpath('foo', 'fail')); ok( -d 'sub'); ok(! -d $test->workpath(qw(sub dir))); ok(! -d $test->workpath(qw(sub dir ectory))); ok(-d $test->workpath(qw(one two three))); ok(-d $test->workpath(qw(a b))); Test-Cmd-1.09/t/TMPDIR.t000644 000765 000024 00000007261 12613140643 014754 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 43, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir1 = $run_env->workdir; ok($tdir1); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir2 = $run_env->workdir; ok($tdir2); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir3 = $run_env->workdir; ok($tdir3); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ENV{PRESERVE} = '1'; $ENV{TMPDIR} = $tdir1; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file1', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.1"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir1, '*testcmd*', 'file1'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #1.\n"); # $ENV{TMPDIR} = $tdir2; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.2 2>perl.stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file2', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.2"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.2"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir2, '*testcmd*', 'file2'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #2.\n"); # $ENV{TMPDIR} = Test::Cmd->catfile($tdir3, ''); $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.3 2>perl.stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file3', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.3"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.3"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir3, '*testcmd*', 'file3'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #3.\n"); Test-Cmd-1.09/t/workdir.t000644 000765 000024 00000003410 12613140643 015426 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 22, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. use File::Spec; my($ret, $workdir_foo, $workdir_bar, $no_such_subdir); my $test = Test::Cmd->new; ok($test); ok(! $test->workdir); $test = Test::Cmd->new(workdir => undef); ok($test); ok(! $test->workdir); $test = Test::Cmd->new(workdir => ''); ok($test); ok(File::Spec->file_name_is_absolute($test->workdir)); ok(-d $test->workdir); $test = Test::Cmd->new(workdir => 'dir'); ok($test); ok(File::Spec->file_name_is_absolute($test->workdir)); ok(-d $test->workdir); $no_such_subdir = $test->catfile('no', 'such', 'subdir'); $test = Test::Cmd->new(workdir => $no_such_subdir); ok(! $test); $test = Test::Cmd->new(workdir => 'foo'); ok($test); $workdir_foo = $test->workdir; ok(File::Spec->file_name_is_absolute($workdir_foo)); $ret = $test->workdir('bar'); ok($ret); $workdir_bar = $test->workdir; ok(File::Spec->file_name_is_absolute($workdir_bar)); $ret = $test->workdir($no_such_subdir); ok(! $ret); ok($workdir_bar eq $test->workdir); ok(-d $workdir_foo); ok(-d $workdir_bar); if ($iswin32) { eval("use Win32"); $cwd_ref = \&Win32::GetCwd; } else { eval("use Cwd"); $cwd_ref = \&Cwd::cwd; } $ret = chdir($test->workdir); ok($ret); ok($test->workdir eq &$cwd_ref()); Test-Cmd-1.09/t/workdirs.t000644 000765 000024 00000001315 12613140643 015613 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my $test = Test::Cmd->new; ok($test); ok(! $test->workdir); $wdir_1 = $test->workdir(''); ok($wdir_1); ok(-d $wdir_1); $wdir_2 = $test->workdir(''); ok($wdir_2); ok(-d $wdir_2); ok(-d $wdir_1); $test->cleanup; ok(! -d $wdir_2); ok(! -d $wdir_1); Test-Cmd-1.09/t/workpath.t000644 000765 000024 00000001263 12613140643 015610 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wpath); $test = Test::Cmd->new; ok($test); ok(! $test->workpath); $test->workdir(''); ok($test->workdir); $wpath = $test->workpath('foo', 'bar'); ok($wpath eq Test::Cmd->catfile($test->workdir, 'foo', 'bar')); Test-Cmd-1.09/t/writable.t000644 000765 000024 00000004415 12613140643 015564 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 30, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->write('file1', <write(['foo', 'file2'], <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir, 0); ok($ret == 0); # If we're running as root, then non-writability tests fail because root # can write to anything. Let them know why we're skipping those tests. print "# Skipping tests because you're running with EUID of 0\n" if $> == 0; skip($> == 0, ! -w $test->curdir); skip($> == 0, ! -w 'file1'); skip($> == 0, ! -w 'foo'); skip($> == 0, ! -w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir, 1); ok($ret == 0); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); # Make sure we can call with the optional error-collecting hash. # It would be good to check that this does, in fact, collect errors, # but the only two ways I can think of to get chmod() to generate an # error are a non-existent file (which won't happen because # finddepth() only calls its routine for existing files) or a file # owned by someone else. We can't rely on being able to chown() # a file unless we're root, though, and if we're root, the file will # be writable because root can write to anything. So just punt on # this for now. my %errs; $ret = $test->writable($wdir, 0, \%errs); ok($ret == 0); skip($> == 0, ! -w $test->curdir); skip($> == 0, ! -w 'file1'); skip($> == 0, ! -w 'foo'); skip($> == 0, ! -w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir); ok($ret == 0); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); Test-Cmd-1.09/t/write.t000644 000765 000024 00000004335 12613140642 015105 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 25, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->write('file1', <write(['foo', 'file2'], <write(['bar', 'file3'], <write($test->workpath('file4'), <write($test->workpath('foo', 'file5'), <write($test->workpath('bar', 'file6'), <write([$test->workpath('foo'), 'file7'], <write([$test->workpath('bar'), 'file8'], <workdir; ok($wdir); # I don't understand why, but setting read-only on a Windows NT # directory on Windows NT still allows you to create a file. # That doesn't make sense to my UNIX-centric brain, but it does # mean we need to skip the related tests on Win32 platforms. $ret = chmod(0500, $wdir); skip($iswin32, $ret == 1); $ret = $test->write('file9', < == 0, ! $ret); $ret = chdir($wdir); ok($ret); ok(-d 'foo'); ok(! -d 'bar'); ok(-f 'file1'); ok(-f $test->workpath('foo', 'file2')); ok(! -f $test->workpath('bar', 'file3')); ok(-f 'file4'); ok(-f $test->workpath('foo', 'file5')); ok(! -f $test->workpath('bar', 'file6')); ok(-f $test->workpath('foo', 'file7')); ok(! -f $test->workpath('bar', 'file8')); skip($iswin32 || $> == 0, ! -f 'file9'); Test-Cmd-1.09/t/Common/chmod.t000644 000765 000024 00000003304 12613140643 016271 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->write('file2', "file2\n"); $t->chmod(0777, 'file1', 'file2'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->chmod(0777, 'file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not chmod files.*NO RESULT/ms); Test-Cmd-1.09/t/Common/copy.t000644 000765 000024 00000003247 12613140643 016157 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->copy('file1', 'file2'); $t->file_matches('file2', "file1\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->copy('file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not copy file1 to file2:.*NO RESULT/ms); Test-Cmd-1.09/t/Common/f_matches.t000644 000765 000024 00000003770 12613140643 017137 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read contents of file1:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1 does not match\n"); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of file1.*FAILED/ms); Test-Cmd-1.09/t/Common/m_exist.t000644 000765 000024 00000003162 12613140643 016651 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->must_exist('file1'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->must_exist('file1'); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /files are missing: file1\nFAILED/ms); Test-Cmd-1.09/t/Common/m_n_exist.t000644 000765 000024 00000003177 12613140643 017174 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->must_not_exist('file1'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->must_not_exist('file1'); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /unexpected files exist: file1\nFAILED/ms); Test-Cmd-1.09/t/Common/read.t000644 000765 000024 00000004425 12613140643 016117 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->read(\$contents, 'file'); $t->fail($contents ne "the\nfile\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->read(\@contents, 'file'); $t->fail(join('', @contents) ne "the\nfile\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->read(\$contents, 'file'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read file contents:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->read(\@contents, 'file'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read file contents:.*NO RESULT/ms); Test-Cmd-1.09/t/Common/run.t000644 000765 000024 00000011272 12613140643 016006 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 31, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $pass = $test->workpath('pass'); $fail = $test->workpath('fail'); $stdout = $test->workpath('stdout'); $stderr = $test->workpath('stderr'); $test->write($pass, <<'_EOF_'); open(OUT, '>output'); print OUT "pass: @ARGV\n"; close(OUT); exit(0); _EOF_ $test->write($fail, <<'_EOF_'); open(OUT, '>output'); print OUT "fail: @ARGV\n"; close(OUT); exit(1); _EOF_ $test->write($stdout, <<'_EOF_'); print STDOUT "stdout: @ARGV\n"; exit(0); _EOF_ $test->write($stderr, <<'_EOF_'); print STDERR "stderr: @ARGV\n"; exit(0); _EOF_ $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(); \$t->file_matches('output', "pass: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(args => 'one two three'); \$t->file_matches('output', "pass: one two three\n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$fail', interpreter => '$perl', workdir => ''); \$t->run(); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /FAILED test of fail/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(fail => '$? != 1'); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /FAILED test of pass/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stdout', interpreter => '$perl', workdir => ''); \$t->run(stdout => "stdout: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stdout', interpreter => '$perl', workdir => ''); \$t->run(args => 'foo', stdout => "stdout: \n"); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDOUT.*FAILED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDERR.*FAILED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(stderr => undef); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(stderr => "stderr: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(args => 'foo', stderr => "stderr: \n"); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDERR.*FAILED/ms); Test-Cmd-1.09/t/Common/sleep.t000644 000765 000024 00000002561 12613140643 016313 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $before = time; $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->sleep(1); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $after = time; ok($before <= $after - 1) Test-Cmd-1.09/t/Common/subdir.t000644 000765 000024 00000004201 12613140643 016464 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => ['no', 'such', 'subdir']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not create subdirectories:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->subdir(['no', 'such', 'subdir']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not create subdirectories:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => 'foo'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->subdir(subdir => 'foo'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); Test-Cmd-1.09/t/Common/touch.t000644 000765 000024 00000003314 12613140643 016322 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->write('file2', "file2\n"); $t->touch(time + 1, 'file1', 'file2'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->touch(time + 1, 'file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not touch files.*NO RESULT/ms); Test-Cmd-1.09/t/Common/unlink.t000644 000765 000024 00000003175 12613140643 016505 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->unlink('file'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->unlink('file', ['foo', 'file']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not unlink files.*NO RESULT/ms); Test-Cmd-1.09/t/Common/write.t000644 000765 000024 00000003540 12613140643 016333 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => 'foo'); $t->write(['foo', 'file']); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write(['no_such_subdir', 'file']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not write \S+:.*NO RESULT/ms); Test-Cmd-1.09/lib/Test/000755 000765 000024 00000000000 12613140643 015004 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/lib/Test/Cmd/000755 000765 000024 00000000000 12613140643 015507 5ustar00neilbstaff000000 000000 Test-Cmd-1.09/lib/Test/Cmd.pm000644 000765 000024 00000136505 12613140643 016057 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. # # This package tests an executable program or script, # managing one or more temporary working directories, # keeping track of standard and error output, # and cleaning up after everything is done. package Test::Cmd; $Test::Cmd::VERSION = '1.09'; use 5.006; use strict; use warnings; use Exporter; use File::Basename (); # don't import the basename() method, we redefine it use File::Find; use File::Spec; our @ISA = qw(Exporter File::Spec); our @EXPORT_OK = qw(match_exact match_regex diff_exact diff_regex); =head1 NAME Test::Cmd - Perl module for portable testing of commands and scripts =head1 SYNOPSIS An example using L with this module to run a command and then test the exit code, standard out, and standard error: use Test::Cmd; use Test::More tests => 3; my $test = Test::Cmd->new( prog => 'outerr', workdir => '' ); $test->run(); is( $test->stdout, "out\n", 'standard out' ); is( $test->stderr, "err\n", 'standard error' ); is( $? >> 8, 1, 'exit status' ); Where C is the shell script: $ cat outerr #!/bin/sh echo out echo >&2 err exit 1 $ chmod +x outerr See below for other examples. Otherwise, the full list of available methods is: use Test::Cmd; $test = Test::Cmd->new(prog => 'program_or_script_to_test', interpreter => 'script_interpreter', string => 'identifier_string', workdir => '', subdir => 'dir', match_sub => $code_ref, verbose => 1); $test->verbose(1); $test->prog('program_or_script_to_test'); $test->basename(@suffixlist); $test->interpreter('script_interpreter'); $test->string('identifier string'); $test->workdir('prefix'); $test->workpath('subdir', 'file'); $test->subdir('subdir', ...); $test->subdir(['sub', 'dir'], ...); $test->write('file', <<'EOF'); contents of file EOF $test->write(['subdir', 'file'], <<'EOF'); contents of file EOF $test->read(\$contents, 'file'); $test->read(\@lines, 'file'); $test->read(\$contents, ['subdir', 'file']); $test->read(\@lines, ['subdir', 'file']); $test->writable('dir'); $test->writable('dir', $rwflag); $test->writable('dir', $rwflag, \%errors); $test->preserve(condition, ...); $test->cleanup(condition); $test->run(prog => 'program_or_script_to_test', interpreter => 'script_interpreter', chdir => 'dir', args => 'arguments', stdin => <<'EOF'); input to program EOF $test->pass(condition); $test->pass(condition, \&func); $test->fail(condition); $test->fail(condition, \&func); $test->fail(condition, \&func, $caller); $test->no_result(condition); $test->no_result(condition, \&func); $test->no_result(condition, \&func, $caller); $test->stdout; $test->stdout($run_number); $test->stderr; $test->stderr($run_number); $test->match(\@lines, \@matches); $test->match($lines, $matches); $test->match_exact(\@lines, \@matches); $test->match_exact($lines, $matches); $test->match_regex(\@lines, \@regexes); $test->match_regex($lines, $regexes); $test->diff_exact(\@lines, \@matches, \@output); $test->diff_exact($lines, $matches, \@output); $test->diff_regex(\@lines, \@regexes, \@output); $test->diff_regex($lines, $regexes, \@output); sub func { my ($self, $lines, $matches) = @_; # code to match $lines and $matches } $test->match_sub(\&func); $test->match_sub(sub { code to match $_[1] and $_[2] }); $test->here; =head1 DESCRIPTION The C module provides a low-level framework for portable automated testing of executable commands and scripts (in any language, not just Perl), especially commands and scripts that interact with the file system. The C module makes no assumptions about what constitutes a successful or failed test. Attempting to read a file that doesn't exist, for example, may or may not be an error, depending on the software being tested. Consequently, no C methods (including the C method) exit, die or throw any other sorts of exceptions (but they all do return useful error indications). Exceptions or other error status should be handled by a higher layer: a subclass of L, or another testing framework such as the L or L Perl modules, or by the test itself. (That said, see the L module if you want a similar module that provides exception handling, either to use directly in your own tests, or as an example of how to use C.) In addition to running tests and evaluating conditions, the C module manages and cleans up one or more temporary workspace directories, and provides methods for creating files and directories in those workspace directories from in-line data (that is, here-documents), allowing tests to be completely self-contained. When used in conjunction with another testing framework, the C module can function as a I (common startup code for multiple tests) for simple management of command execution and temporary workspaces. The C module inherits L methods (C, C, etc.) to support writing tests portably across a variety of operating and file systems. A C environment object is created via the usual invocation: $test = Test::Cmd->new(); Arguments to the C method are keyword-value pairs that may be used to initialize the object, typically by invoking the same-named method as the keyword. =head1 TESTING FRAMEWORKS As mentioned, because the C module makes no assumptions about what constitutes success or failure of a test, it can be used to provide temporary workspaces, other file system interaction, or command execution for a variety of testing frameworks. This section describes how to use the C with several different higher-layer testing frameworks. Note that you should I intermix multiple testing frameworks in a single testing script. =head2 C The C module may be used in tests that print results in a format suitable for the standard Perl L module: use Test::Cmd; print "1..5\n"; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); if ($test) { print "ok 1\n"; } else { print "not ok 1\n"; } $input = <<_EOF; test_program should process this input and exit successfully (status 0). _EOF_ $wrote_file = $test->write('input_file', $input); if ($wrote_file) { print "ok 2\n"; } else { print "not ok 2\n"; } $test->run(args => '-x input_file'); if ($? == 0) { print "ok 3\n"; } else { print "not ok 3\n"; } $wrote_file = $test->write('input_file', $input); if ($wrote_file) { print "ok 4\n"; } else { print "not ok 4\n"; } $test->run(args => '-y input_file'); if ($? == 0) { print "ok 5\n"; } else { print "not ok 5\n"; } Several other Perl modules simplify the use of L by eliminating the need to hand-code the C statements and test numbers. The L module, the L module, and the L module all export an C subroutine to test conditions. Here is how the above example would look rewritten to use L: use Test::Simple tests => 5; use Test::Cmd; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); ok($test, "creating Test::Cmd object"); $input = <<_EOF; test_program should process this input and exit successfully (status 0). _EOF_ $wrote_file = $test->write('input_file', $input); ok($wrote_file, "writing input_file"); $test->run(args => '-x input_file'); ok($? == 0, "executing test_program -x input_file"); $wrote_file = $test->write('input_file', $input); ok($wrote_file, "writing input_file"); $test->run(args => '-y input_file'); ok($? == 0, "executing test_program -y input_file"); =head2 C The Perl L package provides a procedural testing interface modeled after a testing framework widely used in the eXtreme Programming development methodology. The C module can function as part of a L fixture that can set up workspaces as needed for a set of tests. This avoids having to repeat code to re-initialize an input file multiple times: use Test::Unit; use Test::Cmd; my $test; $input = <<'EOF'; test_program should process this input and exit successfully (status 0). EOF sub set_up { $test = Test::Cmd->new(prog => 'test_program', workdir => ''); $test->write('input_file', $input); } sub test_x { my $result = $test->run(args => '-x input_file'); assert($result == 0, "failed test_x\n"); } sub test_y { my $result = $test->run(args => '-y input_file'); assert($result == 0, "failed test_y\n"); } create_suite(); run_suite; Note that, because the C module takes care of cleaning up temporary workspaces on exit, there is no need to remove explicitly the workspace in a C subroutine. (There may, of course, be other things in the test that need a C subroutine.) =head2 Aegis Alternatively, the C module provides C, C, and C methods that can be used to provide an appropriate exit status and simple printed indication for a test. These methods terminate the test immediately, reporting C, C, or C respectively, and exiting with status 0 (success), 1 or 2 respectively. The separate C and C methods allow for a distinction between an actual failed test and a test that could not be properly evaluated because of an external condition (such as a full file system or incorrect permissions). The exit status values happen to match the requirements of the Aegis change management system, and the printed strings are based on existing Aegis conventions. They are not really Aegis-specific, however, and provide a simple, useful starting point if you don't already have another testing framework: use Test::Cmd; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); Test::Cmd->no_result(! $test); $input = <write('input_file', $input); $test->no_result(! $wrote_file); $test->run(args => '-x input_file'); $test->fail($? != 0); $wrote_file = $test->write('input_file', $input); $test->no_result(! $wrote_file); $test->run(args => '-y input_file'); $test->fail($? != 0); $test->pass; Note that the separate L wrapper module can simplify the above example even further by taking care of common exception handling cases within the testing object itself. use Test::Cmd::Common; $test = Test::Cmd::Common->new(prog => 'test_program', workdir => ''); $input = <write('input_file', $input); $test->run(args => '-x input_file'); $wrote_file = $test->write('input_file', $input); $test->run(args => '-y input_file'); $test->pass; See the L module for details. =head1 METHODS Methods supported by the C module include: =over 4 =cut my @Cleanup; my $Run_Count; my $Default; # Map exit values to conditions. my @Cond = ( 'pass', 'fail', 'no_result' ); BEGIN { $Run_Count = 0; # The File::Spec->tmpdir method was only added recently, # so we can't assume it's there. $Test::Cmd::TMPDIR = eval("File::Spec->tmpdir"); # now we do win32 detection. what a mess :-( # if the version is 5.003, we can check $^O my $iswin32; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } my @tmps = (); if ($iswin32) { eval("use Win32;"); $Test::Cmd::_WIN32 = 1; $Test::Cmd::Temp_Prefix = "~testcmd$$-"; $Test::Cmd::Cwd_Ref = \&Win32::GetCwd; # Test for WIN32 temporary directories. # The following is lifted from the 5.005056 # version of File::Spec::Win32::tmpdir. push @tmps, (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)); } else { eval("use Cwd"); $Test::Cmd::Temp_Prefix = "testcmd$$."; $Test::Cmd::Cwd_Ref = \&Cwd::cwd; # Test for UNIX temporary directories. # The following is lifted from the 5.005056 # version of File::Spec::Unix::tmpdir. push @tmps, ($ENV{TMPDIR}, "/tmp"); } if (! $Test::Cmd::TMPDIR) { foreach (@tmps) { next unless defined && -d && -w; $Test::Cmd::TMPDIR = $_; last; } } # Get the absolute path to the temporary directory, in case # the TMPDIR specification is affected by symbolic links, # or by lack of a volume name on WIN32. # The following better way isn't available in the Cwd module # until sometime after 5.003: # $Test::Cmd::TMPDIR = Cwd::abs_path($Test::Cmd::TMPDIR); my($save) = &$Test::Cmd::Cwd_Ref(); chdir($Test::Cmd::TMPDIR); $Test::Cmd::TMPDIR = &$Test::Cmd::Cwd_Ref(); chdir($save); $Default = {}; $Default->{'failed'} = 0; $Default->{'verbose'} = $ENV{VERBOSE} || 0; if (defined $ENV{PRESERVE}) { $Default->{'preserve'}->{'fail'} = $ENV{PRESERVE} || 0; $Default->{'preserve'}->{'pass'} = $ENV{PRESERVE} || 0; $Default->{'preserve'}->{'no_result'} = $ENV{PRESERVE} || 0; } else { $Default->{'preserve'}->{'fail'} = $ENV{PRESERVE_FAIL} || 0; $Default->{'preserve'}->{'pass'} = $ENV{PRESERVE_PASS} || 0; $Default->{'preserve'}->{'no_result'} = $ENV{PRESERVE_NO_RESULT} || 0; } sub handler { print STDERR "NO RESULT -- SIG$_ received.\n"; my $test; foreach $test (@Cleanup) { $test->cleanup('no_result'); } exit(2); } $SIG{HUP} = \&handler if $SIG{HUP}; $SIG{INT} = \&handler; $SIG{QUIT} = \&handler; $SIG{TERM} = \&handler; } END { my $cond = @Cond[$?] || 'no_result'; my $test; foreach $test (@Cleanup) { $test->cleanup($cond); } } =item C Create a new C environment. Arguments with which to initialize the environment are passed in as keyword-value pairs. Fails if a specified temporary working directory or subdirectory cannot be created. Does NOT die or exit on failure, but returns C if the test environment object cannot be created. =cut sub new { my $type = shift; my $self = {}; %$self = %$Default; $self->{'cleanup'} = []; $self->{'preserve'} = {}; %{$self->{'preserve'}} = %{$Default->{'preserve'}}; $self->{'cwd'} = &$Test::Cmd::Cwd_Ref(); while (@_) { my $keyword = shift; $self->{$keyword} = shift; } bless $self, $type; if (defined $self->{'workdir'}) { if (! $self->workdir($self->{'workdir'})) { return undef; } } push @Cleanup, $self; if (defined $self->{'subdir'}) { if (! $self->subdir($self->{'subdir'})) { return undef; } } $self->prog($self->{'prog'}); $self->match_sub($self->{'match_sub'} || \&Test::Cmd::match_regex); $self; } =item C Sets the verbose level for the environment object to the specified value. =cut sub verbose { my $self = shift; $self->{'verbose'} = $_; } =item C Specifies the executable program or script to be tested. Returns the absolute path name of the current program or script. =cut sub prog { my ($self, $prog) = @_; if ($prog) { # make sure we're always talking about the same program if (! $self->file_name_is_absolute($prog)) { $prog = $self->catfile($self->{'cwd'}, $prog); } $self->{'prog'} = $prog; } return $self->{'prog'}; } =item C Returns the basename of the current program or script. Any specified arguments are a list of file suffixes that may be stripped from the basename. =cut sub basename { my $self = shift; return undef if ! $self->{'prog'}; File::Basename::basename($self->{'prog'}, @_); } =item C Specifies the program to be used to interpret C as a script. Returns the current value of C. =cut sub interpreter { my ($self, $interpreter) = @_; $self->{'interpreter'} = $interpreter if defined $interpreter; $self->{'interpreter'}; } =item C Specifies an identifier string for the functionality being tested to be printed on failure or no result. =cut sub string { my ($self, $string) = @_; $self->{'string'} = $string if defined $string; $self->{'string'}; } my $counter = 0; sub _workdir_name { my $self = shift; while (1) { $counter++; my $name = $self->catfile($Test::Cmd::TMPDIR, $Test::Cmd::Temp_Prefix . $counter); return $name if ! -e $name; } } =item C When an argument is specified, creates a temporary working directory with the specified name. If the argument is a NULL string (''), the directory is named C by default, followed by the unique ID of the executing process. Returns the absolute pathname to the temporary working directory, or FALSE if the directory could not be created. =cut sub workdir { my ($self, $workdir) = @_; if (defined($workdir)) { # return if $workdir && $self->{'workdir'} eq $workdir; # no change my $wdir = $workdir || $self->_workdir_name; if (!mkdir($wdir, 0755)) { return undef; } # The following better way to fetch the absolute path of the # workdir isn't available in the Cwd module until sometime # after 5.003: # $self->{'workdir'} = Cwd::abs_path($wdir); my($save) = &$Test::Cmd::Cwd_Ref(); chdir($wdir); $self->{'workdir'} = &$Test::Cmd::Cwd_Ref(); chdir($save); push(@{$self->{'cleanup'}}, $self->{'workdir'}); } $self->{'workdir'}; } =item C Returns the absolute path name to a subdirectory or file under the current temporary working directory by concatenating the temporary working directory name with the specified arguments. =cut sub workpath { my $self = shift; return undef if ! $self->{'workdir'}; $self->catfile($self->{'workdir'}, @_); } =item C Creates new subdirectories under the temporary working dir, one for each argument. An argument may be an array reference, in which case the array elements are concatenated together using the Ccatfile> method. Subdirectories multiple levels deep must be created via a separate argument for each level: $test->subdir('sub', ['sub', 'dir'], [qw(sub dir ectory)]); Returns the number of subdirectories actually created. =cut sub subdir { my $self = shift; my $count = 0; foreach (@_) { my $newdir = ref $_ ? $self->catfile(@$_) : $_; if (! $self->file_name_is_absolute($newdir)) { $newdir = $self->catfile($self->{'workdir'}, $newdir); } if (mkdir($newdir, 0755)) { $count++; } } return $count; } =item C Writes the specified text (second argument) to the specified file name (first argument). The file name may be an array reference, in which case all the array elements except the last are subdirectory names to be concatenated together. The file is created under the temporary working directory. Any subdirectories in the path must already exist. =cut sub write { my $self = shift; my $file = shift; # the file to write to $file = $self->catfile(@$file) if ref $file; if (! $self->file_name_is_absolute($file)) { $file = $self->catfile($self->{'workdir'}, $file); } if (! open(OUT, ">$file")) { return undef; } if (! print OUT @_) { return undef; } return close(OUT); } =item C Reads the contents of the specified file name (second argument) into the scalar or array referred to by the first argument. The file name may be an array reference, in which case all the array elements except the last are subdirectory names to be concatenated together. The file is assumed to be under the temporary working directory unless it is an absolute path name. Returns TRUE on successfully opening and reading the file, FALSE otherwise. =cut sub read { my ($self, $destref, $file) = @_; return undef if ref $destref ne 'SCALAR' && ref $destref ne 'ARRAY'; $file = $self->catfile(@$file) if ref $file; if (! $self->file_name_is_absolute($file)) { $file = $self->catfile($self->{'workdir'}, $file); } if (! open(IN, "<$file")) { return undef; } my @lines = ; if (! close(IN)) { return undef; } if (ref $destref eq 'SCALAR') { $$destref = join('', @lines); } else { @$destref = @lines; } return (1); } =item C Makes every file and directory within the specified directory tree writable (C == TRUE) or not writable (C == FALSE). The default is to make the directory tree writable. Optionally fills in the supplied hash reference with a hash of path names that could not have their permissions set appropriately, with the reason why each could not be set. =cut my $_errors; sub writable { my ($self, $dir, $flag, $err) = @_; $flag = 1 if ! defined $flag; $Test::Cmd::_errors = $err || {}; if ($flag) { sub _writable { if (!chmod 0755, $_) { $Test::Cmd::_errors->{$_} = $!; } } finddepth(\&_writable, $dir); } else { sub _writeprotect { if (!chmod 0555, $_) { $Test::Cmd::_errors->{$_} = $!; } } finddepth(\&_writeprotect, $dir); } return 0 + keys %$Test::Cmd::_errors; } =item C Arranges for the temporary working directories for the specified C environment to be preserved for one or more conditions. If no conditions are specified, arranges for the temporary working directories to be preserved for all conditions. =cut sub preserve { my $self = shift; my @cond = (@_) ? @_ : qw(pass fail no_result); my $cond; foreach $cond (@cond) { $self->{'preserve'}->{$cond} = 1; } } sub _nuke { # print STDERR "unlink($_)\n" if (!-d $_); # print STDERR "rmdir($_)\n" if (-d $_ && $_ ne "."); unlink($_) if (!-d $_); rmdir($_) if (-d $_ && $_ ne "."); 1; } =item C Removes any temporary working directories for the specified C environment. If the environment variable C was set when the C module was loaded, temporary working directories are not removed. If any of the environment variables C, C, or C were set when the C module was loaded, then temporary working directories are not removed if the test passed, failed, or had no result, respectively. Temporary working directories are also preserved for conditions specified via the C method. Typically, this method is not called directly, but is used when the script exits to clean up temporary working directories as appropriate for the exit status. =cut sub cleanup { my ($self, $cond) = @_; $cond = (($self->{'failed'} == 0) ? 'pass' : 'fail') if !$cond; if ($self->{'preserve'}->{$cond}) { print STDERR "Preserving work directory ".$self->{'workdir'}."\n" if $self->{'verbose'}; return; } chdir $self->{'cwd'}; # cd out of whatever work dir we're in my $dir; foreach $dir (@{$self->{'cleanup'}}) { $self->writable($dir, "true"); finddepth(\&_nuke, $dir); rmdir($dir); } $self->{'cleanup'} = []; } =item C Runs a test of the program or script for the test environment. Standard output and error output are saved for future retrieval via the C and C methods. Arguments are supplied as keyword-value pairs: =over 4 =item C Specifies the command-line arguments to be supplied to the program or script under test for this run: $test->run(args => 'arg1 arg2'); =item C Changes directory to the path specified as the value argument: $test->run(chdir => 'xyzzy'); If the specified path is not an absolute path name (begins with '/' on Unix systems), then the subdirectory is relative to the temporary working directory for the environment (C<$test-&>workdir>). Note that, by default, the C module does NOT chdir to the temporary working directory, so to execute the test under the temporary working directory, you must specify an explicit C to the current directory: $test->run(chdir => '.'); # Unix-specific $test->run(chdir => $test->curdir); # portable =item C Specifies the program to be used to interpret C as a script, for this run only. This does not change the C<$test-&>interpreter> value of the test environment. =item C Specifies the executable program or script to be run, for this run only. This does not change the C<$test-&>prog> value of the test environment. =item C Pipes the specified value (string or array ref) to the program or script under test for this run: $test->run(stdin => <<_EOF_); input to the program under test _EOF_ =back Returns the exit status of the program or script. =cut sub run { my $self = shift; my %args = @_; my $oldcwd; if ($args{'chdir'}) { $oldcwd = &$Test::Cmd::Cwd_Ref(); if (! $self->file_name_is_absolute($args{'chdir'})) { $args{'chdir'} = $self->catfile($self->{'workdir'}, $args{'chdir'}); } print STDERR "Changing to $args{'chdir'}\n" if $self->{'verbose'}; if (!chdir $args{'chdir'}) { return undef; } } $Run_Count++; my $stdout_file = $self->_stdout_file($Run_Count); my $stderr_file = $self->_stderr_file($Run_Count); my $cmd; if ($args{'prog'}) { if (! $self->file_name_is_absolute($args{'prog'})) { $args{'prog'} = $self->catfile($self->{'cwd'}, $args{'prog'}); } $cmd = $args{'prog'}; $cmd = $args{'interpreter'}." ".$cmd if $args{'interpreter'}; } else { $cmd = $self->{'prog'}; if ($args{'interpreter'}) { $cmd = $args{'interpreter'}." ".$cmd; } elsif ($self->{'interpreter'}) { $cmd = $self->{'interpreter'}." ".$cmd; } } $cmd = $cmd." ".$args{'args'} if $args{'args'}; $cmd =~ s/\$work/$self->{'workdir'}/g; $cmd = "|$cmd 1>$stdout_file 2>$stderr_file"; print STDERR "Invoking $cmd\n" if $self->{'verbose'}; if (! open(RUN, $cmd)) { $? = 2; print STDERR "Could not invoke $cmd: $!\n"; return undef; } if ($args{'stdin'}) { print RUN ref $args{'stdin'} ? @{$args{'stdin'}} : $args{'stdin'}; } close(RUN); my $return = $?; chdir $oldcwd if $oldcwd; return $return; } sub _to_value { my $v = shift; (ref $v or '') eq 'CODE' ? &$v() : $v; } =item C Exits the test successfully. Reports "PASSED" on the error output and exits with a status of 0. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. =cut sub pass { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref) = @_; return if ! _to_value($cond); &$funcref() if $funcref; print STDERR "PASSED\n"; # Let END take care of cleanup. exit (0); } =item C Exits the test unsuccessfully. Reports "FAILED test of {string} at line {line} of {file}." on the error output and exits with a status of 1. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. If a caller level is supplied, prints a simple calling trace N levels deep as part of reporting the failure. =cut sub fail { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref, $caller) = @_; return if ! _to_value($cond); &$funcref() if $funcref; $caller = 0 if ! defined($caller); my $of_str = " "; if (ref $self) { my $basename = $self->basename; if ($basename) { $of_str = " of ".$self->basename; if ($self->{'string'}) { $of_str .= " [".$self->{'string'}."]"; } $of_str .= "\n\t"; } } my $c = 0; my ($pkg,$file,$line,$sub) = caller($c++); print STDERR "FAILED test${of_str}at line $line of $file"; while ($c <= $caller) { ($pkg,$file,$line,$sub) = caller($c++); print STDERR " ($sub)\n\tfrom line $line of $file"; } print STDERR ".\n"; # Let END take care of cleanup. exit (1); } =item C Exits the test with an indeterminate result (the test could not be performed due to external conditions such as, for example, a full file system). Reports "NO RESULT for test of {string} at line {line} of {file}." on the error output and exits with a status of 2. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. If a caller level is supplied, prints a simple calling trace N levels deep as part of reporting the failure. =cut sub no_result { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref, $caller) = @_; return if ! _to_value($cond); &$funcref() if $funcref; $caller = 0 if ! defined($caller); my $of_str = " "; if (ref $self) { my $basename = $self->basename; if ($basename) { $of_str = " of ".$self->basename; if ($self->{'string'}) { $of_str .= " [".$self->{'string'}."]"; } $of_str .= "\n\t"; } } my $c = 0; my ($pkg,$file,$line,$sub) = caller($c++); print STDERR "NO RESULT for test${of_str}at line $line of $file"; while ($c <= $caller) { ($pkg,$file,$line,$sub) = caller($c++); print STDERR " ($sub)\n\tfrom line $line of $file"; } print STDERR ".\n"; # Let END take care of cleanup. exit (2); } sub _stdout_file { my ($self, $count) = @_; $self->catfile($self->{'workdir'}, "stdout.$count"); } sub _stderr_file { my ($self, $count) = @_; $self->catfile($self->{'workdir'}, "stderr.$count"); } =item C Returns the standard output from the specified run number. If there is no specified run number, then returns the standard output of the last run. Returns the standard output as either a scalar or an array of output lines, as appropriate for the calling context. Returns C if there has been no test run. =cut sub stdout { my $self = shift; my $count = @_ ? shift : $Run_Count; return undef if ! $Run_Count; my @lines; if (! $self->read(\@lines, $self->_stdout_file($count))) { return undef; } return (wantarray ? @lines : join('', @lines)); } =item C Returns the error output from the specified run number. If there is no specified run number, then returns the error output of the last run. Returns the error output as either a scalar or an array of output lines, as apporpriate for the calling context. Returns C if there has been no test run. =cut sub stderr { my $self = shift; my $count = @_ ? shift : $Run_Count; return undef if ! $Run_Count; my @lines; if (! $self->read(\@lines, $self->_stderr_file($count))) { return undef; } return (wantarray ? @lines : join('', @lines)); } sub _make_arrays { my ($lines, $matches) = @_; my @line_array; my @match_array; if (ref $lines) { chomp(@line_array = @$lines); } else { @line_array = split(/\n/, $lines, -1); pop(@line_array); } if (ref $matches) { chomp(@match_array = @$matches); } else { @match_array = split(/\n/, $matches, -1); pop(@match_array); } return (\@line_array, \@match_array); } =item C Matches one or more input lines against an equal number of expected lines using the currently-registered line-matching function. The default line-matching function is the C method, which means that the default is to match lines against regular expressions. =cut sub match { my $self = shift; # We can write this more clearly when we drop support for Perl 5.003: # $self->{'match_sub'}->($self, @_); &{$self->{'match_sub'}}($self, @_); } sub _matcher { my ($lines, $matches, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); return undef if @$lines != @$matches; my ($i, $l, $m); for ($i = 0; $i <= $#{ $matches }; $i++) { # More clearly, but doesn't work in Perl 5.003: # if (! $sub->($lines->[$i], $matches->[$i])) if (! &{$sub}($lines->[$i], $matches->[$i])) { #print STDERR "Line ", $i+1, " does not match:\n"; #print STDERR "Expect: ${\$matches->[\$i]}\n"; #print STDERR "Got: ${\$lines->[\$i]}\n"; return undef; } } return 1; } =item C Compares two arrays of lines for exact matches. The arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. An unequal number of lines in the two arrays fails immediately and returns FALSE before any comparisons are performed. Returns TRUE if each line matched its corresponding line in the other array, FALSE otherwise. =cut sub match_exact { my ($self, $lines, $matches) = @_; _matcher($lines, $matches, sub {$_[0] eq $_[1]}); } =item C Matches one or more input lines against an equal number of regular expressions. The arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. An unequal number of lines and regular expressions fails immediately and returns FALSE before any comparisons are performed. Comparison is performed for each entire line, that is, with each regular expression anchored at both the start of line (^) and end of line ($). Returns TRUE if each line matched each regular expression, FALSE otherwise. =cut sub match_regex { my ($self, $lines, $regexes) = @_; _matcher($lines, $regexes, sub {$_[0] =~ m/^$_[1]$/}); } sub _range { ($_[0]->[1] + 1) . ((@_ == 1) ? '' : (',' . ($_[-1]->[1] + 1))) } my $_differ; eval("use Algorithm::DiffOld;"); if ($@) { $_differ = \&_differ_no_lcs; } else { $_differ = \&_differ_lcs; } sub _differ_lcs { my ($matches, $lines, $output, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); @$output = () if defined $output; my @diffs = Algorithm::DiffOld::diff($matches, $lines, $sub); return 1 if @diffs == 0; if (defined $output) { my $added = 0; my $hunk; foreach $hunk (@diffs) { my @deletions = grep($_->[0] eq '-', @$hunk); my @additions = grep($_->[0] eq '+', @$hunk); if (! @deletions) { push @$output, ($additions[0]->[1] - $added) . 'a' . _range(@additions) . "\n"; push @$output, "> " . join("\n> ", map($_->[2], @additions)) . "\n"; } elsif (! @additions) { push @$output, _range(@deletions) . 'd' . ($deletions[0]->[1] + $added) . "\n"; push @$output, "< " . join("\n< ", map($_->[2], @deletions)) . "\n"; } else { push @$output, _range(@deletions) . 'c' . _range(@additions) . "\n"; push @$output, "< " . join("\n< ", map($_->[2], @deletions)) . "\n"; push @$output, "---\n"; push @$output, "> " . join("\n> ", map($_->[2], @additions)) . "\n"; } $added += @additions - @deletions; } } return undef; } sub _differ_no_lcs { my ($matches, $lines, $output, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); @$output = () if defined $output; return 1 if _matcher($matches, $lines, $sub); if (defined $output) { push @$output, "Expected =====\n"; push @$output, map { $_ . "\n" } @$matches; push @$output, "Actual =====\n"; push @$output, map { $_ . "\n" } @$lines; } return undef; } =item C Diffs two arrays of lines in a manner similar to the UNIX L utility. If the L package is installed on the local system, output describing the differences between the input lines and the matching lines, in L format, is saved to the C<$output> array reference. In the diff output, the expected output lines are considered the "old" (left-hand) file, and the actual output is considered the "new" (right-hand) file. If the L package is I installed on the local system, the Expected and Actual contents are saved as-is to the C<$output> array reference. The C and C arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. Returns TRUE if each line matched its corresponding line in the expected matches, FALSE otherwise, in order to conform to the conventions of the C method. Typical invocation: if (! $test->diff_exact($test->stdout, \@expected_lines, \@diff)) { print @diff; } =cut sub diff_exact { my ($self, $lines, $matches, $output) = @_; return &{$_differ}($matches, $lines, $output, sub {$_[0] eq $_[1]}); } =item C Diffs one or more input lines against one or more regular expressions in a manner similar to the UNIX L utility. If the L package is installed on the local system, output describing the differences between the input lines and the matching lines, in L format, is saved to the C<$output> array reference. In the diff output, the expected output lines are considered the "old" (left-hand) file, and the actual output is considered the "new" (right-hand) file. If the L package is I installed on the local system, the Expected and Actual contents are saved as-is to the C<$output> array reference. The C and C arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. Comparison is performed for each entire line, that is, with each regular expression anchored at both the start of line (^) and end of line ($). Returns TRUE if each line matched each regular expression, FALSE otherwise, in order to conform to the conventions of the C method. Typical invocation: if (! $test->diff_regex($test->stdout, \@expected_lines, \@diff)) { print @diff; } =cut sub diff_regex { my ($self, $lines, $regexes, $output) = @_; return &{$_differ}($regexes, $lines, $output, sub {$_[1] =~ /^$_[0]$/}); } =item C Registers the specified code reference as the line-matching function to be called by the C method. This can be a user-supplied subroutine, or the C, C, C, or C methods supplied by the C module: $test->match_sub(\&Test::Cmd::match_exact); $test->match_sub(\&Test::Cmd::match_regex); $test->match_sub(\&Test::Cmd::diff_exact); $test->match_sub(\&Test::Cmd::diff_regex); The C, C, C and C subroutine names are exportable from the C module, and may be specified at object initialization: use Test::Cmd qw(match_exact match_regex diff_exact diff_regex); $test_exact = Test::Cmd->new(match_sub => \&match_exact); $test_regex = Test::Cmd->new(match_sub => \&match_regex); $test_exact = Test::Cmd->new(match_sub => \&diff_exact); $test_regex = Test::Cmd->new(match_sub => \&diff_regex); =cut sub match_sub { my ($self, $funcref) = @_; $self->{'match_sub'} = $funcref if defined $funcref; $self->{'match_sub'}; } =item C Returns the absolute path name of the current working directory. (This is essentially the same as the C method, except that the C method preserves the directory separators exactly as returned by the underlying operating-system-dependent method. The C method canonicalizes all directory separators to '/', which makes for consistent path name representations within Perl, but may mess up another program or script to which you try to pass the path name.) =cut sub here { &$Test::Cmd::Cwd_Ref(); } 1; __END__ =back =head1 ENVIRONMENT Several environment variables affect the default values in a newly created C environment object. These environment variables must be set when the module is loaded, not when the object is created. =over 4 =item C If set to a true value, all temporary working directories will be preserved on exit, regardless of success or failure of the test. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a failed test. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a test for which there is no result. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a successful test. The full path names of all temporary working directories will be reported on error output. =item C When set to a true value, enables verbose reporting of various internal things (path names, exact command line being executed, etc.). =back =head1 PORTABLE TESTS Although the C module is intended to make it easier to write portable tests for portable utilities that interact with file systems, it is still very easy to write non-portable tests if you're not careful. The best and most comprehensive set of portability guidelines is the standard "Writing portable Perl" document at: http://www.perl.com/pub/doc/manual/html/pod/perlport.html To reiterate one important point from the "WpP" document: Not all Perl programs have to be portable. If the program or script you're testing is UNIX-specific, you can (and should) use the C module to write UNIX-specific tests. That having been said, here are some hints that may help keep your tests portable, if that's a requirement. =over 4 =item Use the Chere> method for current directory path. The normal Perl way to fetch the current working directory is to use the C method. Unfortunately, the C method canonicalizes the path name it returns, changing the native directory separators into the forward slashes favored by Perl and UNIX. For most Perl scripts, this makes a great deal of sense and keeps code uncluttered. Passing in a file name that has had its directory separators altered, however, may confuse the command or script under test, or make it difficult to compare output from the command or script with an expected result. The C method returns the absolute path name of the current working directory, like C, but does not manipulate the returned path in any way. =item Use C methods for manipulating path names. The L module provides a system-independent interface for manipulating path names. Because the C class is a sub-class of the L class, you can use these methods directly as follows: if (! Test::Cmd->file_name_is_absolute($prog)) { my $prog = Test::Cmd->catfile(Test::Cmd->here, $prog); } For details about the available methods and their use, see the documentation for the L module and its sub-modules, especially the L modules. =item Use C for file-name suffixes, where possible. The standard L module provides values that reflect the file-name suffixes on the system for which the Perl executable was built. This provides convenient portability for situations where a file name may have different extensions on different systems: $foo_exe = "foo$Config{_exe}"; ok(-f $foo_exe); (Unfortunately, there is no existing C<$Config> value that specifies the suffix for a directly-executable Perl script.) =item Avoid generating executable programs or scripts. How to make a file or script executable varies widely from system to system, some systems using file name extensions to indicate executability, others using a file permission bit. The differences are complicated to accommodate in a portable test script. The easiest way to deal with this complexity is to avoid it if you can. If your test somehow requires executing a script that you generate from the test itself, the best way is to generate the script in Perl and then explicitly feed it to the Perl executable on the local system. To be maximally portable, use the C<$^X> variable instead of hard-coding "perl" into the string you execute: $line = "This is output from the generated perl script."; $test->write('script', < file itself executable. (Since you're writing your test in Perl, it's safe to assume that Perl itself is executable.) If you must generate a directly-executable script, then use the C<$Config{'startperl'}> variable at the start of the script to generate the appropriate magic that will execute it as a Perl script: use Config; $line = "This is output from the generated perl script."; $test->write('script', <workdir); chmod(0755, 'script'); # POSIX-SPECIFIC $output = `script`; ok($output eq "$line\n"); =back Addtional hints on writing portable tests are welcome. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L. Alternative command-testing modules include: L, L, or using L with one of the above test modules, for example L. A rudimentary page for the C module is available at: http://www.baldmt.com/Test-Cmd/ The most involved example of using the C package to test a real-world application is the C testing suite for the Cons software construction utility. The suite uses a sub-class of L (which in turn is a sub-class of C) to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons =head1 REPOSITORY L =head1 AUTHORS Steven Knight, knight@baldmt.com This module is now being maintained by Neil Bowers Eneilb@cpan.orgE. =head1 COPYRIGHT Copyright 1999-2001 Steven Knight. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 ACKNOWLEDGEMENTS Thanks to Greg Spencer for the inspiration to create this package and the initial draft of its implementation as a specific testing package for the Cons software construction utility. Information about Cons is available at: http://www.dsmit.com/cons/ The general idea of managing temporary working directories in this way, as well as the test reporting of the C, C and C methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://www.tip.net.au/~millerp/aegis.html Thanks to Michael Schwern for all of the thoughtful work he's put into Perl's standard testing methodology, including the L and L modules, and enhancement and maintenance of the L and L modules. Thanks also to Christian Lemburg for the impressively complete L framework of modules. Ideas from both have helped keep C flexible enough to be useful in multiple testing frameworks. =cut Test-Cmd-1.09/lib/Test/Cmd/Common.pm000644 000765 000024 00000040425 12613140643 017302 0ustar00neilbstaff000000 000000 # Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. # # This package tests an executable program or script, # managing one or more temporary working directories, # keeping track of standard and error output, # and cleaning up after everything is done. package Test::Cmd::Common; $Test::Cmd::Common::VERSION = '1.09'; use 5.006; use strict; use warnings; use Exporter (); our ($_exe, $_o, $_so, $_a, $_is_win32); our @ISA = qw(Test::Cmd Exporter); our @EXPORT_OK = qw($_exe $_o $_a $_so $_is_win32); use Config; use Cwd; use File::Copy (); use Test::Cmd; =head1 NAME Test::Cmd::Common - module for common Test::Cmd error handling =head1 SYNOPSIS use Test::Cmd::Common; $test = Test::Cmd::Common->new(string => 'functionality being tested', prog => 'program_under_test', ); $test->run(chdir => 'subdir', fail => '$? != 0', flags => '-x', targets => '.', stdout => <<_EOF_, stderr => <<_EOF_); expected standard output _EOF_ expected error output _EOF_ $test->subdir('subdir', ...); $test->read(\$contents, 'file'); $test->read(\@lines, 'file'); $test->write('file', <<_EOF_); contents of the file _EOF_ $test->file_matches(); $test->must_exist('file', ['subdir', 'file'], ...); $test->must_not_exist('file', ['subdir', 'file'], ...); $test->copy('src_file', 'dst_file'); $test->chmod($mode, 'file', ...); $test->sleep; $test->sleep($seconds); $test->touch('file', ...); $test->unlink('file', ...); =head1 DESCRIPTION The C module provides a simple, high-level interface for writing tests of executable commands and scripts, especially commands and scripts that interact with the file system. All methods throw exceptions and exit on failure. This makes it unnecessary to add explicit checks for return values, making the test scripts themselves simpler to write and easier to read. The C class is a subclass of L. In essence, C is a wrapper that treats common L error conditions as exceptions that terminate the test. You can use C directly, or subclass it for your program and add additional (or override) methods to tailor it to your program's specific needs. Alternatively, C serves as a useful example of how to define your own L subclass. The C module provides the following importable variables: =over 4 =item C<$_exe> The executable file suffix. This value is normally available as C<$Config{_exe}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_o> The object file suffix. This value is normally available from C<$Config{_o}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_a> The library file suffix. This value is normally available from as C<$Config{_a}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_so> The shared library file suffix. This value is normally available as C<$Config{_so}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_is_win32> A Boolean value that reflects whether the current platform is a Win32 system. =back =head1 METHODS =over 4 =cut BEGIN { if ($] < 5.003) { eval("require Win32"); $_is_win32 = ! $@; } else { $_is_win32 = $^O eq "MSWin32"; } $_exe = $Config{_exe}; $_exe = $Config{exe_ext} if ! defined $_exe; $_exe = $_is_win32 ? '.exe' : '' if ! defined $_exe; $_o = $Config{_o}; $_o = $Config{obj_ext} if ! defined $_o; $_o = $_is_win32 ? '.obj' : '.o' if ! defined $_o; $_a = $Config{_a}; $_a = $Config{lib_ext} if ! defined $_a; $_a = $_is_win32 ? '.lib' : '.a'; $_so = ".$Config{so}"; $_so = $_is_win32 ? '.dll' : '.so' if ! defined $_so; } =item C Creates a new test environment object. Any arguments are keyword-value pairs that are passed through to the construct method for the base class from which we inherit our methods (that is, the L class). In the normal case, this should be the program to be tested and a description of the functionality being tested: $test = Test::Cmd::Common->new(prog => 'my_program', string => 'cool new feature'); By default, methods that match actual versus expected output (the C, and C methods) use an exact match. Tests that require regular expression matches can specify this on initialization of the test environment: $test = Test::Cmd::Common->new(prog => 'my_program', string => 'cool new feature', match_sub => \&Test::Cmd::diff_regex); or by executing the following after initialization of the test environment: $test->match_sub(\&Test::Cmd::diff_regex); Creates a temporary working directory for the test environment and changes directory to it. Exits NO RESULT if the object can not be created, the temporary working directory can not be created, or the current directory cannot be changed to the temporary working directory. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $test = $class->SUPER::new(@_); $class->SUPER::no_result(! $test, undef, 1); # We're going to chdir to the temporary working directory. # So that things work properly relative to the current directory, # turn any relative path names in @INC to absolute paths. my $cwd = Cwd::cwd(); map { $_ = $test->catdir($cwd, $_) if ! $test->file_name_is_absolute($_) } @INC; my $ret = chdir $test->workdir; $test->no_result(! $ret, undef, 1); if (! grep {$_ eq 'match_sub'} @_) { $test->match_sub(\&Test::Cmd::diff_exact); } bless($test, $class); } sub _fail_match_show { my($self, $stream, $expected, $actual, $level) = @_; my @diffs; $self->fail(! $self->match($actual, $expected, \@diffs) => sub {print STDERR "diff expected vs. actual contents of $stream =====\n", @diffs}, $level + 1); } =item C Runs the program under test, checking that the test succeeded. Arguments are keyword-value pairs that affect the manner in which the program is executed or the results are evaluated. chdir => 'subdir' fail => 'failure condition' # default is '$? != 0' flags => 'Cons flags' stderr => 'expected error output' stdout => 'expected standard output' targets => 'targets to build' The test fails if: -- The specified failure condition is met. The default failure condition is '$? != 0', i.e. the program exits unsuccesfully. A not-uncommon alternative is: $test->run(fail => '$? == 0'); # expect failure when testing how the program handles errors. -- Actual standard output does not match expected standard output (if any). The expected standard output is an array of lines or a scalar which will be split on newlines. -- Actual error output does not match expected error output (if any). The expected error output is an array of lines or a scalar which will be split on newlines. This method will test for NO error output by default if no expected error output is specified (unlike standard output). The error output test may be explicitly suppressed by specifying undef as the "expected" error output: $test->run(stderr => undef); By default, this method performs an exact match of actual vs. expected standard output or error output: $test->run(stdout => <<_EOF_, stderr => _EOF_); An expected STDOUT line, which must be matched exactly. _EOF_ One or more expected STDERR lines, which must be matched exactly. _EOF_ Tests that require regular expression matches should be executed using a test environment that calls the C method as follows: $test->match_sub(\&Test::Cmd::diff_regex); $test->run(stdout => <<_EOF_, stderr => _EOF_); An expected (STDOUT|standard output) line\. _EOF_ One or more expected (STDERR|error output) lines, which may contain (regexes|regular expressions)\. _EOF_ =cut sub run { my $self = shift; my %args = @_; my $cmd = $args{'args'}; if (! $cmd) { $cmd = $args{'targets'}; $cmd = "$args{'flags'} $cmd" if $args{'flags'}; } my $lev = $args{'level'} || 0; $self->SUPER::run(@_, args => $cmd); my $cond = $args{'fail'} || '$? != 0'; $self->fail(eval $cond => sub {print STDERR $self->stdout, $self->stderr}, $lev + 1); if (defined $args{'stdout'}) { my @stdout = $self->stdout; $self->_fail_match_show('STDOUT', $args{'stdout'}, \@stdout, $lev + 1); } $args{'stderr'} = '' if ! grep($_ eq 'stderr', keys %args); if (defined $args{'stderr'}) { my @stderr = $self->stderr; $self->_fail_match_show('STDERR', $args{'stderr'}, \@stderr, $lev + 1); } } =item C Creates one or more subdirectories in the temporary working directory. Exits NO RESULT if the number of subdirectories actually created does not match the number expected. For compatibility with its superclass method, returns the number of subdirectories actually created. =cut sub subdir { my $self = shift; my $expected = @_; my $ret = $self->SUPER::subdir(@_); $self->no_result($expected != $ret, => sub {print STDERR "could not create subdirectories: $!\n"}, 1); return $ret; } =item C Reads the contents of a file, depositing the contents in the destination referred to by the first argument (a scalar or array reference). If the file name is not an absolute path name, it is relative to the temporary working directory. Exits NO RESULT if the file could not be read for any reason. For compatibility with its superclass method, returns TRUE on success. =cut sub read { my $self = shift; my $destref = shift; my $ret = $self->SUPER::read($destref, @_); $self->no_result(! $ret => sub {print STDERR "could not read file contents: $!\n"}, 1); return 1; } =item C Writes a file with the specified contents. If the file name is not an absolute path name, it is relative to the temporary working directory. Exits NO RESULT if there were any errors writing the file. For compatibility with its superclass method, returns TRUE on success. $test->write('file', <<_EOF_); contents of the file _EOF_ =cut sub write { my $self = shift; my $file = shift; # the file to write to my $ret = $self->SUPER::write($file, @_); $self->no_result(! $ret => sub {$file = $self->catfile(@$file) if ref $file; print STDERR "could not write $file: $!\n"}, 1); return 1; } =item C Matches the contents of the specified file (first argument) against the expected contents. The expected contents are an array of lines or a scalar which will be split on newlines. By default, each expected line must match exactly its corresponding line in the file: $test->file_matches('file', <<_EOF_); Line #1. Line #2. _EOF_ Tests that require regular expression matches should be executed using a test environment that calls the C method as follows: $test->match_sub(\&Test::Cmd::diff_regex); $test->file_matches('file', <<_EOF_); The (1st|first) line\. The (2nd|second) line\. _EOF_ =cut sub file_matches { my($self, $file, $regexes) = @_; my @lines; my $ret = $self->SUPER::read(\@lines, $file); $self->no_result(! $ret => sub {print STDERR "could not read contents of $file: $!\n"}, 1); my @diffs; $self->fail(! $self->match(\@lines, $regexes, \@diffs) => sub {$file = $self->catfile(@$file) if ref $file; print STDERR "diff expected vs. actual contents of $file =====\n", @diffs}, 1); } =item C Ensures that the specified files must exist. Files may be specified as an array reference of directory components, in which case the pathname will be constructed by concatenating them. Exits FAILED if any of the files does not exist. =cut sub must_exist { my $self = shift; map(ref $_ ? $self->catfile(@$_) : $_, @_); my @missing = grep(! -e $_, @_); $self->fail(0 + @missing => sub {print STDERR "files are missing: @missing\n"}, 1); } =item C Ensures that the specified files must not exist. Files may be specified as an array reference of directory components, in which case the pathname will be constructed by concatenating them. Exits FAILED if any of the files exists. =cut sub must_not_exist { my $self = shift; map(ref $_ ? $self->catfile(@$_) : $_, @_); my @exist = grep(-e $_, @_); $self->fail(0 + @exist => sub {print STDERR "unexpected files exist: @exist\n"}, 1); } =item C Copies a file from the source (first argument) to the destination (second argument). Exits NO RESULT if the file could not be copied for any reason. =cut sub copy { my($self, $src, $dest) = @_; my $ret = File::Copy::copy($src, $dest); $self->no_result(! $ret => sub {print STDERR "could not copy $src to $dest: $!\n"}, 1); } =item C Changes the permissions of a list of files to the specified mode (first argument). Exits NO RESULT if any file could not be changed for any reason. =cut sub chmod { my $self = shift; my $mode = shift; my $expected = @_; my $ret = CORE::chmod($mode, @_); $self->no_result($expected != $ret, => sub {print STDERR "could not chmod files: $!\n"}, 1); } =item C Sleeps at least the specified number of seconds. If no number is specified, sleeps at least a minimum number of seconds necessary to advance file time stamps on the current system. Sleeping more seconds is all right. Exits NO RESULT if the time slept was less than specified. =cut sub sleep { my($self, $seconds) = @_; # On Windows systems, DOS and FAT file systems have only a # two-second granularity, so we must sleep two seconds to # ensure that file time stamps will be newer. $seconds = $_is_win32 ? 2 : 1 if ! defined $seconds; my $ret = CORE::sleep($seconds); $self->no_result($ret < $seconds, => sub {print STDERR "only slept $ret seconds\n"}, 1); } =item C Updates the access and modification times of the specified files. Exits NO RESULT if any file could not be modified for any reason. =cut sub touch { my $self = shift; my $time = shift; my $expected = @_; my $ret = CORE::utime($time, $time, @_); $self->no_result($expected != $ret, => sub {print STDERR "could not touch files: $!\n"}, 1); } =item C Removes the specified files. Exits NO RESULT if any file could not be removed for any reason. =cut sub unlink { my $self = shift; my @not_removed; my $file; foreach $file (@_) { $file = $self->catfile(@$file) if ref $file; if (! CORE::unlink($file)) { push @not_removed, $file; } } $self->no_result(@not_removed != 0, => sub {print STDERR "could not unlink files (@not_removed): $!\n"}, 1); } 1; __END__ =back =head1 ENVIRONMENT The C module also uses the C, C, C, and C environment variables from the L module. See the L documentation for details. =head1 SEE ALSO L, L. The most involved example of using the C module to test a real-world application is the C testing suite for the Cons software construction utility. The suite sub-classes C to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons =head1 AUTHOR Steven Knight, knight@baldmt.com =head1 ACKNOWLEDGEMENTS Thanks to Johan Holmberg for asking the question that led to the creation of this package. The general idea of testing commands in this way, as well as the test reporting of the C, C and C methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://www.tip.net.au/~millerp/aegis.html =cut