Test2-Harness-1.000182000755001750001750 015267772575 14717 5ustar00exodistexodist000000000000README100644001750001750 4346215267772575 15711 0ustar00exodistexodist000000000000Test2-Harness-1.000182NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) DESCRIPTION This is the primary documentation for yath, App::Yath, Test2::Harness. The canonical source of up-to-date command options are the help output when using $ yath help and $ yath help COMMAND. This document is mainly an overview of yath usage and common recipes. App::Yath is an alternative to App::Prove, and Test2::Harness is an alternative to Test::Harness. It is not designed to replace Test::Harness/prove. Test2::Harness is designed to take full advantage of the rich data Test2 can provide. Test2::Harness is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. PLATFORM SUPPORT Test2::Harness/App::Yath is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. OVERVIEW To use Test2::Harness, you use the yath command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. yath can be thought of as a more powerful alternative to prove (Test::Harness) RECIPES These are common recipes for using yath. RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in ./t, ./t2, and ./test.pl and run any which are found. Normally this implies the test command but will instead imply the run command if a persistent test runner is detected. PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the # HARNESS-NO-PRELOAD directive to the top of the test files that cannot use preload. SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util COMPLEX PRELOAD If your preload is a subclass of Test2::Harness::Runner::Preload then more complex preload behavior is possible. See those docs for more info. LOGGING RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz -B and -G both imply -L. REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the $ yath replay ... command. The replay command is implied if the first argument is a log file. PER-TEST TIMING DATA The -T option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. STARTING This starts the server. Many options available to the 'test' command will work here but not all. See $ yath help start for more info. $ yath start RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the test command will work for this as well. See $ yath help run for more details. $ yath run STOPPING Stopping a persistent runner is easy. $ yath stop INFORMATIONAL The which command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The watch command will tail the runner's log files. $ yath watch PRELOAD + PERSISTENT RUNNER You can use preloads with the yath start command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create test.pl. test.pl is automatically run by most build utils, in which case only the exit value matters. The generated test.pl will run yath and execute all tests in the ./t and/or ./t2 directories. Tests in ./t will ALSO be run by prove but tests in ./t2 will only be run by yath. PROJECT-SPECIFIC YATH CONFIG You can write a .yath.rc file. The file format is very simple. Create a [COMMAND] section to start the configuration for a command and then provide any options normally allowed by it. When yath is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. Note: You can also add pre-command options by placing them at the top of your config file BEFORE any [cmd] markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to .yath.rc and prefix it to the path inside rel(...). If for example you have /project/.yath.rc then the path would become /project/path/to/extra_lib. glob(path/*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a --default-search $_ for every item found in the glob. This uses the perl builtin function glob() under the hood. relglob(path/*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as glob() except paths are relative to the .yath.rc file. PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a .yath.user.rc file. Format is the same as the regular .yath.rc file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. HARNESS DIRECTIVES INSIDE TESTS yath will recognise a number of directive comments placed near the top of test files. These directives should be placed after the #! line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. HARNESS-NO-STREAM yath usually uses the Test2::Formatter::Stream formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make yath use Test2::Formatter::TAP or Test::Builder::Formatter. HARNESS-NO-IO-EVENTS yath can be configured to use the Test2::Plugin::IOEvents plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper Test2::Event's when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. Note: This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. HARNESS-NO-TIMEOUT yath will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: HARNESS-TIMEOUT-EVENT. HARNESS-TIMEOUT-EVENT 60 yath can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT HARNESS-TIMEOUT-POSTEXIT 15 yath can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into HARNESS-DURATION-LONG This lets you tell yath that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a yath option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. HARNESS-DURATION-MEDIUM This lets you tell yath that the test is medium. This is the default duration. HARNESS-DURATION-SHORT This lets you tell yath That the test is short. HARNESS-CATEGORY-ISOLATION This lets you tell yath that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. HARNESS-CATEGORY-IMMISCIBLE This lets you tell yath that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. HARNESS-CATEGORY-GENERAL This is the default category. HARNESS-CONFLICTS-XXX This lets you tell yath that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and yath will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... HARNESS-SHARES-XXX This lets you tell yath that this test uses XXX, but is happy to share it with other tests that merely use it too. Any number of HARNESS-SHARES-XXX tests may run at the same time, but none of them will run at the same time as a HARNESS-CONFLICTS-XXX test. If you think of the two directives as a lock on the name XXX, CONFLICTS takes it exclusively and SHARES takes it shared. XXX can be replaced with any type of your choosing, and you may set several of them. The usual shape for this is one test that disturbs a resource and many that merely read it: mark the disruptive one HARNESS-CONFLICTS-XXX and the rest HARNESS-SHARES-XXX, and the readers keep their parallelism instead of being serialized alongside the writer. NOTE: An exclusive test has to wait for every shared test holding the name to finish, and yath will not hold job slots empty to make room for it. If shared tests keep becoming available the exclusive one may run quite late in the run, possibly last and by itself. This is still better than marking every test CONFLICTS, but it is worth knowing before you mark hundreds of tests as sharing one name. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. HARNESS-JOB-SLOTS 2 HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. MODULE DOCS This section documents the App::Yath module itself. SYNOPSIS In practice you should never need to write your own yath script, or construct an App::Yath instance, or even access the main instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [grep { !ref($_) } @INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that goto::file can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: pre-process essential arguments such as -D and no-scan-plugins re-exec with a different yath script if in developer mode and a local copy is found Parse the yath-rc config files gather and store essential startup information METHODS App::Yath does not provide many methods to use externally. $app->generate_run_sub($symbol_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. $lib_path = $app->app_path() Get the include directory App::Yath was loaded from. SOURCE The source code repository for Test2-Harness can be found at http://github.com/Test-More/Test2-Harness/. MAINTAINERS Chad Granum AUTHORS Chad Granum COPYRIGHT Copyright 2020 Chad Granum . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://dev.perl.org/licenses/ LICENSE100644001750001750 4627615267772575 16044 0ustar00exodistexodist000000000000Test2-Harness-1.000182This software is copyright (c) 2026 by Chad Granum. 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) 2026 by Chad Granum. 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. 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, see . 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 Moe Ghoul, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2026 by Chad Granum. This is free software, licensed under: The Perl 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 as specified below. "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 uunet.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) give non-standard executables non-standard names, and clearly document 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. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 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 whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End test.pl100644001750001750 137315267772575 16320 0ustar00exodistexodist000000000000Test2-Harness-1.000182#!/usr/bin/env perl # HARNESS-NO-RUN use strict; use warnings; use lib 'lib'; use App::Yath::Util qw/find_yath/; print "1..2\n"; $ENV{'YATH_SELF_TEST'} = 1; system($^X, find_yath(), '-D', 'test', '--qvf', '-r1', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit1 = $?; $ENV{T2_NO_FORK} = 1; system($^X, find_yath(), '-D', 'test', '--qvf', '-r1', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit2 = $?; print "not " if $exit1; print "ok 1 - Passed tests when run by yath (allow fork)\n"; print STDERR "yath exited with $exit1" if $exit1; print "not " if $exit2; print "ok 2 - Passed tests when run by yath (no fork)\n"; print STDERR "yath exited with $exit2" if $exit2; exit($exit1 || $exit2 ? 255 : 0); Changes100644001750001750 14473315267772575 16347 0ustar00exodistexodist000000000000Test2-Harness-1.0001821.000182 2026-10-26 17:51:08-07:00 America/Los_Angeles 1.000181 2026-10-26 12:51:38-07:00 America/Los_Angeles - Files a helper process places in aux_logs/attachments/ under the workdir are attached to the run as binaries on the harness output. - Lower the collector's peak memory for large events by writing each event line without first copying it. 1.000180 2026-09-11 10:37:49-07:00 America/Los_Angeles - Apply --cover-exclude-dirs to coverage produced by processes yath did not launch, such as a descendant that loads the coverage plugin itself. - Coverage events now carry file and sub counts instead of the full file map, which is already reproduced in the aggregated coverage data. - Resolve exclusions against the root a coverage event names, so a producer measuring against its own directory is filtered correctly rather than by guess. - The log now records coverage events as they are sent onward, with exclusions applied and the file map collapsed. 1.000179 2026-09-08 14:40:06-07:00 America/Los_Angeles - Add --cover-exclude-dirs to leave a directory, and everything under it, out of file coverage and coverage metrics; useful when a dependency tree is installed inside the working directory. - File coverage and coverage metrics now require Test2::Plugin::Cover 0.000029 or newer. 1.000178 2026-09-04 13:37:49-07:00 America/Los_Angeles - Cut the time `make test` takes by roughly five times, by removing fixed waits from the test suite and moving its slowest tests behind AUTHOR_TESTING. - Make the wait loop in App::Yath::Tester sleep the fraction of a second it asks for instead of not sleeping at all, so it stops spinning while a yath run is in progress. - Escalate to KILL when App::Yath::Tester gives up waiting on a yath run, so a run that ignores TERM no longer hangs the test file that started it. 1.000177 2026-08-26 09:41:18-07:00 America/Los_Angeles - Print a note every ten seconds while App::Yath::Tester waits on a yath run, so a slow run does not look like a hung test to the harness running it. - Stop t/integration/resource.t from failing when the scheduler does not hand the same number of tests to each resource slot. 1.000176 2026-08-25 11:05:26-07:00 America/Los_Angeles - Stop a conflict between two installed plugins from aborting every yath command; a plugin whose options cannot be included is now reported and skipped. - Stop the isolate_stdout test in t/unit/App/Yath/Util.t from failing when a module writes to STDERR during global destruction in the forked child. - Stop output that is not TAP, such as a warning from a module, from ending a subtest the harness is still parsing out of a test's STDOUT. - Stop failure_cases.t, concurrency.t, stall_report.t, and the retry-timeout fixture from failing on slow or heavily loaded machines. 1.000175 2026-08-20 11:31:30-07:00 America/Los_Angeles - Add the # HARNESS-SHARES-XXX directive, a shared claim on a name: any number of tests sharing XXX run at once, but none alongside a # HARNESS-CONFLICTS-XXX test, which claims XXX exclusively. - Show a shares column alongside conflicts in the pending and running tables of yath status. - Add --stall-report, off unless asked for, which prints diagnostics when the scheduler stops starting tests while tests are pending and could run. - When --stall-report is enabled, yath processes install a SIGUSR1 handler that prints a stack trace instead of exiting, so a stalled run can be diagnosed. - Add --stall-report-dir to say where --stall-report writes its JSON bundle; it defaults to the directory yath was run from, and a copy also goes to the log. - Fix yath test hanging forever instead of exiting when the event stream ends unexpectedly. 1.000174 2026-08-17 13:00:43-07:00 America/Los_Angeles - Teach find_yath() to check $ENV{YATH_SCRIPT}, the directories paired with @INC entries, and PATH, so an uninstalled yath script (as CPAN smokers use) is found instead of aborting the test run. - Make the find_yath() failure report every path it checked, plus the current directory, @INC, PATH, and PERL5LIB, so a report from an unhandled environment can be acted on. - Stop find_yath() from looking for ./scripts/yath, which this dist no longer ships; the yath script re-execs into a local one itself and then names it in YATH_SCRIPT. - Let find_yath() accept a yath script that is readable but not executable, since it is run as an argument to perl; a script found via PATH still needs the exec bit. 1.000173 2026-08-16 22:09:40-07:00 America/Los_Angeles - Skip @INC hook entries when yath snapshots @INC, so tools that install one (such as Carmel) no longer abort the run. - Require App::Yath::Script 2.000017, which stops the yath script from destroying an @INC hook when it re-execs itself for dev-libs. - Fix spelling in the help text for -j, --rerun-plugin, --cover-maybe-from, and the persistent runner commands. - Add [PruneCruft] to dist.ini so build artifacts (blib/, pm_to_blib, MYMETA.*) no longer leak into release tarballs. - Fix the collector pinning a CPU core: it now sleeps between polls instead of busy-looping whenever a job is active. - Keep .yath.rc in the release tarball; [PruneCruft] drops every root dotfile and was undoing the [GatherFile] that ships it. - Run xt/ author tests at release via [RunExtraTests]. - Replace AI_AND_LLM_POLICY.txt with AI_AND_LLM_POLICY.md, barring bot accounts from tickets and pull requests, restating how AI use is noted, and allowing the source as AI/LLM training data. - Fix t/integration/coverage.t failing under Test2::Plugin::Cover 0.000028, which sorts each sub's 'from' list into a different but equally valid order. 1.000172 2026-04-28 21:15:51-07:00 America/Los_Angeles - Fix t/integration/help.t to strip the App::Yath::Script::V# detection message correctly so the test passes under plain prove 1.000171 2026-04-23 03:11:01-07:00 America/Los_Angeles - Depend on the App::Yath::Script dist for the yath script - Bump preload integration test watchdog from 15s to 60s to reduce flakiness on slow CPAN testers hosts 1.000170 2026-04-09 22:35:24-07:00 America/Los_Angeles - Fix encoding test flake: defer :utf8 decode until after child exits to avoid corrupting multi-byte characters during non-blocking reads 1.000169 2026-04-08 15:32:47-07:00 America/Los_Angeles 1.000168 2026-04-07 09:20:34-07:00 America/Los_Angeles - Add --fail-on-resource-skip - Detect and report scheduler death instead of hanging forever - Make scheduler resilient to transient errors 1.000167 2026-04-05 13:52:36-07:00 America/Los_Angeles - Change sleeps to be a bit more sensible 1.000166 2026-04-05 13:41:01-07:00 America/Los_Angeles - No Changes since trial 1.000165 2026-04-04 19:58:16-07:00 America/Los_Angeles (TRIAL RELEASE) - Bugfixes assited by an AI audit - Fixes to busy loops (AI Audit) - Fixes to reset EOF handles when needed (Some AI, one a PR) - Added the --resource-timeout option (AI Assisted) - Note AI assisted in these changes, but I (Exodist) reviewed them carefully. 1.000164 2026-03-31 21:49:47-07:00 America/Los_Angeles - Update to reindex after accidental 2.0 release 1.000163 2026-02-23 20:07:43-08:00 America/Los_Angeles - Fix missing Changes entries 1.000162 2026-02-20 10:37:39-08:00 America/Los_Angeles - add and respect the --no-final-table display option 1.000161 2025-06-10 15:36:21-07:00 America/Los_Angeles - Fix #284: Bad caller in --yath-ui-upload route 1.000160 2025-05-30 14:00:00-07:00 America/Los_Angeles - Remove unintended test dep on Test::Exception 1.000159 2025-05-30 13:45:36-07:00 America/Los_Angeles - Fix #282 - Preserve $? in more cases - Fix #281 - Uninitialized value with --no-retry 1.000158 2025-05-18 10:51:39-07:00 America/Los_Angeles - Fix #280 - warnings in test 1.000157 2025-05-04 04:13:46-07:00 America/Los_Angeles - Version bump to fix a botched trial release 1.000156 2025-01-22 09:54:36-08:00 America/Los_Angeles - Poll for filesystem changes less often 1.000155 2023-10-03 08:53:01-07:00 America/Los_Angeles - Fix sleep that is often interrupted 1.000154 2023-10-02 08:40:50-07:00 America/Los_Angeles - Make it possible to disable shared slots on specific hosts 1.000153 2023-06-14 07:08:47-07:00 America/Los_Angeles - Fix #266 - Fix several declare-lexical+conditional statements 1.000152 2023-04-29 05:30:12-07:00 America/Los_Angeles - Do not require non-perl script tests to be executable - Fix issue where Carp::Always being loaded by PERL5OPT or similar does not crash 1.000151 2023-03-08 07:11:31-08:00 America/Los_Angeles - Fix issue where rarely some UUIDs could be duplicated with IPC 1.000150 2023-03-01 13:40:42-08:00 America/Los_Angeles - Add ability to override 'add' value in rerun grabbing 1.000149 2023-02-28 09:13:50-08:00 America/Los_Angeles - Add more 'rerun' capabilities - Fix diagnostcis replacing '0' with an empty string 1.000148 2023-02-22 17:17:49-08:00 America/Los_Angeles - Fix output corruption in interactive mode 1.000147 2023-02-21 08:16:35-08:00 America/Los_Angeles - Show all output early in interactive mode 1.000146 2023-02-20 18:21:51-08:00 America/Los_Angeles - Fix infinite hang in bad preload (#240) - Remove some debugging - Fix #261 ($. being set incorrectly) 1.000145 2023-02-15 17:31:10-08:00 America/Los_Angeles - Add ability to inject lines in resource output 1.000144 2023-02-15 13:29:48-08:00 America/Los_Angeles - Skip empty tables in resource view 1.000143 2023-02-15 08:33:57-08:00 America/Los_Angeles - Add 'autofill' to simplify 'd' and 'D' option types - Better resource management 1.000142 2023-01-25 14:38:31-08:00 America/Los_Angeles - Add more capabilities around argument processing 1.000141 2022-12-15 14:15:39-08:00 America/Los_Angeles - Fix typo in rare conditional 1.000140 2022-12-13 18:11:36-08:00 America/Los_Angeles - Fix permissions issue with state files 1.000139 2022-12-13 11:49:03-08:00 America/Los_Angeles - Add 'COMMON' config options for shared slots - Add options for default j and x values in shared slots 1.000138 2022-12-06 06:52:55-08:00 America/Los_Angeles - Fix resources output for shared slots - Make slots a range, not a single value 1.000137 2022-12-05 13:15:45-08:00 America/Los_Angeles - Rework shared slots logic 1.000136 2022-11-29 13:56:37-08:00 America/Los_Angeles - Add ability to sort resource plugins to get them in order. 1.000135 2022-11-29 10:44:53-08:00 America/Los_Angeles - Add ability to specify a umask for shared slots files 1.000134 2022-11-29 10:03:09-08:00 America/Los_Angeles - Add ability to assign multiple slots to jobs - Add shared job slots 1.000133 2022-09-07 13:44:03-07:00 America/Los_Angeles - Order tests with conflicts earlier than others 1.000132 2022-09-07 09:42:06-07:00 America/Los_Angeles - Further improve resource command and file 1.000131 2022-09-06 15:53:55-07:00 America/Los_Angeles - Use relative file paths for job slot display 1.000130 2022-09-06 14:39:43-07:00 America/Los_Angeles - Better resource display - Fix #255 (.test_info.json being left behind) - Fix issue where not all resources will be loaded by resource command 1.000129 2022-09-06 11:20:38-07:00 America/Los_Angeles - Fix issue with job slots sometimes being doubled when tests are skipped 1.000128 2022-09-02 13:01:09-07:00 America/Los_Angeles - Fix issue where yath might exit before all output is rendered - Add scheduler process - Fix --color flag (Thanks James Raspass, #246) - Fix spelling mistakes (Thanks bernhard, #249) 1.000127 2022-08-31 08:32:44-07:00 America/Los_Angeles - Remove unnecessary Carp::Always 1.000126 2022-08-30 11:09:19-07:00 America/Los_Angeles - Add 'yath resources' command to view resource usage 1.000125 2022-07-08 15:50:11-07:00 America/Los_Angeles - Change -jN to use a resource class instead of hard-coding it into State.pm - Fix bug in how a POSIX function is called 1.000124 2022-04-08 12:26:14-07:00 America/Los_Angeles - Fix bug where see `yath status` was being shown for non-persistent runs - Make 'busy' message shorter so it is less likely to be truncated 1.000123 2022-04-06 13:34:10-07:00 America/Los_Angeles - Fix bug where spawns would not run if queued before stages were ready 1.000122 2022-04-06 11:04:43-07:00 America/Los_Angeles - Fix another id vs uuid typo 1.000121 2022-04-06 10:46:35-07:00 America/Los_Angeles - Fix bug introduced by my last fix... oops 1.000120 2022-04-06 10:17:48-07:00 America/Los_Angeles - Fix bug where a stage reload would re-run all previously requested spawns 1.000119 2022-04-05 10:58:59-07:00 America/Los_Angeles - Allow per-test args to be specified at the command line 1.000118 2022-04-05 09:39:40-07:00 America/Los_Angeles - Do not show broken reload files multiple times 1.000117 2022-04-04 16:09:58-07:00 America/Los_Angeles - Check for reload errors before allowing a `yath run` to work 1.000116 2022-04-01 15:29:40-07:00 America/Los_Angeles - Better handling of version mismatches in the persistent runner - Better info when a `run` command is waiting on a busy runner 1.000115 2022-03-31 10:28:14-07:00 America/Los_Angeles - Fix reload bug when using restricted reload - Fix bug where inotify would only report changes once 1.000114 2022-03-24 09:27:03-07:00 America/Los_Angeles - Fix bug when inotify is not installed - Make yath better at detecting when 2 files are the same 1.000113 2022-03-23 09:36:57-07:00 America/Los_Angeles - Refactor preloader into preloader and reloader - Honor churn blocks during relead events even if --reload is disabled 1.000112 2022-03-15 14:21:29-07:00 America/Los_Angeles - Add --rerun and --rerun-failed options to test/run command - Add lastlog.jsonl.* symlink creation to auto-link to the last log produced 1.000111 2022-03-09 15:07:10-08:00 America/Los_Angeles - Better handling and checking of persistence files 1.000110 2022-02-24 11:50:52-08:00 America/Los_Angeles - Add 'tick()' method to resource classes 1.000109 2022-02-22 12:07:11-08:00 America/Los_Angeles - Do not initialize resources in `yath run` - Add command to settings->harness - Add from_runner to settings included from a persistent runner - Fix temp dir issue in macos 1.000108 2022-02-11 15:23:10-08:00 America/Los_Angeles - Add ability for resource managers to report resources as unavailable ot skip tests - Add setup method for resource managers 1.000107 2022-02-10 08:49:19-08:00 America/Los_Angeles - Clean up FIFO in interactive mode with a persistent runner 1.000106 2022-02-08 10:10:38-08:00 America/Los_Angeles - Fix uninitialized warning 1.000105 2022-02-08 09:52:32-08:00 America/Los_Angeles - Make changes_diff work with or without prefixes in the filenames 1.000104 2022-02-04 11:00:29-08:00 America/Los_Angeles - Add settings ot paremeter list for coverage managers 1.000103 2022-02-04 10:20:32-08:00 America/Los_Angeles - Add options to for whitespace and non-subs in change data --changes-include-whitespace - Include whitespace lines for change data --changes-exclude-nonsub - Do not include non-sub changes in perl files --changes-exclude-opens - Do not include tests that only open() changed files --changes-exclude-loads - Do not include tests that only load changed files without running subs 1.000102 2022-02-03 15:28:54-08:00 America/Los_Angeles - Remove warning that can trigger in valid (not warn-worthy) cases. 1.000101 2022-02-02 13:26:35-08:00 America/Los_Angeles - Fix 'replay' output of subtests 1.000100 2022-02-01 09:49:52-08:00 America/Los_Angeles - Mark reload_syntax_error.t as AUTHOR_TESTING only (#243) - Add threshold for duration data fetching, this saves time when duration data is large 1.000099 2022-01-27 10:20:38-08:00 America/Los_Angeles - Add options to exclude some chnaged files when running coverage tests 1.000098 2022-01-27 09:36:24-08:00 America/Los_Angeles - Fix bugs in 'failed' command after adding subtests 1.000097 2022-01-27 08:31:46-08:00 America/Los_Angeles - Show subtest failures in 'failed' command 1.000096 2022-01-26 14:42:43-08:00 America/Los_Angeles - Show failed subtests in final summary - Fix bug where env vars get removed when we preload Test2::API too early (#241) - Fix bug where replay with test filename has uninitialized warnings (#242) 1.000095 2022-01-07 14:35:25-08:00 America/Los_Angeles - Fix bug where syntax errors prevented reloading of effected files 1.000094 2022-01-05 13:51:40-08:00 America/Los_Angeles - Fix logic so that tests for changed files are only added when requested - Pass all changes to the coverage managers 1.000093 2021-12-16 15:19:47-08:00 America/Los_Angeles - Split out 'get_coverage_tests' logic for reuse 1.000092 2021-12-16 10:39:37-08:00 America/Los_Angeles - Add plugin hook for post-processing of coverage data. 1.000091 2021-12-15 12:09:09-08:00 America/Los_Angeles - Add more reload capabilities (non-perl reloading, callbacks) 1.000090 2021-12-14 12:43:11-08:00 America/Los_Angeles - Fix bug in status command when only 1 run is present 1.000089 2021-12-14 12:12:05-08:00 America/Los_Angeles - Add several commands for managing persisten runners - yath kill - Kill the runner and all tests (stop NOW) - yath ps - Show running yath process list - yath status - Show processes and health status - yath abort - Cancel any running or queued test, but do not kill runner - Control+C in `yath run` does a better job of cleaning up 1.000088 2021-12-13 11:29:24-08:00 America/Los_Angeles - Skip tests that do not exists when running coverage tests 1.000087 2021-12-09 13:51:59-08:00 America/Los_Angeles - Add --procname-prefix option to add custom strings to procnames 1.000086 2021-12-07 13:40:40-08:00 America/Los_Angeles - Add 'HARNESS-CHURN-XXX' directive support 1.000085 2021-12-06 16:28:51-08:00 America/Los_Angeles - Make 'do' actually work 1.000084 2021-12-06 15:59:23-08:00 America/Los_Angeles - Add 'do' command that has the magic of picking run or test as needed 1.000083 2021-12-03 10:18:27-08:00 America/Los_Angeles - Add options for controlling runner output, specially for `yath run` 1.000082 2021-11-18 09:04:17-08:00 America/Los_Angeles - Make collector options configurable - Add collector option for max poll events - Add collector option for max open jobs - Turn warnings about too many open files into proper events 1.000081 2021-11-15 13:27:48-08:00 America/Los_Angeles - Retry opening files later when "too many files open" errors occur 1.000080 2021-11-04 11:13:07-07:00 America/Los_Angeles - Add sort_files_2 for plugins to add settings and future-proof it 1.000079 2021-10-29 10:42:39-07:00 America/Los_Angeles - smarter reloader, bit via callbacks, not assumptions 1.000078 2021-10-28 15:38:10-07:00 America/Los_Angeles - Disable the feature from the last commit, it needs rethinking thanks to things like Moose. 1.000077 2021-10-28 15:14:09-07:00 America/Los_Angeles - Make reloader smarter, do not delete subs from other files when reloading a file 1.000076 2021-10-22 10:29:22-07:00 America/Los_Angeles - Add relative filename to the queued task 1.000075 2021-10-21 14:05:27-07:00 America/Los_Angeles - Fix missing Changes entry for last release 1.000074 2021-10-20 09:58:05-07:00 America/Los_Angeles - Better coverage aggregation and plugin capabilities 1.000073 2021-09-21 10:25:42-07:00 America/Los_Angeles - Load coverage module EARLY in the runner spawn process - Add ability to for plugins to inject CLI options for the runner 1.000072 2021-09-13 09:29:54-07:00 America/Los_Angeles - Wrap fifo creation in a loop for interrupted system calls 1.000071 2021-09-03 08:26:04-07:00 America/Los_Angeles - Allow custom subclasses with cover plugin 1.000070 2021-09-01 13:36:50-07:00 America/Los_Angeles - Improve reload inotify logic 1.000069 2021-08-31 14:07:54-07:00 America/Los_Angeles - Add interactive mode! 1.000068 2021-08-30 09:52:12-07:00 America/Los_Angeles - Expand --cover-dir options with glob() 1.000067 2021-08-27 11:32:10-07:00 America/Los_Angeles - Add option to only reload repo directories 1.000066 2021-08-12 13:48:06-07:00 America/Los_Angeles - Fix 'Cover' plugin to record untested perl files 1.000065 2021-08-04 15:11:59-07:00 America/Los_Angeles - Fix 'Cover' plugin bugs and edge cases 1.000064 2021-08-02 15:23:04-07:00 America/Los_Angeles - Add more capabilities for plugins - Add the 'Cover' plugin to handle coverage in a better way 1.000063 2021-07-14 09:44:17-07:00 America/Los_Angeles - Add diags/notes to notification problem-capture 1.000062 2021-07-07 15:34:34-07:00 America/Los_Angeles - Add info on where/why 'claim_file' was called 1.000061 2021-07-07 12:53:11-07:00 America/Los_Angeles - Add even more support for notification plugins 1.000060 2021-07-06 09:51:45-07:00 America/Los_Angeles - Add support for html email 1.000059 2021-07-01 13:56:29-07:00 America/Los_Angeles - Add support for custom email/slack text 1.000058 2021-06-15 15:38:16-07:00 America/Los_Angeles - Add support for new yathui direct db coverage/duration plugin - Add option to disable bail-out abortion 1.000057 2021-06-04 15:59:24-07:00 America/Los_Angeles - Add ability to provide a diff for changed files - Add ability to filter files with changes 1.000056 2021-05-24 14:26:45-07:00 America/Los_Angeles - Fix warnings from preloader 1.000055 2021-05-18 13:05:20-07:00 America/Los_Angeles - Run 'conficting' tests sooner 1.000054 2021-05-04 08:58:25-07:00 America/Los_Angeles - Add option to dump depmaps 1.000053 2021-04-30 11:22:30-07:00 America/Los_Angeles - Be smarter about what can or cannot be reloaded in 'reload' mode 1.000052 2021-04-30 10:37:56-07:00 America/Los_Angeles - Add --reload option to 'start' command to reload moduels in-place when possible - Make Test2::Plugin::Cover optional again 1.000051 2021-04-29 07:40:33-07:00 America/Los_Angeles - Fix an edge-case warning from git plugin 1.000050 2021-04-27 09:22:25-07:00 America/Los_Angeles - Allow a default coverage manager to be provided - Move Test2::Require::Module to dev requirements - Update some modules from 'base' to 'parent' 1.000049 2021-04-26 08:08:05-07:00 America/Los_Angeles - Fully require Test2::Plugin::Cover at a sufficient version 1.000048 2021-04-23 11:54:37-07:00 America/Los_Angeles - Require updated Test2::Plugin::Cover - Better coverage handling, sync with newer Test2::Plguin::Cover 1.000047 2021-04-20 11:42:49-07:00 America/Los_Angeles - Remove some coverage data that was nto intended to be present (false data) 1.000046 2021-04-20 09:25:24-07:00 America/Los_Angeles - Remove debugging print statement 1.000045 2021-04-20 09:14:01-07:00 America/Los_Angeles - Change how coverage and changed-files data works 1.000044 2021-03-11 20:08:54-08:00 America/Los_Angeles - Add plugin support for providing coverage/duration data - Fix running t/integration tests with ./ in path (#215) - Add a fixme/todo test for #216 (Tap subtest parsing) 1.000043 2021-03-05 07:47:04-08:00 America/Los_Angeles - Minor documentation correction - Add 'signal()' method to Renderer base class 1.000042 2020-11-17 22:44:35-08:00 America/Los_Angeles - Fix pipe size setting to actually use the value we want - Fix pipe size setting code for older perls 1.000041 2020-11-17 22:28:55-08:00 America/Los_Angeles - When possible use a larger pipe buffer 1.000040 2020-11-17 21:59:41-08:00 America/Los_Angeles - Fix bug in collector that made it marginally less efficient - Fix bug that prevented no-max from working in JobDir poll - Fix bug that prevented the active status display from updating 1.000039 2020-11-17 19:54:08-08:00 America/Los_Angeles - yath watch shows aux output - Minor no-op code improvement in Runner.pm 1.000038 2020-11-02 20:49:12-08:00 America/Los_Angeles - Add shellcall and aux output capture for plugins 1.000037 2020-11-02 14:31:10-08:00 America/Los_Angeles - Fix conflict between process management and resource management 1.000036 2020-11-01 20:34:19-08:00 America/Los_Angeles - Add initializing status line 1.000035 2020-10-29 15:00:33-07:00 America/Los_Angeles - Add glob() and relgob() .yath.rc pseudo-functions - Document rel() .yath.rc pseudo-function 1.000034 2020-10-29 07:51:19-07:00 America/Los_Angeles - Fix warning when output is not a terminal 1.000033 2020-10-28 16:37:19-07:00 America/Los_Angeles - Better status line while tests are running - Do not use --START-- and --END-- on long single-lines 1.000032 2020-10-23 11:59:34-07:00 America/Los_Angeles - Make it possible to run an alternate file to the one specified 1.000031 2020-10-22 11:27:59-07:00 America/Los_Angeles - Fix incorrect return from $spawn->args 1.000030 2020-10-21 19:34:45-07:00 America/Los_Angeles - Add environment variable management to spawn command - Move spawn logic to overridable methods 1.000029 2020-10-15 13:57:36-07:00 America/Los_Angeles - Add 'spawn' command - Fix plan in test.pl 1.000028 2020-09-25 08:43:43-07:00 America/Los_Angeles - Fix issue where args after :: were ignored (#195) 1.000027 2020-09-21 11:46:43-07:00 America/Los_Angeles - Move dbi_profile and cover_Files to run 1.000026 2020-09-08 13:37:50-07:00 America/Los_Angeles - Make nytprof work in persistent mode 1.000025 2020-09-08 11:29:07-07:00 America/Los_Angeles - Fix edge case where STDIN was opened for writing - Add basic support for nytprof 1.000024 2020-08-24 09:06:43-07:00 America/Los_Angeles - Add Test2::Harness::Runner::Resource for resource management 1.000023 2020-08-14 21:18:29-07:00 America/Los_Angeles - No changes since trial 1.000022 2020-08-13 15:18:07-07:00 America/Los_Angeles (TRIAL RELEASE) - Make failure to chmod things non-fatal to fix bsd testing - Fix spelling issues - Make chmod stuff more correct 1.000021 2020-08-04 21:03:28-07:00 America/Los_Angeles (TRIAL RELEASE) - Add changed_files plugin hook - Make git plugin support changed_files hook - Add Test2::Harness::Log docs - Add 'cover-files' option using Test2::Plugin::Cover - Add coverage aggregator tool - Add ability to run tests that cover changed files - Add dbi-profiling option - Fix permissions on temp dirs (may still have some issues) 1.000020 2020-07-08 22:25:23-07:00 America/Los_Angeles - reduce version of Data::UUID required - Allow filenames in replay - Add 'cover_files' shortcut for Test2::Plugin::Cover 1.000019 2020-05-30 11:07:09-07:00 America/Los_Angeles - Typo Fix in error message - Do not die on 0 failures 1.000018 2020-04-13 13:35:34-07:00 America/Los_Angeles - Stop leaving leftover files in /tmp 1.000017 2020-04-07 15:47:42-07:00 America/Los_Angeles - Fix log_dir test on macos 1.000016 2020-04-07 15:14:00-07:00 America/Los_Angeles - Fix #! in yath script - Fix 'DEFAULT' and 'IGNORE' signal inheritence - Fix log-dir specificiation (#174) 1.000015 2020-03-23 11:49:38-07:00 America/Los_Angeles - YathUI plugin improvements (show url, show errors) - Add more compression options to open_file 1.000014 2020-03-21 18:20:37-07:00 America/Los_Angeles - Add YathUI plugin - Fix maybe_durations option 1.000013 2020-03-18 13:16:20-07:00 America/Los_Angeles - Minor doc change 1.000012 2020-03-18 13:09:14-07:00 America/Los_Angeles - Fix #172 qvf+verbose - Fix #169 log path in 'run' command - Fix #168 - :: mistaken for command name - Fix #171 summary should only be shown when applicable - Fix #171 Add --brief option to 'failed' command 1.000011 2020-03-09 09:12:25-07:00 America/Los_Angeles - Fix notifications so that all failed tests are shown 1.000010 2020-03-08 15:15:24-07:00 America/Los_Angeles - Fix missing Launch in verbose mode - Restore HARNESS_IS_VERBOSE env variable - Fix #163 where 1 concurrent job would get stuck reducing concurrency 1.000009 2020-03-06 14:05:23-08:00 America/Los_Angeles - Add HARNESS-NO-RETRY 1.000008 2020-03-06 08:17:29-08:00 America/Los_Angeles - Add --exclude-list option 1.000007 2020-03-05 13:55:01-08:00 America/Los_Angeles - Fix __FILE__ value in 'projects' command 1.000006 2020-03-03 15:32:49-08:00 America/Los_Angeles - Provide methods in TestFile that let you get/set retry 1.000005 2020-03-02 14:48:40-08:00 America/Los_Angeles - Use --qvf in test.pl for better output - Use -r1 in test.pl temporarily for some cpantesters 1.000004 2020-03-02 10:05:10-08:00 America/Los_Angeles - Switch away from sys-io in Util::File::Stream - Properly wrap FLOCK to handle interrupted syscalls - Remove unnecessary IPC::Open3 dep - Remove unnecessary Module::Pluggable dep - Add missing require statement 1.000003 2020-03-01 21:50:08-08:00 America/Los_Angeles - Do not run persistent tests in AUTOMATED_TESTING 1.000002 2020-03-01 21:19:04-08:00 America/Los_Angeles - Fix integration tests IO issues 1.000001 2020-02-29 10:49:11-08:00 America/Los_Angeles - Do not run tests on broken NJH smokers 1.000000 2020-02-28 09:30:47-08:00 America/Los_Angeles - No changes since last trial release - This is the first stable release - Huge changes/refactor from the alpha versions 0.999010 2020-02-27 21:52:25-08:00 America/Los_Angeles (TRIAL RELEASE) - Make signals.t author-testing - Cleanup failure-test - Show timeout delta when timing out a test 0.999009 2020-02-27 07:27:29-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix sorting in ordering tests - Fix incorrect line numbers in plugin.t errors - Less fragile fork check in Makefile.PL 0.999008 2020-02-26 20:25:34-08:00 America/Los_Angeles (TRIAL RELEASE) - Only officially support systems with true fork(). 0.999007 2020-02-26 16:52:46-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix IOStream permissions issues 0.999006 2020-02-26 15:39:28-08:00 America/Los_Angeles (TRIAL RELEASE) - Do not use IOEvents by default 0.999005 2020-02-25 14:02:01-08:00 America/Los_Angeles (TRIAL RELEASE) - Remove blib from tarball - Fix tests when outdated plugins are present 0.999004 2020-02-25 07:48:30-08:00 America/Los_Angeles (TRIAL RELEASE) - Warn+Skip when auto-loading outdated plugins 0.999003 2020-02-24 14:51:18-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix older perls (down to 5.10) 0.999002 2020-02-24 08:56:06-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix installation when an old yath is installed 0.999001 2020-02-23 15:42:47-08:00 America/Los_Angeles (TRIAL RELEASE) - Attempt to fix includes integration test 0.999000 2020-02-23 10:19:36-08:00 America/Los_Angeles (TRIAL RELEASE) - Huge refactor - Fix signal restoration for forked tests 0.001099 2019-09-09 21:12:15-07:00 America/Los_Angeles - Add --durations and --maybe_durations options 0.001098 2019-09-09 13:35:22-07:00 America/Los_Angeles - Add current dir to run data - Add rel/abs paths to harness_job_start/end 0.001097 2019-09-08 19:22:56-07:00 America/Los_Angeles - Add speedtag command 0.001096 2019-09-08 15:24:00-07:00 America/Los_Angeles - Cleanup help options a bit - Split category into category and duration - Clean up the ProcMan module - Tests start as their own process groups 0.001095 2019-09-04 15:38:07-07:00 America/Los_Angeles - Fix logging of plugin when it is blessed 0.001094 2019-09-04 14:44:55-07:00 America/Los_Angeles - Improve+Test SysInfo and Git Plugins 0.001093 2019-09-03 13:23:04-07:00 America/Los_Angeles - Add branch info to git data 0.001092 2019-09-03 10:32:46-07:00 America/Los_Angeles - Minor tweaks to SysInfo and Git plugins 0.001091 2019-08-30 14:03:19-07:00 America/Los_Angeles - Add Yath::Plugin::SysInfo 0.001090 2019-08-30 10:22:23-07:00 America/Los_Angeles - Allow specifying run-fields as JSON 0.001089 2019-08-30 09:05:59-07:00 America/Los_Angeles - Allow listing run-fields on the command line 0.001088 2019-08-29 23:23:47-07:00 America/Los_Angeles - Abstract and correct timing data collection 0.001087 2019-08-29 12:54:23-07:00 America/Los_Angeles - Fix incorrect timestamps 0.001086 2019-08-28 14:19:57-07:00 America/Los_Angeles - Fix overall harness run time where HiRes was only used for start time, not end time (sometimes resulting in a negative run time being printed) - Do not use Test2::Plugin::Times - Use event based timing data for -T - remove --times flag - Support for non-perl tests 0.001085 2019-08-21 16:49:20-07:00 America/Los_Angeles - Do not require DBIProfile yet until we need it (#111) - Standardize how fields are specified 0.001084 2019-08-16 20:08:48-07:00 America/Los_Angeles - Make More information available to plugins 0.001083 2019-08-16 19:55:17-07:00 America/Los_Angeles - Split out some plugins (DBIProfile, MemUsage, UUID) - No special treatment for plugins, they need to use INFO facets 0.001082 2019-08-15 11:03:22-07:00 America/Los_Angeles - Support 'END' phase in calculating times - Support super verbose mode in composer - Improvement ot DBIProfile - New minimum Test2 version 0.001081 2019-08-13 13:49:32-07:00 America/Los_Angeles - Add Git injection plugin - Add DBI Profile plugin - Calculate and record timing data 0.001080 2019-07-24 09:56:41-07:00 America/Los_Angeles - Make it possible to relocate the persistence file 0.001079 2019-07-05 12:56:06-07:00 America/Los_Angeles - Work around JSON::XS Bug 0.001078 2019-07-02 08:46:49-07:00 America/Los_Angeles - Document yath log format 0.001077 2019-06-06 15:04:32-07:00 America/Los_Angeles - Add --retry options (toddr) - Make sure all events are flushed if there is a sync issue - Added some tests 0.001076 2019-05-20 14:54:50-07:00 America/Los_Angeles - Fix TAP parsers nesting parsing - Dix comment groupign when parsing TAP 0.001075 2019-05-18 18:33:52-07:00 America/Los_Angeles - Fix Stream+IPC issues 0.001074 2019-05-07 12:04:51-07:00 America/Los_Angeles - Add support for table structures 0.001073 2019-04-10 08:21:04-07:00 America/Los_Angeles - Add support for disabled progress indicators to QVF mode 0.001072 2019-04-08 10:27:50-07:00 America/Los_Angeles - Add option to turn off progress indicators 0.001071 2018-12-13 09:43:38-08:00 America/Los_Angeles - Add --notify-text CLI option - Fix exit code parsing and reporting 0.001070 2018-10-24 13:19:53-07:00 America/Los_Angeles - Allow --author-testing in 'projects' command - Misc minor changes 0.001069 2018-08-23 13:48:54-07:00 America/Los_Angeles - Fix busy-spin in job reaper - Allow --no-fork and --no-preload simultaneously 0.001068 2018-07-27 09:12:45-07:00 America/Los_Angeles - Fix more encoding/utf8 bugs - Fix missing dep on sufficient List::Utils version 0.001067 2018-07-18 07:42:06-07:00 America/Los_Angeles - Add ability to congiure a custom log file format 0.001066 2018-07-12 08:06:46-07:00 America/Los_Angeles - Fix issue where isolation jobs were being kicked off too early. It needs to wait for all non-isolation jobs to finish first. - New Feature: # HARNESS-CONFLICTS-XXX - New documentation for HARNESS-CATEGORY-IMMISCIBLE - New documentation for HARNESS-TIMEOUT-EVENT - Get rid of the use of each when walking a hash. - Allow comment only lines prior to HARNESS-XXX directives - Accept binary TAP output that is not correctly formatted to UTF8 - Honor multiple spaces (or -) as a delimiter for # HARNESS directives 0.001065 2018-04-22 03:26:57-07:00 America/Los_Angeles - Fix utf8 double encoding error 0.001064 2018-03-29 22:47:10-07:00 America/Los_Angeles - Make it possible to chdir for a given test - Make run automatically chdir to the dir you were in when queuing tests - Add 'projects' command to run a dir with multiple projects 0.001063 2018-03-27 10:17:02-07:00 America/Los_Angeles - Make it possible to use relative paths in yath.rc 0.001062 2018-03-19 09:22:18-07:00 America/Los_Angeles - Fix bug where $, and $\ would break the formatters 0.001061 2018-03-14 12:47:28-07:00 America/Los_Angeles - No Changes since last trial 0.001060 2018-03-13 11:11:27-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix parsing of streaming subtests 0.001059 2018-03-12 13:26:43-07:00 America/Los_Angeles - Job id's are now uuid's. Numbers for humans are now names - Use UUIDs for event IDs - Update min Test2 version 0.001058 2018-03-11 15:29:23-07:00 America/Los_Angeles - Fix broken tests - Record times by default, but only show when requested - Add memory usage - Do not add times from the harness itself - Add UUIDs to everything 0.001057 2018-03-07 08:09:18-08:00 America/Los_Angeles - No changes from last trial 0.001056 2018-03-06 13:47:08-08:00 America/Los_Angeles (TRIAL RELEASE) - Account for the 'hub' facet 0.001055 2018-03-05 20:10:24-08:00 America/Los_Angeles - Fix error where multiple procs read the same fh at once 0.001054 2018-03-02 09:05:44-08:00 America/Los_Angeles - Switch Streaming write() to use syswrite - Fix bug where jobs would re-run after a reload 0.001053 2018-02-27 07:15:53-08:00 America/Los_Angeles - No changes since last trial 0.001052 2018-02-06 15:03:08-08:00 America/Los_Angeles (TRIAL RELEASE) - Fix infinite recursion in closed subtests log json 0.001051 2018-02-06 13:29:38-08:00 America/Los_Angeles (TRIAL RELEASE) - Extract composer logic from Test2 formatter so it can be re-used - Revamp Watcher to stop mangling events - Onlt log processed events now by default (since mangling has stopped) 0.001050 2018-02-01 13:31:58-08:00 America/Los_Angeles - Allow logging of both processed and unprocessed events - Add finish() hook to loggers - This is a breaking change for any existing loggers (still alpha! Do not complain!) 0.001049 2018-01-26 14:27:16-08:00 America/Los_Angeles - Better 'renderer' handling 0.001048 2018-01-23 10:42:16-08:00 America/Los_Angeles - Make it possible to use multiple renderers at once - Fix return via next issue 0.001047 2018-01-19 21:58:13-08:00 America/Los_Angeles - Fix auto-reload for preload mode 0.001046 2018-01-18 10:47:31-08:00 America/Los_Angeles - Make --qvf show INTERNAL messages (#51) - Make -v override --qvf (#50) - Do not show 'no_display' about messages (#44) 0.001045 2018-01-05 08:38:05-08:00 America/Los_Angeles - Make it possible to toggle --qvf off - Show files being run in --qvf mode 0.001044 2018-01-02 07:25:06-08:00 America/Los_Angeles - Add post-run hook to plugins - Add -V/--version flags 0.001043 2017-12-19 10:12:22-08:00 America/Los_Angeles - Remove test for deleted file 0.001042 2017-12-18 15:03:26-08:00 America/Los_Angeles - Better scheduling simplification 0.001041 2017-12-06 11:01:16-08:00 America/Los_Angeles - Make realtime slack/email of failures possible - Add QVF (Quiet but verbose on failure) formatter 0.001040 2017-12-04 23:20:35-08:00 America/Los_Angeles - Fix filehandle IPC leak issue 0.001039 2017-12-04 21:54:24-08:00 America/Los_Angeles - Simplify scheduling 0.001038 2017-11-30 10:13:09-08:00 America/Los_Angeles - Minor fixes - Fix race condition/off by 1 when using the 'run' command 0.001037 2017-11-29 09:44:23-08:00 America/Los_Angeles - Add slack integrations - Add support for .yath.user.rc 0.001036 2017-11-28 10:26:36-08:00 America/Los_Angeles - Harness directives for meta-data - Add email capabilities 0.001035 2017-11-22 09:59:49-08:00 America/Los_Angeles - Fix infinite recrusion looking for .yathrc - Add 'failed' command 0.001034 2017-11-20 09:19:47-08:00 America/Los_Angeles - Prevent deadlock on win32 (tests do not pass yet in win32) 0.001033 2017-11-18 16:16:52-08:00 America/Los_Angeles - Add a summarize_events to Test2::Tools::HarnessTester 0.001032 2017-11-15 08:44:40-08:00 America/Los_Angeles - Add an extra @INC hook in persistent mode for dep tracing 0.001031 2017-11-03 09:18:56-07:00 America/Los_Angeles - Remove Debug tool that used sigusr1 - Fix support for perls as far back as 5.8.9 0.001030 2017-11-01 13:24:17-07:00 America/Los_Angeles - Make tests work witohut old version installed - Do not use shm by default - add tests for replay command - better test.pl - use clone_io instead of hand rolling it (Formatter) - doc fixes - make sure test.pl does not run itself 0.001029 2017-10-31 14:53:52-07:00 America/Los_Angeles - Move away from IPC::Open3 0.001028 2017-10-31 09:35:23-07:00 America/Los_Angeles - More test coverage improvements 0.001027 2017-10-27 15:11:57-07:00 America/Los_Angeles - Do not inject a HASHREF as an env var key - Improved test coverage - Added a test helper for commands (including third party ones) - Do not remove newlines from stdout - Merge sequential stdout/stderr lines - Add minimal test descriptions 0.001026 2017-10-24 10:00:34-07:00 America/Los_Angeles - Fix a couple commands that broke due ot @INC fixes 0.001025 2017-10-24 09:40:28-07:00 America/Los_Angeles - Require a newer goto-file to avoid changing exceptions - Allow control of default search locations - stop command now prints all to stdout 0.001024 2017-10-23 12:12:53-07:00 America/Los_Angeles - Make sure @INC is set as soon as possible - Do not let a file hide a command 0.001023 2017-10-20 22:16:33-07:00 America/Los_Angeles - Update to a newer HashBase 0.001022 2017-10-20 07:12:19-07:00 America/Los_Angeles - Minor test updates 0.001021 2017-10-13 11:02:22-07:00 America/Los_Angeles - More @INC corrections - DepTracer no longer mangles caller. 0.001020 2017-10-13 07:34:02-07:00 America/Los_Angeles - Use the correct @INC in all preload methods 0.001019 2017-10-11 10:08:14-07:00 America/Los_Angeles - Don't call find_yath() if we already found a yath (Matthew Horsfall) - Minor display optimizations 0.001018 2017-10-10 14:42:16-07:00 America/Los_Angeles - Fix a DESTROY typo (Michael McClimon) - Test2::Harness namespace does not use App::Yath namespace - Package delcaration allowed before harness directives - When respawning a stage may exit badly, nobody cares - Fix scheduling properly this time - Record timing data for all events - Stop using expensive canonical JSON for logs - Better $0 handling 0.001017 2017-10-07 16:24:01-07:00 America/Los_Angeles - Fix scheduling - Add 'times' tool - Put skip reason on same line as filename 0.001016 2017-10-03 07:14:08-07:00 America/Los_Angeles - More test coverage - Added --cover option - Added --dummy option - Improved 'start', 'stop', and 'run' - Remove chdir option - Fix broken replay command - Fix some deadlock conditions - Cleaner output - Do not wrap long output lines when output is not a terminal - DZIL generates some docs now - Minor bug fixes and improvements - Improved performance of the parser - Add # HARNESS-TIMEOUT-[TYPE] ## header support - Add -q|--quiet mode - Do not try to kill job after post-exit timeout - Remove the tcm plugin (it is failure) - Handle sync points when incomplete lines are written 0.001015 2017-09-15 08:55:30-07:00 America/Los_Angeles - Put lib, blib, and -I's before system libs (Fixes #31) - Bump minimum goto-file version (Fixes #30) - Use $Config for path seperator instead of ':' 0.001014 2017-09-14 21:27:29-07:00 America/Los_Angeles - Pass-Through $ENV{PERL5LIB} 0.001013 2017-09-14 18:29:49-07:00 America/Los_Angeles - Put back code that was accidentally removed 0.001012 2017-09-14 15:19:19-07:00 America/Los_Angeles - Fix dep list 0.001011 2017-09-14 14:27:32-07:00 America/Los_Angeles - Fix bug where no-fork skipped tests - Use relative paths for tests in $0, __FILE__, and caller 0.001010 2017-09-14 10:31:35-07:00 America/Los_Angeles - Pull out the filter into goto::file - Do not use filter for tests that come back as subrefs - Improve TCM plugin - Fix timeouts (again) - Remove unused variable - Stop waiting for a test once it is killed - Fix Typos - Some bug fixes 0.001009 2017-09-12 23:10:05-07:00 America/Los_Angeles - Better docs - More testing - Minor bug fixes 0.001008 2017-09-12 13:49:05-07:00 America/Los_Angeles NOW Feature-complete! (Needs docs and tests) - Fix dep versions in dist.ini - Improve test coverage - Better test.pl detection by yath command - Add color/no-color options - Support for project .yath.rc files - Make sure $VERSION is in correct files - Add 'help' command - Add 'init' command - More hooks for preload modules - Several bug fixes - Make it so that preload+fork does not add a stack layer - unify to only one 'yath' script - Split persist into multiple commands - Create a plugin system, Add TCM plugin to split out later - Remove pre-import option - Better default log location+name - Move CommandShared/Harness -> App/Command.pm - Add --no-long option - Add --exclude option - Bind lib & blib earlier, use absolute paths - Fix parser error on '}' - Allow -w in tests after preload - Handle timers better 0.001007 2017-09-11 21:40:28-07:00 America/Los_Angeles - Properly pass args given via '::' - Honor NO-STREAM header - Persist now reloads when a file is changed 0.001006 2017-09-06 14:24:18-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix replay - Add pre-import - Add load and load-import options - Add persistent harness 0.001005 2017-09-05 21:59:21-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix some bugs - Remove accidentally added file - Do not hang when waiting after control+c - Restructure Run/Runner to be more sane - Fix bugs, break out test file and queue - Add extra space in help dialog - Restructure common command options - Better queue handling - Put test and replay common logic in one place - Fix bugs in replay - Put common logic for test and replay commands in a single place. 0.001004 2017-08-31 21:02:34-07:00 America/Los_Angeles - Make test.pl ok with preload - Fix Formatter::Test2 for non-tty output - Add -T for timing data per-test - Better signal handling - More HARNESS- header options: - HARNESS-NO-TIMEOUT - Delete job dirs when they are done unless -k is used 0.001003 2017-08-30 23:18:54-07:00 America/Los_Angeles (TRIAL RELEASE) - Set env vars in the run-runner for preload - Improve preload support - Fix formatter selection in Open3 runner - Update deps 0.001002 2017-08-29 21:10:17-07:00 America/Los_Angeles - Allow preload of Test::Builder 0.001001 2017-08-28 22:40:20-07:00 America/Los_Angeles (TRIAL RELEASE) - Complete rewrite 0.000013 2017-01-03 21:18:19-08:00 America/Los_Angeles - Add event timeout option - Fix filename rendering when a test is done - Fixed handling of a "plan skip_all" issued in the main test (as opposed to a subtest). Partially fixes GitHub #21, reported by rjbs. - When a test file doesn't run any tests but exits successfully, this was treated as a pass. This is now detected and generates different output indicating that the process did not run any tests. Fixes the rest of GitHub #21, reported by rjbs. 0.000012 2016-12-19 11:46:41-08:00 America/Los_Angeles (TRIAL RELEASE) - Fixed #9, environment now set properly in preload mode - Job listeners now receive the Test2::Harness::Job object as the first argument, rather than just the job id. - Fixed the TAP parser to handle comments with leading whitespace. Previously it would strip all the leading whitespace out, causing both "# foo" and "# foo" to be output the same way. - Add example for using the harness as a preload test file - Document using Test2::Harness as a preload test runner - Rewrote all of the internals so that the harness now handles Test2 events directly, rather than converting them into Test2::Harness::Fact objects. The facts were losing some details of the events, and the event system already exists and is usable with the harness simply by adding some new harness-specific events. Implemented by Dave Rolsky. GitHub #20. 0.000011 2016-06-10 14:11:01-07:00 America/Los_Angeles - Fix rendering todo subtests... 0.000010 2016-06-10 13:39:27-07:00 America/Los_Angeles - More complete todo subtest fix 0.000009 2016-06-10 13:02:11-07:00 America/Los_Angeles - Fix TAP parsing bug when buffered subtests are TODO 0.000008 2016-05-31 07:35:46-07:00 America/Los_Angeles - Lower the IO::Handle version req 0.000007 2016-05-28 16:31:35-07:00 America/Los_Angeles - Try to fix JSON encoding problem 0.000006 2016-05-26 20:28:27-07:00 America/Los_Angeles (TRIAL RELEASE) - Fix Data::Dumper typo >:-| 0.000005 2016-05-26 08:48:12-07:00 America/Los_Angeles (TRIAL RELEASE) - Add missing JSON prototype in Fact.pm - Add diagnostics when fact->to_json fails 0.000004 2016-05-26 08:35:04-07:00 America/Los_Angeles - Handle -I better in the runner - Make IO::Pty tests AUTHOR_TESTING only. - Add IO::Pty to diagnostics output - Diagnostics to show which JSON gets used 0.000003 2016-05-25 11:55:51-07:00 America/Los_Angeles - Get path separator from config - Better windows prereq specification - Handle buffered usbtest race condition 0.000002 2016-05-25 09:22:22-07:00 America/Los_Angeles - Die if given unknown command line flags. Patch by Dave Rolsky. GitHub #1. - Added -l (--lib) and -b (--blib) flags that work just like prove. Patch by Dave Rolsky. GitHub #2. - Better prereq list - Diagnostic test output - Old version and cross platform support 0.000001 2016-05-24 17:04:13-07:00 America/Los_Angeles - Initial Release MANIFEST100644001750001750 3164515267772575 16162 0ustar00exodistexodist000000000000Test2-Harness-1.000182# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.039 .yath.rc AI_AND_LLM_POLICY.md Changes LICENSE MANIFEST META.json META.yml Makefile.PL README README.md appveyor.yml cpanfile dist.ini lib/App/Yath.pm lib/App/Yath/Command.pm lib/App/Yath/Command/abort.pm lib/App/Yath/Command/auditor.pm lib/App/Yath/Command/collector.pm lib/App/Yath/Command/do.pm lib/App/Yath/Command/failed.pm lib/App/Yath/Command/help.pm lib/App/Yath/Command/init.pm lib/App/Yath/Command/kill.pm lib/App/Yath/Command/projects.pm lib/App/Yath/Command/ps.pm lib/App/Yath/Command/reload.pm lib/App/Yath/Command/replay.pm lib/App/Yath/Command/resources.pm lib/App/Yath/Command/run.pm lib/App/Yath/Command/runner.pm lib/App/Yath/Command/spawn.pm lib/App/Yath/Command/speedtag.pm lib/App/Yath/Command/start.pm lib/App/Yath/Command/status.pm lib/App/Yath/Command/stop.pm lib/App/Yath/Command/test.pm lib/App/Yath/Command/times.pm lib/App/Yath/Command/watch.pm lib/App/Yath/Command/which.pm lib/App/Yath/Converting.pm lib/App/Yath/Option.pm lib/App/Yath/Options.pm lib/App/Yath/Options/Collector.pm lib/App/Yath/Options/Debug.pm lib/App/Yath/Options/Display.pm lib/App/Yath/Options/Finder.pm lib/App/Yath/Options/Logging.pm lib/App/Yath/Options/Persist.pm lib/App/Yath/Options/PreCommand.pm lib/App/Yath/Options/Run.pm lib/App/Yath/Options/Runner.pm lib/App/Yath/Options/Workspace.pm lib/App/Yath/Plugin.pm lib/App/Yath/Plugin/Cover.pm lib/App/Yath/Plugin/Git.pm lib/App/Yath/Plugin/Notify.pm lib/App/Yath/Plugin/SysInfo.pm lib/App/Yath/Plugin/YathUI.pm lib/App/Yath/Script/V1.pm lib/App/Yath/Tester.pm lib/App/Yath/Util.pm lib/Test2/Formatter/QVF.pm lib/Test2/Formatter/Stream.pm lib/Test2/Formatter/Test2.pm lib/Test2/Formatter/Test2/Composer.pm lib/Test2/Harness.pm lib/Test2/Harness/Auditor.pm lib/Test2/Harness/Auditor/TimeTracker.pm lib/Test2/Harness/Auditor/Watcher.pm lib/Test2/Harness/Collector.pm lib/Test2/Harness/Collector/JobDir.pm lib/Test2/Harness/Collector/TapParser.pm lib/Test2/Harness/Event.pm lib/Test2/Harness/Finder.pm lib/Test2/Harness/IPC.pm lib/Test2/Harness/IPC/Process.pm lib/Test2/Harness/Log.pm lib/Test2/Harness/Log/CoverageAggregator.pm lib/Test2/Harness/Log/CoverageAggregator/ByRun.pm lib/Test2/Harness/Log/CoverageAggregator/ByTest.pm lib/Test2/Harness/Plugin.pm lib/Test2/Harness/Renderer.pm lib/Test2/Harness/Renderer/Formatter.pm lib/Test2/Harness/Run.pm lib/Test2/Harness/Runner.pm lib/Test2/Harness/Runner/Constants.pm lib/Test2/Harness/Runner/DepTracer.pm lib/Test2/Harness/Runner/Job.pm lib/Test2/Harness/Runner/Preload.pm lib/Test2/Harness/Runner/Preload/Stage.pm lib/Test2/Harness/Runner/Preloader.pm lib/Test2/Harness/Runner/Preloader/Stage.pm lib/Test2/Harness/Runner/Reloader.pm lib/Test2/Harness/Runner/Resource.pm lib/Test2/Harness/Runner/Resource/JobCount.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots/Config.pm lib/Test2/Harness/Runner/Resource/SharedJobSlots/State.pm lib/Test2/Harness/Runner/Run.pm lib/Test2/Harness/Runner/Spawn.pm lib/Test2/Harness/Runner/State.pm lib/Test2/Harness/Settings.pm lib/Test2/Harness/Settings/Prefix.pm lib/Test2/Harness/Stall/Capture.pm lib/Test2/Harness/Stall/Detector.pm lib/Test2/Harness/Stall/Report.pm lib/Test2/Harness/Stall/Trace.pm lib/Test2/Harness/TestFile.pm lib/Test2/Harness/Util.pm lib/Test2/Harness/Util/File.pm lib/Test2/Harness/Util/File/JSON.pm lib/Test2/Harness/Util/File/JSONL.pm lib/Test2/Harness/Util/File/Stream.pm lib/Test2/Harness/Util/File/Value.pm lib/Test2/Harness/Util/HashBase.pm lib/Test2/Harness/Util/IPC.pm lib/Test2/Harness/Util/JSON.pm lib/Test2/Harness/Util/Queue.pm lib/Test2/Harness/Util/Term.pm lib/Test2/Harness/Util/UUID.pm lib/Test2/Tools/HarnessTester.pm t/0-load_all.t t/1-pod_name.t t/HashBase.t t/child_exit_282.t t/integration/concurrency.t t/integration/concurrency/a.tx t/integration/concurrency/b.tx t/integration/concurrency/c.tx t/integration/concurrency/d.tx t/integration/concurrency/e.tx t/integration/cover_exclude.t t/integration/cover_exclude/a.tx t/integration/cover_exclude/deps/lib/Dep.pm t/integration/cover_exclude/deps2/Dep2.pm t/integration/cover_exclude/lib/CoverExcludePreload.pm t/integration/cover_exclude/lib/Keep.pm t/integration/cover_exclude/vendor/Vendor.pm t/integration/cover_exclude_out_of_band/a.tx t/integration/cover_exclude_out_of_band/deps/OOBDep.pm t/integration/cover_exclude_out_of_band/lib/CoverExcludePeek.pm t/integration/cover_exclude_out_of_band/lib/OOBKeep.pm t/integration/cover_exclude_out_of_band/lib/OOBRekey.pm t/integration/coverage.t t/integration/coverage/a.tx t/integration/coverage/b.tx t/integration/coverage/c.tx t/integration/coverage/lib/Ax.pm t/integration/coverage/lib/Bx.pm t/integration/coverage/lib/Cx.pm t/integration/coverage/lib/Manager.pm t/integration/coverage/lib/Plugin.pm t/integration/coverage/once.tx t/integration/coverage/open.tx t/integration/coverage/x.tx t/integration/coverage2.t t/integration/coverage3.t t/integration/coverage4.t t/integration/encoding.t t/integration/encoding/no-plugin.tx t/integration/encoding/plugin.tx t/integration/fail_on_resource_skip.t t/integration/fail_on_resource_skip/UnavailableResource.pm t/integration/fail_on_resource_skip/a.tx t/integration/fail_on_resource_skip/b.tx t/integration/failed.t t/integration/failed/fail.tx t/integration/failed/pass.tx t/integration/failure_cases.t t/integration/failure_cases/badplan.tx t/integration/failure_cases/buffered_subtest_abrupt_end.tx t/integration/failure_cases/buffered_subtest_abrupt_end_nested.tx t/integration/failure_cases/dupnums.tx t/integration/failure_cases/exit.tx t/integration/failure_cases/missingnums.tx t/integration/failure_cases/nested_subtest.tx t/integration/failure_cases/nested_subtest_exception.tx t/integration/failure_cases/noplan.tx t/integration/failure_cases/notok.tx t/integration/failure_cases/parse_error.tx t/integration/failure_cases/post_exit_timeout.tx t/integration/failure_cases/subtest.tx t/integration/failure_cases/timeout.tx t/integration/help.t t/integration/inc_hook.t t/integration/inc_hook/ArrayrefHook.pm t/integration/inc_hook/CoderefHook.pm t/integration/inc_hook/FakeHook.pm t/integration/inc_hook/simple.tx t/integration/includes.t t/integration/includes/.yath.rc t/integration/includes/default-i.tx t/integration/includes/default.tx t/integration/includes/dot-last.tx t/integration/includes/not-perl.pl t/integration/includes/not-perl.sh t/integration/includes/order-ibili.tx t/integration/includes/order-ilibi.tx t/integration/init.t t/integration/log_dir.t t/integration/log_dir/foo.tx t/integration/persist.t t/integration/persist/fail.txx t/integration/persist/pass.tx t/integration/plugin.t t/integration/plugin/a.tx t/integration/plugin/b.tx t/integration/plugin/c.tx t/integration/plugin/d.tx t/integration/plugin/lib/App/Yath/Plugin/TestPlugin.pm t/integration/plugin/test.tx t/integration/preload.t t/integration/preload/aaa.tx t/integration/preload/bbb.tx t/integration/preload/ccc.tx t/integration/preload/fast.tx t/integration/preload/lib/AAA.pm t/integration/preload/lib/BBB.pm t/integration/preload/lib/Broken.pm t/integration/preload/lib/CCC.pm t/integration/preload/lib/FAST.pm t/integration/preload/lib/TestBadPreload.pm t/integration/preload/lib/TestPreload.pm t/integration/preload/lib/TestSimplePreload.pm t/integration/preload/no_preload.tx t/integration/preload/preload_test.tx t/integration/preload/retry.tx t/integration/preload/simple_test.tx t/integration/preload/slow.tx t/integration/projects.t t/integration/projects/bar/lib/Bar.pm t/integration/projects/bar/lib/Baz.pm t/integration/projects/bar/lib/Foo.pm t/integration/projects/bar/t/pass.tx t/integration/projects/baz/lib/Bar.pm t/integration/projects/baz/lib/Baz.pm t/integration/projects/baz/lib/Foo.pm t/integration/projects/baz/t/fail.txx t/integration/projects/baz/t/pass.tx t/integration/projects/foo/lib/Bar.pm t/integration/projects/foo/lib/Baz.pm t/integration/projects/foo/lib/Foo.pm t/integration/projects/foo/t/pass.tx t/integration/reload.t t/integration/reload/lib/Preload.pm t/integration/reload/lib/Preload/A.pm t/integration/reload/lib/Preload/B.pm t/integration/reload/lib/Preload/Churn.pm t/integration/reload/lib/Preload/ExceptionA.pm t/integration/reload/lib/Preload/ExceptionB.pm t/integration/reload/lib/Preload/ExporterA.pm t/integration/reload/lib/Preload/ExporterB.pm t/integration/reload/lib/Preload/IncChange.pm t/integration/reload/lib/Preload/WarningA.pm t/integration/reload/lib/Preload/WarningB.pm t/integration/reload/lib/Preload/nonperl1 t/integration/reload/lib/Preload/nonperl2 t/integration/reload_syntax_error.t t/integration/reload_syntax_error.tx t/integration/replay.t t/integration/replay/fail.tx t/integration/replay/pass.tx t/integration/resource.t t/integration/resource/Resource.pm t/integration/resource/a.tx t/integration/resource/b.tx t/integration/resource/c.tx t/integration/resource/d.tx t/integration/resource_timeout.t t/integration/resource_timeout/StalledResource.pm t/integration/resource_timeout/a.tx t/integration/resource_timeout/b.tx t/integration/retry-symlinks/retry.tx t/integration/retry-symlinks/symlink.tl t/integration/retry-timeout/retry.tx t/integration/retry.t t/integration/retry/retry.tx t/integration/scheduler_death.t t/integration/scheduler_death/SchedulerKillerResource.pm t/integration/scheduler_death/a.tx t/integration/scheduler_death/b.tx t/integration/scheduler_death/c.tx t/integration/shares.t t/integration/shares/exclusive.tx t/integration/shares/shared_a.tx t/integration/shares/shared_b.tx t/integration/signals.t t/integration/signals/abrt_or_iot.t t/integration/slots_per_job.t t/integration/slots_per_job2.t t/integration/slots_per_job3.t t/integration/smoke.t t/integration/smoke/a.tx t/integration/smoke/b.tx t/integration/smoke/c.tx t/integration/smoke/d.tx t/integration/smoke/e.tx t/integration/smoke/f.tx t/integration/smoke/g.tx t/integration/smoke/h.tx t/integration/smoke/lib/SmokePlugin.pm t/integration/speedtag.t t/integration/speedtag/pass.tx t/integration/speedtag/pass2.tx t/integration/stall_report.t t/integration/stall_report/BlockingResource.pm t/integration/stall_report/a.tx t/integration/stall_report/b.tx t/integration/stall_report/c.tx t/integration/stamps.t t/integration/stamps/fail.tx t/integration/stamps/lib/App/Yath/Plugin/TestPlugin.pm t/integration/stamps/pass.tx t/integration/tapsubtest.t t/integration/tapsubtest/test.tx t/integration/test-broken-symlinks/keepme t/integration/test-broken-symlinks/pass.tx t/integration/test-durations.json t/integration/test-durations/fast-01.tx t/integration/test-durations/fast-02.tx t/integration/test-durations/fast-03.tx t/integration/test-durations/fast-04.tx t/integration/test-durations/slow-01.tx t/integration/test-durations/slow-02.tx t/integration/test-inc/check-INC.tx t/integration/test-symlinks/_base.xt t/integration/test-symlinks/symlink_to_base.xt t/integration/test-w.t t/integration/test-w/a.tx t/integration/test-w/b.tx t/integration/test.t t/integration/test/fail.txx t/integration/test/pass.tx t/integration/test/pass.txxx t/integration/times.t t/integration/times/pass.tx t/integration/times/pass2.tx t/integration/verbose_env.t t/integration/verbose_env/not_verbose.tx t/integration/verbose_env/verbose1.tx t/integration/verbose_env/verbose2.tx t/lib/App/Yath/Command/broken.pm t/lib/App/Yath/Command/fake.pm t/lib/App/Yath/Plugin/Fail.pm t/lib/App/Yath/Plugin/Options.pm t/lib/TestBarrier.pm t/unit/App/Yath.t t/unit/App/Yath/Command/init.t t/unit/App/Yath/Command/test.t t/unit/App/Yath/Option.t t/unit/App/Yath/Options.t t/unit/App/Yath/Options/Runner.t t/unit/App/Yath/Plugin.t t/unit/App/Yath/Plugin/Git.script t/unit/App/Yath/Plugin/Git.t t/unit/App/Yath/Plugin/SysInfo.t t/unit/App/Yath/Util.t t/unit/Test2/Harness/Auditor/Watcher.t t/unit/Test2/Harness/Collector.t t/unit/Test2/Harness/Runner/DepTracer.t t/unit/Test2/Harness/Runner/Job.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/.sharedjobslots.yml t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/Config.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/State.t t/unit/Test2/Harness/Runner/State.t t/unit/Test2/Harness/Settings.t t/unit/Test2/Harness/Settings/Prefix.t t/unit/Test2/Harness/Stall/Capture.t t/unit/Test2/Harness/Stall/Detector.t t/unit/Test2/Harness/TestFile.t t/unit/Test2/Harness/Util.t t/unit/Test2/Harness/Util/File.t t/unit/Test2/Harness/Util/File/JSON.t t/unit/Test2/Harness/Util/File/JSONL.t t/unit/Test2/Harness/Util/File/Stream.t t/unit/Test2/Harness/Util/File/Value.t t/unit/Test2/Harness/Util/JSON.t t/unit/Test2/Harness/Util/Term.t t/unit/Test2/Tools/HarnessTester.t t/yath_script.t t/yath_script/.yath.rc t/yath_script/nested/.yath.user.rc t/yath_script/nested/scripts/yath t2/builder.t t2/caller.t t2/data.t t2/dollardot.t t2/ending.t t2/exception.t t2/findbin.t t2/ipc_reexec.t t2/lib/App/Yath/Plugin/SelfTest.pm t2/magic_vars.t t2/no_stdout_eol.t t2/non_perl/test.c t2/non_perl/test.sh t2/output.t t2/relative_paths.t t2/relative_paths_no_fork.t t2/require_file.pm t2/require_file.t t2/simple.t t2/subtests.t t2/subtests_buffered.t t2/subtests_streamed.t t2/tmp_perms.t t2/utf8-2.t t2/utf8.t t2/vars.t test.pl xt/author/pod-spell.t xt/author/pod-syntax.t .yath.rc100644001750001750 14715267772575 16333 0ustar00exodistexodist000000000000Test2-Harness-1.000182-D -D=rel(t2/lib) ;-pSelfTest --project Test2-Harness [test] -Irel(t2/lib) --default-search glob(t/*) dist.ini100644001750001750 1326715267772575 16475 0ustar00exodistexodist000000000000Test2-Harness-1.000182name = Test2-Harness author = Chad Granum license = Perl_5 copyright_holder = Chad Granum [RewriteVersion] ; sets dist version from main module's $VERSION [License] [ManifestSkip] [Manifest] [NextRelease] [GatherFile] filename = .yath.rc ; Gathered by name: the .md exclusion below would otherwise drop it. filename = AI_AND_LLM_POLICY.md [GatherDir] exclude_match = ^xt/downstream ; only run these tests locally exclude_match = ^pt ; only run these tests locally exclude_match = ^tt ; only run these tests locally exclude_match = ^release-scripts exclude_match = ^cover exclude_match = ^nyt exclude_match = ^test-logs exclude_match = ^t/ exclude_match = ^t2/ exclude_match = ^old/ exclude_match = ^agent_scripts/ ; dev-only tooling exclude_match = ^AI_DOCS/ ; dev-only notes exclude_match = ^worktrees ; agent working state exclude_match = \.md$ ; internal docs never ship exclude_filename = LICENSE exclude_filename = Makefile.PL exclude_filename = cpanfile exclude_filename = cpanfile.ci exclude_filename = README exclude_filename = README.md exclude_filename = TEMPLATE.pod exclude_filename = .yath-persist.json [PruneCruft] ; PruneCruft drops every root dotfile, which would undo the [GatherFile] above. except = ^\.yath\.rc$ [Git::GatherDir / GatherDotFilesT] root = t/ prefix = t/ include_dotfiles = 1 [Git::GatherDir / GatherDotFilesT2] root = t2/ prefix = t2/ include_dotfiles = 1 [Run::AfterBuild] run = release-scripts/generate_command_pod.pl %d run = release-scripts/generate_options_pod.pl %d [PodSyntaxTests] [TestRelease] [RunExtraTests] [MetaResources] bugtracker.web = https://github.com/Test-More/Test2-Harness/issues repository.url = https://github.com/Test-More/Test2-Harness/ repository.type = git [Prereqs] perl = 5.010000 Test2 = 1.302170 Test2::API = 1.302170 Test2::Event = 1.302170 Test2::Event::V2 = 1.302170 Test2::Formatter = 1.302170 Test2::Util = 1.302170 Test::Builder = 1.302170 Test::Builder::Formatter = 1.302170 Test::More = 1.302170 Test2::Tools::AsyncSubtest = 0.000127 Test2::Tools::Subtest = 0.000127 Test2::Util::Term = 0.000127 Test2::V0 = 0.000127 Test2::Bundle::Extended = 0.000127 Test2::Plugin::MemUsage = 0.002003 Test2::Plugin::UUID = 0.002001 Long::Jump = 0.000001 Term::Table = 0.015 Importer = 0.025 goto::file = 0.005 File::Path = 2.11 List::Util = 1.44 IO::Handle = 1.27 YAML::Tiny = 0 Data::UUID = 0 File::Find = 0 Carp = 0 Config = 0 Cwd = 0 Data::Dumper = 0 Exporter = 0 Fcntl = 0 File::Spec = 0 File::Temp = 0 Filter::Util::Call = 0 IO::Compress::Bzip2 = 0 IO::Compress::Gzip = 0 IO::Uncompress::Bunzip2 = 0 IO::Uncompress::Gunzip = 0 IPC::Cmd = 0 JSON::PP = 0 MIME::Base64 = 0 POSIX = 0 Scalar::Util = 0 Symbol = 0 Time::HiRes = 0 base = 0 constant = 0 parent = 0 Sys::Hostname = 0 Scope::Guard = 0 Text::ParseWords = 0 App::Yath::Script = 2.000017 [Prereqs / TestRequires] File::Copy = 0 [Prereqs / DevelopRequires] Test::Spelling = 0.12 ; for xt/author/pod-spell.t Test2::Require::Module = 0.000127 [Prereqs / RuntimeSuggests] JSON::MaybeXS = 0 Cpanel::JSON::XS = 0 Term::ANSIColor = 4.03 Email::Stuffer = 0.016 HTTP::Tiny = 0.070 IO::Pager = 1.00 Test2::Plugin::IOEvents = 0.001001 HTTP::Tiny::Multipart = 0.08 Test2::Plugin::DBIProfile = 0.002002 Test2::Plugin::Cover = 0.000030 Win32::Console::ANSI = 0 [MakeMaker::Awesome] :version = 0.26 delimiter = | header = |use Config qw/%Config/; header = |die "OS unsupported\nTest2-Harness currently only works on systems that support true forking.\n" header = | unless $Config{d_fork}; header = |if ($ENV{AUTOMATED_TESTING}) { header = | my $is_njh = 0; header = | $is_njh ||= -d '/export/home/njh'; header = | $is_njh ||= -d '/home/njh'; header = | $is_njh ||= lc($ENV{USER} // 'na') eq 'njh'; header = | $is_njh ||= lc($ENV{HOME} // 'na') =~ m{njh$}; header = | $is_njh ||= lc($ENV{PATH} // 'na') =~ m{/njh/}; header = | die "OS unsupported\nNJH smokers are broken, aborting tests.\n" header = | if $is_njh; header = |} [CPANFile] [MetaYAML] [MetaJSON] ; authordep Pod::Markdown [ReadmeFromPod / Markdown] filename = lib/App/Yath.pm type = markdown readme = README.md [ReadmeFromPod / Text] filename = lib/App/Yath.pm type = text readme = README [CopyFilesFromBuild] copy = LICENSE copy = cpanfile copy = README copy = README.md copy = Makefile.PL [Git::Check] allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE allow_dirty = Changes [Git::Commit] allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE allow_dirty = Changes [Git::Tag] [FakeRelease] [BumpVersionAfterRelease] [Git::Commit / Commit_Changes] munge_makefile_pl = true allow_dirty_match = ^lib allow_dirty_match = ^scripts allow_dirty = Makefile.PL allow_dirty = README allow_dirty = README.md allow_dirty = cpanfile allow_dirty = LICENSE commit_msg = Automated Version Bump cpanfile100644001750001750 527715267772575 16517 0ustar00exodistexodist000000000000Test2-Harness-1.000182# This file is generated by Dist::Zilla::Plugin::CPANFile v6.039 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "App::Yath::Script" => "2.000017"; requires "Carp" => "0"; requires "Config" => "0"; requires "Cwd" => "0"; requires "Data::Dumper" => "0"; requires "Data::UUID" => "0"; requires "Exporter" => "0"; requires "Fcntl" => "0"; requires "File::Find" => "0"; requires "File::Path" => "2.11"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "Filter::Util::Call" => "0"; requires "IO::Compress::Bzip2" => "0"; requires "IO::Compress::Gzip" => "0"; requires "IO::Handle" => "1.27"; requires "IO::Uncompress::Bunzip2" => "0"; requires "IO::Uncompress::Gunzip" => "0"; requires "IPC::Cmd" => "0"; requires "Importer" => "0.025"; requires "JSON::PP" => "0"; requires "List::Util" => "1.44"; requires "Long::Jump" => "0.000001"; requires "MIME::Base64" => "0"; requires "POSIX" => "0"; requires "Scalar::Util" => "0"; requires "Scope::Guard" => "0"; requires "Symbol" => "0"; requires "Sys::Hostname" => "0"; requires "Term::Table" => "0.015"; requires "Test2" => "1.302170"; requires "Test2::API" => "1.302170"; requires "Test2::Bundle::Extended" => "0.000127"; requires "Test2::Event" => "1.302170"; requires "Test2::Event::V2" => "1.302170"; requires "Test2::Formatter" => "1.302170"; requires "Test2::Plugin::MemUsage" => "0.002003"; requires "Test2::Plugin::UUID" => "0.002001"; requires "Test2::Tools::AsyncSubtest" => "0.000127"; requires "Test2::Tools::Subtest" => "0.000127"; requires "Test2::Util" => "1.302170"; requires "Test2::Util::Term" => "0.000127"; requires "Test2::V0" => "0.000127"; requires "Test::Builder" => "1.302170"; requires "Test::Builder::Formatter" => "1.302170"; requires "Test::More" => "1.302170"; requires "Text::ParseWords" => "0"; requires "Time::HiRes" => "0"; requires "YAML::Tiny" => "0"; requires "base" => "0"; requires "constant" => "0"; requires "goto::file" => "0.005"; requires "parent" => "0"; requires "perl" => "5.010000"; suggests "Cpanel::JSON::XS" => "0"; suggests "Email::Stuffer" => "0.016"; suggests "HTTP::Tiny" => "0.070"; suggests "HTTP::Tiny::Multipart" => "0.08"; suggests "IO::Pager" => "1.00"; suggests "JSON::MaybeXS" => "0"; suggests "Term::ANSIColor" => "4.03"; suggests "Test2::Plugin::Cover" => "0.000030"; suggests "Test2::Plugin::DBIProfile" => "0.002002"; suggests "Test2::Plugin::IOEvents" => "0.001001"; suggests "Win32::Console::ANSI" => "0"; on 'test' => sub { requires "File::Copy" => "0"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Test2::Require::Module" => "0.000127"; requires "Test::Pod" => "1.41"; requires "Test::Spelling" => "0.12"; }; META.yml100644001750001750 366615267772575 16264 0ustar00exodistexodist000000000000Test2-Harness-1.000182--- abstract: 'A new and improved test harness with better Test2 integration.' author: - 'Chad Granum ' build_requires: File::Copy: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.039, CPAN::Meta::Converter version 2.150013' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test2-Harness requires: App::Yath::Script: '2.000017' Carp: '0' Config: '0' Cwd: '0' Data::Dumper: '0' Data::UUID: '0' Exporter: '0' Fcntl: '0' File::Find: '0' File::Path: '2.11' File::Spec: '0' File::Temp: '0' Filter::Util::Call: '0' IO::Compress::Bzip2: '0' IO::Compress::Gzip: '0' IO::Handle: '1.27' IO::Uncompress::Bunzip2: '0' IO::Uncompress::Gunzip: '0' IPC::Cmd: '0' Importer: '0.025' JSON::PP: '0' List::Util: '1.44' Long::Jump: '0.000001' MIME::Base64: '0' POSIX: '0' Scalar::Util: '0' Scope::Guard: '0' Symbol: '0' Sys::Hostname: '0' Term::Table: '0.015' Test2: '1.302170' Test2::API: '1.302170' Test2::Bundle::Extended: '0.000127' Test2::Event: '1.302170' Test2::Event::V2: '1.302170' Test2::Formatter: '1.302170' Test2::Plugin::MemUsage: '0.002003' Test2::Plugin::UUID: '0.002001' Test2::Tools::AsyncSubtest: '0.000127' Test2::Tools::Subtest: '0.000127' Test2::Util: '1.302170' Test2::Util::Term: '0.000127' Test2::V0: '0.000127' Test::Builder: '1.302170' Test::Builder::Formatter: '1.302170' Test::More: '1.302170' Text::ParseWords: '0' Time::HiRes: '0' YAML::Tiny: '0' base: '0' constant: '0' goto::file: '0.005' parent: '0' perl: '5.010000' resources: bugtracker: https://github.com/Test-More/Test2-Harness/issues repository: https://github.com/Test-More/Test2-Harness/ version: '1.000182' x_generated_by_perl: v5.44.0 x_serialization_backend: 'YAML::Tiny version 1.76' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' t2000755001750001750 015267772575 15165 5ustar00exodistexodist000000000000Test2-Harness-1.000182data.t100644001750001750 23315267772575 16401 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; # HARNESS-DURATION-SHORT is( [], ["foo\n", "bar\n", "baz\n"], "Got data section" ); done_testing; __DATA__ foo bar baz utf8.t100644001750001750 127415267772575 16404 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use utf8; use Test2::V0; use Test2::Plugin::UTF8; use Test2::API qw/test2_stack/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/get_tid ipc_separator/; # HARNESS-DURATION-SHORT test2_stack()->top; my ($hub) = test2_stack()->all(); my $fmt = $hub->format; skip_all "This test requires the stream formatter" unless $fmt && $fmt->isa('Test2::Formatter::Stream'); ok(1, "І ще трохи"); my $file = File::Spec->catfile($fmt->dir, join(ipc_separator() => 'events', $$, 0) . ".jsonl"); open(my $fh, '<:utf8', $file) or die "Could not open events file: $!"; my @lines = <$fh>; like($lines[-1], qr/\QІ ще трохи\E/, "Wrote utf8, not double encoded"); done_testing; vars.t100644001750001750 42015267772575 16441 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; ok(defined($ENV{$_}), "env var $_ is set") for qw{ HARNESS_ACTIVE TEST2_HARNESS_ACTIVE TEST2_ACTIVE TEST_ACTIVE TEST2_RUN_DIR TEST2_JOB_DIR T2_HARNESS_JOB_IS_TRY T2_HARNESS_JOB_NAME T2_HARNESS_JOB_FILE }; done_testing; META.json100644001750001750 744715267772575 16435 0ustar00exodistexodist000000000000Test2-Harness-1.000182{ "abstract" : "A new and improved test harness with better Test2 integration.", "author" : [ "Chad Granum " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.039, CPAN::Meta::Converter version 2.150013", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test2-Harness", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test2::Require::Module" : "0.000127", "Test::Pod" : "1.41", "Test::Spelling" : "0.12" } }, "runtime" : { "requires" : { "App::Yath::Script" : "2.000017", "Carp" : "0", "Config" : "0", "Cwd" : "0", "Data::Dumper" : "0", "Data::UUID" : "0", "Exporter" : "0", "Fcntl" : "0", "File::Find" : "0", "File::Path" : "2.11", "File::Spec" : "0", "File::Temp" : "0", "Filter::Util::Call" : "0", "IO::Compress::Bzip2" : "0", "IO::Compress::Gzip" : "0", "IO::Handle" : "1.27", "IO::Uncompress::Bunzip2" : "0", "IO::Uncompress::Gunzip" : "0", "IPC::Cmd" : "0", "Importer" : "0.025", "JSON::PP" : "0", "List::Util" : "1.44", "Long::Jump" : "0.000001", "MIME::Base64" : "0", "POSIX" : "0", "Scalar::Util" : "0", "Scope::Guard" : "0", "Symbol" : "0", "Sys::Hostname" : "0", "Term::Table" : "0.015", "Test2" : "1.302170", "Test2::API" : "1.302170", "Test2::Bundle::Extended" : "0.000127", "Test2::Event" : "1.302170", "Test2::Event::V2" : "1.302170", "Test2::Formatter" : "1.302170", "Test2::Plugin::MemUsage" : "0.002003", "Test2::Plugin::UUID" : "0.002001", "Test2::Tools::AsyncSubtest" : "0.000127", "Test2::Tools::Subtest" : "0.000127", "Test2::Util" : "1.302170", "Test2::Util::Term" : "0.000127", "Test2::V0" : "0.000127", "Test::Builder" : "1.302170", "Test::Builder::Formatter" : "1.302170", "Test::More" : "1.302170", "Text::ParseWords" : "0", "Time::HiRes" : "0", "YAML::Tiny" : "0", "base" : "0", "constant" : "0", "goto::file" : "0.005", "parent" : "0", "perl" : "5.010000" }, "suggests" : { "Cpanel::JSON::XS" : "0", "Email::Stuffer" : "0.016", "HTTP::Tiny" : "0.070", "HTTP::Tiny::Multipart" : "0.08", "IO::Pager" : "1.00", "JSON::MaybeXS" : "0", "Term::ANSIColor" : "4.03", "Test2::Plugin::Cover" : "0.000030", "Test2::Plugin::DBIProfile" : "0.002002", "Test2::Plugin::IOEvents" : "0.001001", "Win32::Console::ANSI" : "0" } }, "test" : { "requires" : { "File::Copy" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Test-More/Test2-Harness/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/Test-More/Test2-Harness/" } }, "version" : "1.000182", "x_generated_by_perl" : "v5.44.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.52", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } README.md100644001750001750 4362215267772575 16306 0ustar00exodistexodist000000000000Test2-Harness-1.000182# NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) # DESCRIPTION This is the primary documentation for `yath`, [App::Yath](https://metacpan.org/pod/App%3A%3AYath), [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness). The canonical source of up-to-date command options are the help output when using `$ yath help` and `$ yath help COMMAND`. This document is mainly an overview of `yath` usage and common recipes. [App::Yath](https://metacpan.org/pod/App%3A%3AYath) is an alternative to [App::Prove](https://metacpan.org/pod/App%3A%3AProve), and [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is an alternative to [Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness). It is not designed to replace [Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness)/prove. [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is designed to take full advantage of the rich data [Test2](https://metacpan.org/pod/Test2) can provide. [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness) is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. # PLATFORM SUPPORT [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness)/[App::Yath](https://metacpan.org/pod/App%3A%3AYath) is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. ## WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. # OVERVIEW To use [Test2::Harness](https://metacpan.org/pod/Test2%3A%3AHarness), you use the `yath` command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. `yath` can be thought of as a more powerful alternative to `prove` ([Test::Harness](https://metacpan.org/pod/Test%3A%3AHarness)) # RECIPES These are common recipes for using `yath`. ## RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in `./t`, `./t2`, and `./test.pl` and run any which are found. Normally this implies the `test` command but will instead imply the `run` command if a persistent test runner is detected. ## PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the `# HARNESS-NO-PRELOAD` directive to the top of the test files that cannot use preload. ### SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util ### COMPLEX PRELOAD If your preload is a subclass of [Test2::Harness::Runner::Preload](https://metacpan.org/pod/Test2%3A%3AHarness%3A%3ARunner%3A%3APreload) then more complex preload behavior is possible. See those docs for more info. ## LOGGING ### RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz `-B` and `-G` both imply `-L`. ### REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the `$ yath replay ...` command. The `replay` command is implied if the first argument is a log file. ## PER-TEST TIMING DATA The `-T` option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s ## PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. ### STARTING This starts the server. Many options available to the 'test' command will work here but not all. See `$ yath help start` for more info. $ yath start ### RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the `test` command will work for this as well. See `$ yath help run` for more details. $ yath run ### STOPPING Stopping a persistent runner is easy. $ yath stop ### INFORMATIONAL The `which` command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The `watch` command will tail the runner's log files. $ yath watch ### PRELOAD + PERSISTENT RUNNER You can use preloads with the `yath start` command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. ## MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create `test.pl`. `test.pl` is automatically run by most build utils, in which case only the exit value matters. The generated `test.pl` will run `yath` and execute all tests in the `./t` and/or `./t2` directories. Tests in `./t` will ALSO be run by prove but tests in `./t2` will only be run by yath. ## PROJECT-SPECIFIC YATH CONFIG You can write a `.yath.rc` file. The file format is very simple. Create a `[COMMAND]` section to start the configuration for a command and then provide any options normally allowed by it. When `yath` is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. **Note:** You can also add pre-command options by placing them at the top of your config file _BEFORE_ any `[cmd]` markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. ### SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! - rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to `.yath.rc` and prefix it to the path inside `rel(...)`. If for example you have `/project/.yath.rc` then the path would become `/project/path/to/extra_lib`. - glob(path/\*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a `--default-search $_` for every item found in the glob. This uses the perl builtin function `glob()` under the hood. - relglob(path/\*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as `glob()` except paths are relative to the `.yath.rc` file. ## PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a `.yath.user.rc` file. Format is the same as the regular `.yath.rc` file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. ## HARNESS DIRECTIVES INSIDE TESTS `yath` will recognise a number of directive comments placed near the top of test files. These directives should be placed after the `#!` line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # - good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... - good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... - bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... - bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... ### HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. ### HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. ### HARNESS-NO-STREAM `yath` usually uses the [Test2::Formatter::Stream](https://metacpan.org/pod/Test2%3A%3AFormatter%3A%3AStream) formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make `yath` use [Test2::Formatter::TAP](https://metacpan.org/pod/Test2%3A%3AFormatter%3A%3ATAP) or [Test::Builder::Formatter](https://metacpan.org/pod/Test%3A%3ABuilder%3A%3AFormatter). ### HARNESS-NO-IO-EVENTS `yath` can be configured to use the [Test2::Plugin::IOEvents](https://metacpan.org/pod/Test2%3A%3APlugin%3A%3AIOEvents) plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper [Test2::Event](https://metacpan.org/pod/Test2%3A%3AEvent)'s when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. **Note:** This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. ### HARNESS-NO-TIMEOUT `yath` will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: `HARNESS-TIMEOUT-EVENT`. ### HARNESS-TIMEOUT-EVENT 60 `yath` can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT ### HARNESS-TIMEOUT-POSTEXIT 15 `yath` can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into ### HARNESS-DURATION-LONG This lets you tell `yath` that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a `yath` option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. ### HARNESS-DURATION-MEDIUM This lets you tell `yath` that the test is medium. This is the default duration. ### HARNESS-DURATION-SHORT This lets you tell `yath` That the test is short. ### HARNESS-CATEGORY-ISOLATION This lets you tell `yath` that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. ### HARNESS-CATEGORY-IMMISCIBLE This lets you tell `yath` that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. ### HARNESS-CATEGORY-GENERAL This is the default category. ### HARNESS-CONFLICTS-XXX This lets you tell `yath` that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and `yath` will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. - Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... - Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... ### HARNESS-SHARES-XXX This lets you tell `yath` that this test uses XXX, but is happy to share it with other tests that merely use it too. Any number of `HARNESS-SHARES-XXX` tests may run at the same time, but none of them will run at the same time as a `HARNESS-CONFLICTS-XXX` test. If you think of the two directives as a lock on the name XXX, `CONFLICTS` takes it exclusively and `SHARES` takes it shared. XXX can be replaced with any type of your choosing, and you may set several of them. The usual shape for this is one test that disturbs a resource and many that merely read it: mark the disruptive one `HARNESS-CONFLICTS-XXX` and the rest `HARNESS-SHARES-XXX`, and the readers keep their parallelism instead of being serialized alongside the writer. NOTE: An exclusive test has to wait for every shared test holding the name to finish, and `yath` will not hold job slots empty to make room for it. If shared tests keep becoming available the exclusive one may run quite late in the run, possibly last and by itself. This is still better than marking every test `CONFLICTS`, but it is worth knowing before you mark hundreds of tests as sharing one name. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. ### HARNESS-JOB-SLOTS 2 ### HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. ### HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. ### HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. # MODULE DOCS This section documents the [App::Yath](https://metacpan.org/pod/App%3A%3AYath) module itself. ## SYNOPSIS In practice you should never need to write your own yath script, or construct an [App::Yath](https://metacpan.org/pod/App%3A%3AYath) instance, or even access the main instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [grep { !ref($_) } @INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that [goto::file](https://metacpan.org/pod/goto%3A%3Afile) can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: - pre-process essential arguments such as -D and no-scan-plugins - re-exec with a different yath script if in developer mode and a local copy is found - Parse the yath-rc config files - gather and store essential startup information ## METHODS App::Yath does not provide many methods to use externally. - $app->generate\_run\_sub($symbol\_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. - $lib\_path = $app->app\_path() Get the include directory App::Yath was loaded from. # SOURCE The source code repository for Test2-Harness can be found at `http://github.com/Test-More/Test2-Harness/`. # MAINTAINERS - Chad Granum # AUTHORS - Chad Granum # COPYRIGHT Copyright 2020 Chad Granum . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See `http://dev.perl.org/licenses/` caller.t100644001750001750 54115267772575 16734 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2package FooBarBaz; use strict; use warnings; # HARNESS-DURATION-SHORT use Test2::V0; is([caller(0)], [], "No caller at the flat test level"); is(__PACKAGE__, 'FooBarBaz', "inside main package"); like(__FILE__, qr/caller\.t$/, "__FILE__ is correct"); is(__LINE__, 11, "Got the correct line number"); is($@, '', '$@ set to empty string'); done_testing;ending.t100644001750001750 44215267772575 16736 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2# HARNESS-DURATION-SHORT package FooBarBaz; use strict; use warnings; use Test2::V0; open(my $fh, '<', __FILE__) or die "Could not open this file!: $!"; my @end = <$fh>; close($fh); is($end[-1], 'done_testing', "no semicolon or newline is present at the end of this file"); done_testingoutput.t100644001750001750 62615267772575 17036 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; # HARNESS-DURATION-SHORT use Test2::Require::AuthorTesting; # All these prints intentionally have no newlines print STDERR "STDERR Before any events"; print STDOUT "STDOUT Before any events"; ok(1, "pass"); print STDERR "STDERR Between events"; print STDOUT "STDOUT Between events"; ok(1, "pass"); print STDERR "STDERR after events"; print STDOUT "STDOUT after events"; done_testing; simple.t100644001750001750 13115267772575 16756 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2#!/usr/bin/perl -w # HARNESS-DURATION-SHORT use Test2::V0; ok(1, "pass"); done_testing; utf8-2.t100644001750001750 244715267772575 16546 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use utf8; use strict; use warnings; use Test::More; use Test2::Plugin::UTF8; use Test2::API qw/test2_stack/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Tools::Basic qw/skip_all/; use File::Spec; use Test2::Util qw/get_tid ipc_separator/; # HARNESS-DURATION-SHORT # HARNESS-NO-IO-EVENTS test2_stack()->top; my ($hub) = test2_stack()->all(); my $fmt = $hub->format; skip_all "This test requires the stream formatter" unless $fmt && $fmt->isa('Test2::Formatter::Stream'); print STDOUT "STDOUT: Mākaha\n"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); my $file = File::Spec->catfile($fmt->dir, join(ipc_separator() => 'events', $$, 0) . ".jsonl"); open(my $events_fh, '<:utf8', $file) or die "Could not open events file: $!"; open(my $stdout_fh, '<:utf8', File::Spec->catfile($ENV{TEST2_JOB_DIR}, 'stdout')) or die "Could not open STDOUT for reading: $!"; my @events = map { decode_json($_) } grep m/(NOTE|DIAG|ASSERT): /, <$events_fh>; my ($stdout) = grep m/STDOUT: /, <$stdout_fh>; is($stdout, "STDOUT: Mākaha\n", "Round trip STDOUT encoding/decoding"); is($events[0]->{facet_data}->{info}->[0]->{details}, "NOTE: Mākaha", "Round trip encoding/decoding a note"); is($events[1]->{facet_data}->{assert}->{details}, "ASSERT: Mākaha", "Round trip encoding/decoding an assert"); done_testing; Makefile.PL100644001750001750 1167715267772575 17006 0ustar00exodistexodist000000000000Test2-Harness-1.000182# This Makefile.PL for Test2-Harness was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.49. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use 5.010000; use ExtUtils::MakeMaker; use Config qw/%Config/; die "OS unsupported\nTest2-Harness currently only works on systems that support true forking.\n" unless $Config{d_fork}; if ($ENV{AUTOMATED_TESTING}) { my $is_njh = 0; $is_njh ||= -d '/export/home/njh'; $is_njh ||= -d '/home/njh'; $is_njh ||= lc($ENV{USER} // 'na') eq 'njh'; $is_njh ||= lc($ENV{HOME} // 'na') =~ m{njh$}; $is_njh ||= lc($ENV{PATH} // 'na') =~ m{/njh/}; die "OS unsupported\nNJH smokers are broken, aborting tests.\n" if $is_njh; } my %WriteMakefileArgs = ( "ABSTRACT" => "A new and improved test harness with better Test2 integration.", "AUTHOR" => "Chad Granum ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Test2-Harness", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.010000", "NAME" => "Test2::Harness", "PREREQ_PM" => { "App::Yath::Script" => "2.000017", "Carp" => 0, "Config" => 0, "Cwd" => 0, "Data::Dumper" => 0, "Data::UUID" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Find" => 0, "File::Path" => "2.11", "File::Spec" => 0, "File::Temp" => 0, "Filter::Util::Call" => 0, "IO::Compress::Bzip2" => 0, "IO::Compress::Gzip" => 0, "IO::Handle" => "1.27", "IO::Uncompress::Bunzip2" => 0, "IO::Uncompress::Gunzip" => 0, "IPC::Cmd" => 0, "Importer" => "0.025", "JSON::PP" => 0, "List::Util" => "1.44", "Long::Jump" => "0.000001", "MIME::Base64" => 0, "POSIX" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Symbol" => 0, "Sys::Hostname" => 0, "Term::Table" => "0.015", "Test2" => "1.302170", "Test2::API" => "1.302170", "Test2::Bundle::Extended" => "0.000127", "Test2::Event" => "1.302170", "Test2::Event::V2" => "1.302170", "Test2::Formatter" => "1.302170", "Test2::Plugin::MemUsage" => "0.002003", "Test2::Plugin::UUID" => "0.002001", "Test2::Tools::AsyncSubtest" => "0.000127", "Test2::Tools::Subtest" => "0.000127", "Test2::Util" => "1.302170", "Test2::Util::Term" => "0.000127", "Test2::V0" => "0.000127", "Test::Builder" => "1.302170", "Test::Builder::Formatter" => "1.302170", "Test::More" => "1.302170", "Text::ParseWords" => 0, "Time::HiRes" => 0, "YAML::Tiny" => 0, "base" => 0, "constant" => 0, "goto::file" => "0.005", "parent" => 0 }, "TEST_REQUIRES" => { "File::Copy" => 0 }, "VERSION" => "1.000182", "test" => { "TESTS" => "t/*.t t/integration/*.t t/integration/signals/*.t t/unit/App/*.t t/unit/App/Yath/*.t t/unit/App/Yath/Command/*.t t/unit/App/Yath/Options/*.t t/unit/App/Yath/Plugin/*.t t/unit/Test2/Harness/*.t t/unit/Test2/Harness/Auditor/*.t t/unit/Test2/Harness/Runner/*.t t/unit/Test2/Harness/Runner/Resource/SharedJobSlots/*.t t/unit/Test2/Harness/Settings/*.t t/unit/Test2/Harness/Stall/*.t t/unit/Test2/Harness/Util/*.t t/unit/Test2/Harness/Util/File/*.t t/unit/Test2/Tools/*.t" } ); my %FallbackPrereqs = ( "App::Yath::Script" => "2.000017", "Carp" => 0, "Config" => 0, "Cwd" => 0, "Data::Dumper" => 0, "Data::UUID" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Copy" => 0, "File::Find" => 0, "File::Path" => "2.11", "File::Spec" => 0, "File::Temp" => 0, "Filter::Util::Call" => 0, "IO::Compress::Bzip2" => 0, "IO::Compress::Gzip" => 0, "IO::Handle" => "1.27", "IO::Uncompress::Bunzip2" => 0, "IO::Uncompress::Gunzip" => 0, "IPC::Cmd" => 0, "Importer" => "0.025", "JSON::PP" => 0, "List::Util" => "1.44", "Long::Jump" => "0.000001", "MIME::Base64" => 0, "POSIX" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Symbol" => 0, "Sys::Hostname" => 0, "Term::Table" => "0.015", "Test2" => "1.302170", "Test2::API" => "1.302170", "Test2::Bundle::Extended" => "0.000127", "Test2::Event" => "1.302170", "Test2::Event::V2" => "1.302170", "Test2::Formatter" => "1.302170", "Test2::Plugin::MemUsage" => "0.002003", "Test2::Plugin::UUID" => "0.002001", "Test2::Tools::AsyncSubtest" => "0.000127", "Test2::Tools::Subtest" => "0.000127", "Test2::Util" => "1.302170", "Test2::Util::Term" => "0.000127", "Test2::V0" => "0.000127", "Test::Builder" => "1.302170", "Test::Builder::Formatter" => "1.302170", "Test::More" => "1.302170", "Text::ParseWords" => 0, "Time::HiRes" => 0, "YAML::Tiny" => 0, "base" => 0, "constant" => 0, "goto::file" => "0.005", "parent" => 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); appveyor.yml100644001750001750 125015267772575 17366 0ustar00exodistexodist000000000000Test2-Harness-1.000182skip_tags: true cache: - C:\strawberry install: - if not exist "C:\strawberry" cinst strawberryperl -y - set PATH=C:\strawberry\perl\bin;C:\strawberry\perl\site\bin;C:\strawberry\c\bin;%PATH% - cd C:\projects\%APPVEYOR_PROJECT_NAME% - cpanm -n Dist::Zilla - dzil authordeps --missing | cpanm -n - dzil listdeps --author --missing | cpanm build_script: - perl -e 2 test_script: - dzil test notifications: - provider: Slack auth_token: secure: 1XmVVszAQyTtMdNkyWup8p7AC9iqXkMl6QMchq3Xu7L7rCzYgjjlS/mas+bfp3ouyjPKnoh01twl4eB0Xs/1Ig== channel: '#general' on_build_success: false on_build_failure: true on_build_status_changed: true t000755001750001750 015267772575 15103 5ustar00exodistexodist000000000000Test2-Harness-1.000182HashBase.t100644001750001750 1376215267772575 17137 0ustar00exodistexodist000000000000Test2-Harness-1.000182/tuse strict; use warnings; use Test::More; sub warnings(&) { my $code = shift; my @warnings; local $SIG{__WARN__} = sub { push @warnings => @_ }; $code->(); return \@warnings; } sub exception(&) { my $code = shift; local ($@, $!, $SIG{__DIE__}); my $ok = eval { $code->(); 1 }; my $error = $@ || 'SQUASHED ERROR'; return $ok ? undef : $error; } BEGIN { $INC{'Object/HashBase/Test/HBase.pm'} = __FILE__; package main::HBase; use Test2::Harness::Util::HashBase qw/foo bar baz/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); } BEGIN { package main::HBaseSub; use base 'main::HBase'; use Test2::Harness::Util::HashBase qw/apple pear/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); main::is(APPLE, 'apple', "APPLE CONSTANT"); main::is(PEAR, 'pear', "PEAR CONSTANT"); } my $one = main::HBase->new(foo => 'a', bar => 'b', baz => 'c'); is($one->foo, 'a', "Accessor"); is($one->bar, 'b', "Accessor"); is($one->baz, 'c', "Accessor"); $one->set_foo('x'); is($one->foo, 'x', "Accessor set"); $one->set_foo(undef); is_deeply( $one, { foo => undef, bar => 'b', baz => 'c', }, 'hash' ); BEGIN { package main::Const::Test; use Test2::Harness::Util::HashBase qw/foo/; sub do_it { if (FOO()) { return 'const'; } return 'not const' } } my $pkg = 'main::Const::Test'; is($pkg->do_it, 'const', "worked as expected"); { local $SIG{__WARN__} = sub { }; *main::Const::Test::FOO = sub { 0 }; } ok(!$pkg->FOO, "overrode const sub"); is($pkg->do_it, 'const', "worked as expected, const was constant"); BEGIN { $INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__; package main::HBase::Wrapped; use Test2::Harness::Util::HashBase qw/foo bar dup/; my $foo = __PACKAGE__->can('foo'); no warnings 'redefine'; *foo = sub { my $self = shift; $self->set_bar(1); $self->$foo(@_); }; } BEGIN { $INC{'Object/HashBase/Test/HBase/Wrapped/Inherit.pm'} = __FILE__; package main::HBase::Wrapped::Inherit; use base 'main::HBase::Wrapped'; use Test2::Harness::Util::HashBase qw/baz dup/; } my $o = main::HBase::Wrapped::Inherit->new(foo => 1); my $foo = $o->foo; is($o->bar, 1, 'parent attribute sub not overridden'); { package Foo; sub new; use Test2::Harness::Util::HashBase qw/foo bar baz/; sub new { 'foo' }; } is(Foo->new, 'foo', "Did not override existing 'new' method"); BEGIN { $INC{'Object/HashBase/Test/HBase2.pm'} = __FILE__; package main::HBase2; use Test2::Harness::Util::HashBase qw/foo -bar ^baz ban +boo/; main::is(FOO, 'foo', "FOO CONSTANT"); main::is(BAR, 'bar', "BAR CONSTANT"); main::is(BAZ, 'baz', "BAZ CONSTANT"); main::is(BAT, 'bat', "BAT CONSTANT"); main::is(BAN, 'ban', "BAN CONSTANT"); main::is(BOO, 'boo', "BOO CONSTANT"); } my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz', bat => 'bat', ban => 'ban'); is($ro->foo, 'foo', "got foo"); is($ro->bar, 'bar', "got bar"); is($ro->baz, 'baz', "got baz"); is($ro->bat, 'bat', "got bat"); ok(!$ro->can('set_bat'), "No setter for bat"); ok(!$ro->can('ban'), "No reader for ban"); ok(!$ro->can('boo'), "No reader for boo"); ok(!$ro->can('set_boo'), "No setter for boo"); is($ro->{ban}, 'ban', "ban attribute is set"); $ro->set_ban('xxx'); is($ro->{ban}, 'xxx', "ban attribute can be set"); is($ro->set_foo('xxx'), 'xxx', "Can set foo"); is($ro->foo, 'xxx', "got foo"); like(exception { $ro->set_bar('xxx') }, qr/'bar' is read-only/, "Cannot set bar"); my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') }; like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning"); is_deeply( [Test2::Harness::Util::HashBase::attr_list('main::HBase::Wrapped::Inherit')], [qw/foo bar dup baz/], "Got a list of attributes in order starting from base class, duplicates removed", ); my $x = main::HBase::Wrapped::Inherit->new(foo => 1, baz => 2); is($x->foo, 1, "set foo via pairs"); is($x->baz, 2, "set baz via pairs"); # Now with hashref my $y = main::HBase::Wrapped::Inherit->new({foo => 1, baz => 2}); is($y->foo, 1, "set foo via hashref"); is($y->baz, 2, "set baz via hashref"); # Now with hashref my $z = main::HBase::Wrapped::Inherit->new([ 1, # foo 2, # bar 3, # dup 4, # baz ]); is($z->foo, 1, "set foo via arrayref"); is($z->baz, 4, "set baz via arrayref"); like( exception { main::HBase::Wrapped::Inherit->new([1 .. 10]) }, qr/Too many arguments for main::HBase::Wrapped::Inherit constructor/, "Too many args in array form" ); my $CAN_COUNT = 0; my $CAN_COUNT2 = 0; my $INIT_COUNT = 0; BEGIN { $INC{'Object/HashBase/Test/HBase3.pm'} = __FILE__; package main::HBase3; use Test2::Harness::Util::HashBase qw/foo/; sub can { my $self = shift; $CAN_COUNT++; $self->SUPER::can(@_); } $INC{'Object/HashBase/Test/HBase4.pm'} = __FILE__; package main::HBase4; use Test2::Harness::Util::HashBase qw/foo/; sub can { my $self = shift; $CAN_COUNT2++; $self->SUPER::can(@_); } sub init { $INIT_COUNT++ } } is($CAN_COUNT, 0, "->can has not been called yet"); my $it = main::HBase3->new; is($CAN_COUNT, 1, "->can has been called once to check for init"); $it = main::HBase3->new; is($CAN_COUNT, 1, "->can was not called again, we cached it"); is($CAN_COUNT2, 0, "->can has not been called yet"); is($INIT_COUNT, 0, "->init has not been called yet"); $it = main::HBase4->new; is($CAN_COUNT2, 1, "->can has been called once to check for init"); is($INIT_COUNT, 1, "->init has been called once"); $it = main::HBase4->new; is($CAN_COUNT2, 1, "->can was not called again, we cached it"); is($INIT_COUNT, 2, "->init has been called again"); done_testing; 1; builder.t100644001750001750 11015267772575 17110 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test::More; # HARNESS-DURATION-SHORT ok(1, "pass"); done_testing; findbin.t100644001750001750 11215267772575 17075 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; # HARNESS-DURATION-SHORT use ok 'FindBin'; done_testing; subtests.t100644001750001750 113315267772575 17364 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2#!/usr/bin/perl # HARNESS-DURATION-MEDIUM use Test2::V0; use Time::HiRes qw/sleep/; use Test2::Tools::AsyncSubtest; ok(1, "pass"); my $astA = async_subtest 'ast A'; $astA->run(sub { ok(1, "ast A 1") }); subtest out => sub { ok(1, "pass"); ok(1, "pass"); my $astB = async_subtest 'ast B'; $astB->run(sub { ok(1, "ast B 1") }); $astA->run(sub { ok(1, "ast A 2") }); $astB->finish; subtest in => sub { for (1 .. 10) { ok(1, "pass $_"); sleep 0.1; } }; ok(1, "pass"); ok(1, "pass"); }; $astA->finish; done_testing; 0-load_all.t100644001750001750 102015267772575 17325 0ustar00exodistexodist000000000000Test2-Harness-1.000182/tuse Test2::V0; use File::Find; use Test2::Harness; use Test2::Harness::Util qw/file2mod/; find(\&wanted, 'lib/'); sub wanted { my $file = $File::Find::name; return unless $file =~ m/\.pm$/; $file =~ s{^.*lib/}{}g; my $ok = eval { require($file); 1 }; my $err = $@; ok($ok, "require $file", $ok ? () : $err); my $mod = file2mod($file); my $sym = "$mod\::VERSION"; no strict 'refs'; is($$sym, $Test2::Harness::VERSION, "Package $mod ($file) has the version number"); }; done_testing; 1-pod_name.t100644001750001750 251015267772575 17346 0ustar00exodistexodist000000000000Test2-Harness-1.000182/tuse Test2::V0; use Test2::Harness::Util qw/file2mod/; use File::Find; my @files; find(\&wanted, 'lib/'); sub wanted { my $file = $File::Find::name; return unless $file =~ m/\.pm$/; my $mod = $file; $mod =~ s{^.*lib/}{}g; $mod = file2mod($mod); push @files => [$file, $mod]; }; my %bad_files; for my $set (@files) { my ($file, $mod) = @$set; my @res; open(my $fh, '<', "$file") or die "Could not open file '$file': $!"; chomp(my $start = <$fh>); push @res => is($start, "package $mod;", "$file has correct package $mod", "Incorrect: $start"); my $found; while(my $line = <$fh>) { chomp($line); if ($line eq "=head1 POD IS AUTO-GENERATED") { $found = 1; last; } next unless $line eq '=head1 NAME'; $found = 1; my $space = <$fh> // last; chomp(my $check = <$fh> // ''); push @res => like($check, qr/^\Q$mod - \E.+$/, "$file POD has correct package '$mod' under NAME"); last; } push @res => ok($found, "Found 'NAME' section in $file POD"); next unless grep { !$_ } @res; $bad_files{$file} = $mod; }; if (keys %bad_files) { my $diag = "All files with errors:\n"; for my $file (sort keys %bad_files) { $diag .= "$file\n"; } diag $diag; } done_testing; dollardot.t100644001750001750 10315267772575 17450 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; is($., undef, "\$. is set to undef"); done_testing; exception.t100644001750001750 34015267772575 17465 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; # HARNESS-DURATION-SHORT my $file = __FILE__; my $line = __LINE__ + 1; sub throw { die("xxx") }; is( dies { throw() }, "xxx at $file line $line.\n", "Got exception as expected" ); done_testing; tmp_perms.t100644001750001750 215415267772575 17522 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; use File::Spec; use Test2::Harness::Util qw/clean_path/; use Fcntl ':mode'; sub check_perms { my $file = shift; my $mode = (stat($file))[2]; my @bad; $mode & S_ISVTX or push @bad => "$file does not have sticky-bit"; $mode & S_IRWXU or push @bad => "$file is not user RWX"; $mode & S_IRWXG or push @bad => "$file is not group RWX"; $mode & S_IRWXO or push @bad => "$file is not other RWX"; return \@bad; } my $system_tmp = clean_path($ENV{SYSTEM_TMPDIR}); my $problems = check_perms($system_tmp); skip_all join ", " => @$problems if @$problems; my $path = $ENV{TMPDIR}; is(check_perms($path), [], "tempdir has correct permissions"); my $last = $path; my $cnt = 0; while ($system_tmp) { my $next = clean_path(File::Spec->catdir($last, File::Spec->updir())); last if $next eq $system_tmp; # We hit system temp, we can stop last if $next eq $last; # We probably hit root last if $cnt++ > 10; # Something went wrong, no need to loop forever $last = $next; is(check_perms($next), [], "$next has correct permissions"); } done_testing; App000755001750001750 015267772575 16126 5ustar00exodistexodist000000000000Test2-Harness-1.000182/libYath.pm100644001750001750 6375015267772575 17564 0ustar00exodistexodist000000000000Test2-Harness-1.000182/lib/Apppackage App::Yath; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::HashBase qw{ -config -settings -_options -options_loaded -_argv -argv_processed <_orig_argv -_command_class -_command_name -_early_command }; use Time::HiRes qw/time/; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/find_libraries clean_path/; use App::Yath::Options(); use Scalar::Util qw/blessed/; my $APP_PATH = __FILE__; $APP_PATH =~ s{App\S+Yath\.pm$}{}g; $APP_PATH = clean_path($APP_PATH); sub app_path { $APP_PATH } sub init { my $self = shift; my $old = select STDOUT; $| = 1; select STDERR; $| = 1; select $old; my @caller = caller(1); $self->{+SETTINGS} //= Test2::Harness::Settings->new; ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('script')} //= clean_path($caller[1]); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('start')} //= time(); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('no_scan_plugins')} //= 0; $self->{+_ARGV} //= delete($self->{argv}) // []; $self->{+_ORIG_ARGV} = [@{$self->{+_ARGV}}]; $self->{+CONFIG} //= {}; } sub generate_run_sub { my $self = shift; my ($symbol) = @_; my $cmd_class; my ($options, $argv); if (my $cmd = $self->_command_from_argv(no_default => 1, valid_only => 1)) { $cmd_class = $self->load_command($cmd); $self->{+_COMMAND_NAME} = $cmd; $self->{+_COMMAND_CLASS} = $cmd_class; if ($cmd_class->only_cmd_opts) { $self->{+_EARLY_COMMAND} = 1; my $settings = $self->{+SETTINGS}; $options = App::Yath::Options->new(settings => $settings); $options->set_command_class($cmd_class); $options->set_args($self->{+_ARGV}); $argv = $self->{+_ARGV}; $cmd_class->munge_opts($options, $argv, $settings); } } $options //= $self->load_options(); $cmd_class //= $self->command_class(); ${$self->{+SETTINGS}->define_prefix('harness')->vivify_field('command')} //= $cmd_class; $argv = $self->process_argv(); return $cmd_class->generate_run_sub($symbol, $argv, $self->{+SETTINGS}, $self->{+_ORIG_ARGV}) if $cmd_class->can('generate_run_sub'); my $cmd = $cmd_class->new(settings => $options->settings, args => $argv, orig_args => $self->{+_ORIG_ARGV}); $options->process_option_post_actions($cmd); my $run = sub { $self->run_command($cmd) }; { no strict 'refs'; *{$symbol} = $run; } return; } sub run_command { my $self = shift; my ($cmd) = @_; my $exit = $cmd->run; die "Command '" . $cmd->name() . "' did not return an exit value.\n" unless defined $exit; return $exit; } sub load_options { my $self = shift; my $settings = $self->{+SETTINGS} = $self->{+SETTINGS}; my $options = $self->{+_OPTIONS} //= App::Yath::Options->new(settings => $settings); return $options if $self->{+OPTIONS_LOADED}++; $options->include_from( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', ); return $options if $self->{+SETTINGS}->harness->no_scan_plugins; my $option_libs = { %{find_libraries('App::Yath::Plugin::*')}, %{find_libraries('Test2::Harness::Runner::Resource::*')}, }; for my $lib (sort keys %$option_libs) { my $ok = eval { require $option_libs->{$lib}; 1 }; unless ($ok) { warn "Failed to load module '$option_libs->{$lib}': $@"; next; } next unless $lib->can('options'); my $add; $ok = eval { $add = $lib->options; 1 }; unless ($ok) { warn "Failed to get options from module '$option_libs->{$lib}': $@"; next; } next unless $add; unless (blessed($add) && $add->isa('App::Yath::Options')) { warn "Module '$option_libs->{$lib}' is outdated, not loading options.\n" unless $ENV{'YATH_SELF_TEST'}; next; } # A module found by the scan is not necessarily one we know anything # about, it may conflict with another. That is not a reason to abort # every yath command on the system. $ok = eval { $options->include_from($lib); 1 }; unless ($ok) { warn "Failed to include options from module '$option_libs->{$lib}': $@"; next; } } return $options; } sub process_argv { my $self = shift; return $self->{+_ARGV} if $self->{+ARGV_PROCESSED}++; my $options = $self->load_options(); my $settings = $self->settings; my $config_pre_args = $self->{+CONFIG}->{'~'}; $options->grab_pre_command_opts(args => $config_pre_args, stop_at_non_opt => 0, passthrough => 0, die_at_non_opt => 1) if $config_pre_args; $options->set_args($self->{+_ARGV}); $options->grab_pre_command_opts(); $options->process_pre_command_opts(); my $cmd_name = $self->_command_from_argv(); my $cmd_class = $self->load_command($cmd_name); die "Command '$cmd_name' needs to be specified earlier in the command line arguments to yath.\n" if $cmd_class->only_cmd_opts && !$self->{+_EARLY_COMMAND}; $options->set_command_class($cmd_class); $self->{+_COMMAND_CLASS} = $cmd_class; $options->grab_pre_command_opts(stop_at_non_opt => 1, passthrough => 1, die_at_non_opt => 0); my $config_cmd_args = $self->{+CONFIG}->{$cmd_name}; $options->grab_pre_command_opts(args => $config_cmd_args, stop_at_non_opt => 1, passthrough => 1, die_at_non_opt => 0) if $config_cmd_args; $options->process_pre_command_opts(); $options->grab_command_opts(args => $config_cmd_args, die_at_non_opt => 1, stop_at_non_opt => 0, passthrough => 0) if $config_cmd_args; $options->grab_command_opts(); $options->process_command_opts(); $options->clear_env(); $self->clear_env(); my %seen = map {((ref($_) || $_) => 1)} @{$settings->harness->plugins}; for my $plugin (@{$options->used_plugins}) { next if $seen{$plugin}++; push @{$settings->harness->plugins} => $plugin->can('new') ? $plugin->new() : $plugin; } return $self->{+_ARGV}; } sub clear_env { delete $ENV{HARNESS_IS_VERBOSE}; delete $ENV{T2_FORMATTER}; delete $ENV{T2_HARNESS_FORKED}; delete $ENV{T2_HARNESS_IS_VERBOSE}; delete $ENV{T2_HARNESS_JOB_IS_TRY}; delete $ENV{T2_HARNESS_JOB_NAME}; delete $ENV{T2_HARNESS_PRELOAD}; delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_STREAM_FILE}; delete $ENV{T2_STREAM_JOB_ID}; delete $ENV{TEST2_JOB_DIR}; delete $ENV{TEST2_RUN_DIR}; # If Test2::API is already loaded then we need to keep these. delete $ENV{TEST2_ACTIVE} unless $INC{'Test2/API.pm'}; delete $ENV{TEST_ACTIVE} unless $INC{'Test2/API.pm'}; } sub command_class { my $self = shift; $self->process_argv() unless $self->{+_COMMAND_CLASS}; return $self->{+_COMMAND_CLASS}; } sub _command_from_argv { my $self = shift; my %params = @_; return $self->{+_COMMAND_NAME} if $self->{+_COMMAND_NAME}; my $argv = $self->{+_ARGV}; for (my $idx = 0; $idx < @$argv; $idx++) { my $arg = $argv->[$idx]; if ($arg =~ m/^-*h(elp)?$/i) { splice(@$argv, $idx, 1); return 'help'; } if ($arg eq 'do') { splice(@$argv, $idx, 1); last; } last if $arg eq '::'; next if $arg =~ /^-/; if ($arg =~ m/\.jsonl(\.bz2|\.gz)?$/) { warn "\n** First argument is a log file, defaulting to the 'replay' command **\n\n"; return 'replay'; } return splice(@$argv, $idx, 1) if $self->load_command($arg, check_only => 1); return if $params{valid_only}; my $is_path = 0; $is_path ||= -f $arg; $is_path ||= -d $arg; # Assume it is a command, but an invalid one. return splice(@$argv, $idx, 1) unless $is_path; } return if $params{no_default}; if (my $pfile = find_pfile($self->settings, no_checks => 1)) { warn "\n** Persistent runner detected, defaulting to the 'run' command **\n\n"; return 'run'; } warn "\n** Defaulting to the 'test' command **\n\n"; return 'test'; } sub load_command { my $self = shift; my ($cmd_name, %params) = @_; my $cmd_class = "App::Yath::Command::$cmd_name"; my $cmd_file = "App/Yath/Command/$cmd_name.pm"; return $cmd_class if eval { require $cmd_file; 1 }; my $error = $@ || 'unknown error'; my $not_found = $error =~ m{Can't locate \Q$cmd_file\E in \@INC}; return undef if $params{check_only} && $not_found; die "yath command '$cmd_name' not found. (did you forget to install $cmd_class?)\n" if $not_found; die $error; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath - Yet Another Test Harness (Test2-Harness) Command Line Interface (CLI) =head1 DESCRIPTION This is the primary documentation for C, L, L. The canonical source of up-to-date command options are the help output when using C<$ yath help> and C<$ yath help COMMAND>. This document is mainly an overview of C usage and common recipes. L is an alternative to L, and L is an alternative to L. It is not designed to replace L/prove. L is designed to take full advantage of the rich data L can provide. L is also able to use non-core modules and provide more functionality than prove can achieve with its restrictions. =head1 PLATFORM SUPPORT L/L is is focused on unix-like platforms. Most development happens on linux, but bsd, macos, etc should work fine as well. Patches are welcome for any/all platforms, but the primary author (Chad 'Exodist' Granum) does not directly develop against non-unix platforms. =head2 WINDOWS Currently windows is not supported, and it is known that the package will not install on windows. Patches are be welcome, and it would be great if someone wanted to take on the windows-support role, but it is not a primary goal for the project. =head1 OVERVIEW To use L, you use the C command. Yath will find the tests (or use the ones you specify) and run them. As it runs, it will output diagnostic information such as failures. At the end, yath will print a summary of the test run. C can be thought of as a more powerful alternative to C (L) =head1 RECIPES These are common recipes for using C. =head2 RUN PROJECT TESTS $ yath Simply running yath with no arguments means "Run all tests for the current project". Yath will look for tests in C<./t>, C<./t2>, and C<./test.pl> and run any which are found. Normally this implies the C command but will instead imply the C command if a persistent test runner is detected. =head2 PRELOAD MODULES Yath has the ability to preload modules. Yath normally forks to start new tests, so preloading can reduce the time spent loading modules over and over in each test. Note that some tests may depend on certain modules not being loaded. In these cases you can add the C<# HARNESS-NO-PRELOAD> directive to the top of the test files that cannot use preload. =head3 SIMPLE PRELOAD Any module can be preloaded: $ yath -PMoose You can preload as many modules as you want: $ yath -PList::Util -PScalar::Util =head3 COMPLEX PRELOAD If your preload is a subclass of L then more complex preload behavior is possible. See those docs for more info. =head2 LOGGING =head3 RECORDING A LOG You can turn on logging with a flag. The filename of the log will be printed at the end. $ yath -L ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl The event log can be quite large. It can be compressed with bzip2. $ yath -B ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 gzip compression is also supported. $ yath -G ... Wrote log file: test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.gz C<-B> and C<-G> both imply C<-L>. =head3 REPLAYING FROM A LOG You can replay a test run from a log file: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 This will be significantly faster than the initial run as no tests are actually being executed. All events are simply read from the log, and processed by the harness. You can change display options and limit rendering/processing to specific test jobs from the run: $ yath test-logs/2017-09-12~22:44:34~1505281474~25709.jsonl.bz2 -v [TEST UUID(S)] Note: This is done using the C<$ yath replay ...> command. The C command is implied if the first argument is a log file. =head2 PER-TEST TIMING DATA The C<-T> option will cause each test file to report how long it took to run. $ yath -T ( PASSED ) job 1 t/yath_script.t ( TIME ) job 1 Startup: 0.07692s | Events: 0.01170s | Cleanup: 0.00190s | Total: 0.09052s =head2 PERSISTENT RUNNER yath supports starting a yath session that waits for tests to run. This is very useful when combined with preload. =head3 STARTING This starts the server. Many options available to the 'test' command will work here but not all. See C<$ yath help start> for more info. $ yath start =head3 RUNNING This will run tests using the persistent runner. By default, it will search for tests just like the 'test' command. Many options available to the C command will work for this as well. See C<$ yath help run> for more details. $ yath run =head3 STOPPING Stopping a persistent runner is easy. $ yath stop =head3 INFORMATIONAL The C command will tell you which persistent runner will be used. Yath searches for the persistent runner in the current directory, then searches in parent directories until it either hits the root directory, or finds the persistent runner tracking file. $ yath which The C command will tail the runner's log files. $ yath watch =head3 PRELOAD + PERSISTENT RUNNER You can use preloads with the C command. In this case, yath will track all the modules pulled in during preload. If any of them change, the server will reload itself to bring in the changes. Further, modified modules will be blacklisted so that they are not preloaded on subsequent reloads. This behavior is useful if you are actively working on a module that is normally preloaded. =head2 MAKING YOUR PROJECT ALWAYS USE YATH $ yath init The above command will create C. C is automatically run by most build utils, in which case only the exit value matters. The generated C will run C and execute all tests in the C<./t> and/or C<./t2> directories. Tests in C<./t> will ALSO be run by prove but tests in C<./t2> will only be run by yath. =head2 PROJECT-SPECIFIC YATH CONFIG You can write a C<.yath.rc> file. The file format is very simple. Create a C<[COMMAND]> section to start the configuration for a command and then provide any options normally allowed by it. When C is run inside your project, it will use the config specified in the rc file, unless overridden by command line options. B You can also add pre-command options by placing them at the top of your config file I any C<[cmd]> markers. Comments start with a semi-colon. Example .yath.rc: -pFoo ; Load the 'foo' plugin before dealing with commands. [test] -B ;Always write a bzip2-compressed log [start] -PMoose ;Always preload Moose with a persistent runner This file is normally committed into the project's repo. =head3 SPECIAL PATH PSEUDO-FUNCTIONS Sometimes you want to specify files relative to the .yath.rc so that the config option works from any subdirectory of the project. Other times you may wish to use a shell expansion. Sometimes you want both! =over 4 =item rel(path/to/file) -I rel(path/to/extra_lib) -I=rel(path/to/extra_lib) This will take the path to C<.yath.rc> and prefix it to the path inside C. If for example you have C then the path would become C. =item glob(path/*/file) --default-search glob(subprojects/*/t) --default-search=glob(subprojects/*/t) This will add a C<--default-search $_> for every item found in the glob. This uses the perl builtin function C under the hood. =item relglob(path/*/file) --default-search relglob(subprojects/*/t) --default-search=relglob(subprojects/*/t) Same as C except paths are relative to the C<.yath.rc> file. =back =head2 PROJECT-SPECIFIC YATH CONFIG USER OVERRIDES You can add a C<.yath.user.rc> file. Format is the same as the regular C<.yath.rc> file. This file will be read in addition to the regular config file. Directives in this file will come AFTER the directives in the primary config so it may be used to override config. This file should not normally be committed to the project repo. =head2 HARNESS DIRECTIVES INSIDE TESTS C will recognise a number of directive comments placed near the top of test files. These directives should be placed after the C<#!> line but before any real code. Real code is defined as any line that does not start with use, require, BEGIN, package, or # =over 4 =item good example 1 #!/usr/bin/perl # HARNESS-NO-FORK ... =item good example 2 #!/usr/bin/perl use strict; use warnings; # HARNESS-NO-FORK ... =item bad example 1 #!/usr/bin/perl # blah # HARNESS-NO-FORK ... =item bad example 2 #!/usr/bin/perl print "hi\n"; # HARNESS-NO-FORK ... =back =head3 HARNESS-NO-PRELOAD #!/usr/bin/perl # HARNESS-NO-PRELOAD Use this if your test will fail when modules are preloaded. This will tell yath to start a new perl process to run the script instead of forking with preloaded modules. Currently this implies HARNESS-NO-FORK, but that may not always be the case. =head3 HARNESS-NO-FORK #!/usr/bin/perl # HARNESS-NO-FORK Use this if your test file cannot run in a forked process, but instead must be run directly with a new perl process. This implies HARNESS-NO-PRELOAD. =head3 HARNESS-NO-STREAM C usually uses the L formatter instead of TAP. Some tests depend on using a TAP formatter. This option will make C use L or L. =head3 HARNESS-NO-IO-EVENTS C can be configured to use the L plugin. This plugin replaces STDERR and STDOUT in your test with tied handles that fire off proper L's when they are printed to. Most of the time this is not an issue, but any fancy tests or modules which do anything with STDERR or STDOUT other than print may have really messy errors. B This plugin is disabled by default, so you only need this directive if you enable it globally but need to turn it back off for select tests. =head3 HARNESS-NO-TIMEOUT C will usually kill a test if no events occur within a timeout (default 60 seconds). You can add this directive to tests that are expected to trip the timeout, but should be allowed to continue. NOTE: you usually are doing the wrong thing if you need to set this. See: C. =head3 HARNESS-TIMEOUT-EVENT 60 C can be told to alter the default event timeout from 60 seconds to another value. This is the recommended alternative to HARNESS-NO-TIMEOUT =head3 HARNESS-TIMEOUT-POSTEXIT 15 C can be told to alter the default POSTEXIT timeout from 15 seconds to another value. Sometimes a test will fork producing output in the child while the parent is allowed to exit. In these cases we cannot rely on the original process exit to tell us when a test is complete. In cases where we have an exit, and partial output (assertions with no final plan, or a plan that has not been completed) we wait for a timeout period to see if any additional events come into =head3 HARNESS-DURATION-LONG This lets you tell C that the test file is long-running. This is primarily used when concurrency is turned on in order to run longer tests earlier, and concurrently with shorter ones. There is also a C option to skip all long tests. This duration is set automatically if HARNESS-NO-TIMEOUT is set. =head3 HARNESS-DURATION-MEDIUM This lets you tell C that the test is medium. This is the default duration. =head3 HARNESS-DURATION-SHORT This lets you tell C That the test is short. =head3 HARNESS-CATEGORY-ISOLATION This lets you tell C that the test cannot be run concurrently with other tests. Yath will hold off and run these tests one at a time after all other tests. =head3 HARNESS-CATEGORY-IMMISCIBLE This lets you tell C that the test cannot be run concurrently with other tests of this class. This is helpful when you have multiple tests which would otherwise have to be run sequentially at the end of the run. Yath prioritizes running these tests above HARNESS-CATEGORY-LONG. =head3 HARNESS-CATEGORY-GENERAL This is the default category. =head3 HARNESS-CONFLICTS-XXX This lets you tell C that no other test of type XXX can be run at the same time as this one. You are able to set multiple conflict types and C will honor them. XXX can be replaced with any type of your choosing. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. =over 4 =item Example with multiple lines. #!/usr/bin/perl # DASH and space are split the same way. # HARNESS-CONFLICTS-DAEMON # HARNESS-CONFLICTS MYSQL ... =item Or on a single line. #!/usr/bin/perl # HARNESS-CONFLICTS DAEMON MYSQL ... =back =head3 HARNESS-SHARES-XXX This lets you tell C that this test uses XXX, but is happy to share it with other tests that merely use it too. Any number of C tests may run at the same time, but none of them will run at the same time as a C test. If you think of the two directives as a lock on the name XXX, C takes it exclusively and C takes it shared. XXX can be replaced with any type of your choosing, and you may set several of them. The usual shape for this is one test that disturbs a resource and many that merely read it: mark the disruptive one C and the rest C, and the readers keep their parallelism instead of being serialized alongside the writer. NOTE: An exclusive test has to wait for every shared test holding the name to finish, and C will not hold job slots empty to make room for it. If shared tests keep becoming available the exclusive one may run quite late in the run, possibly last and by itself. This is still better than marking every test C, but it is worth knowing before you mark hundreds of tests as sharing one name. NOTE: This directive does not alter the category of your test. You are free to mark the test with LONG or MEDIUM in addition to this marker. =head3 HARNESS-JOB-SLOTS 2 =head3 HARNESS-JOB-SLOTS 1 10 Specify a range of job slots needed for the test to run. If set to a single value then the test will only run if it can have the specified number of slots. If given a range the test will require at least the lower number of slots, and use up to the maximum number of slots. =head3 HARNESS-RETRY-n This lets you specify a number (minimum n=1) of retries on test failure for a specific test. HARNESS-RETRY-1 means a failing test will be run twice and is equivalent to HARNESS-RETRY. =head3 HARNESS-NO-RETRY Use this to avoid this test being retried regardless of your retry settings. =head1 MODULE DOCS This section documents the L module itself. =head2 SYNOPSIS In practice you should never need to write your own yath script, or construct an L instance, or even access the main instance when yath is running. However some aspects of doing so are documented here for completeness. A minimum yath script looks like this: BEGIN { package App::Yath:Script; require Time::HiRes; require App::Yath; require Test2::Harness::Settings; my $settings = Test2::Harness::Settings->new( harness => { orig_argv => [@ARGV], orig_inc => [grep { !ref($_) } @INC], script => __FILE__, start => Time::HiRes::time(), version => $App::Yath::VERSION, }, ); my $app = App::Yath->new( argv => \@ARGV, config => {}, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::run'); } exit(App::Yath::Script::run()); It is important that most logic live in a BEGIN block. This is so that L can be used post-fork to execute a test script. The actual yath script is significantly more complicated with the following behaviors: =over 4 =item pre-process essential arguments such as -D and no-scan-plugins =item re-exec with a different yath script if in developer mode and a local copy is found =item Parse the yath-rc config files =item gather and store essential startup information =back =head2 METHODS App::Yath does not provide many methods to use externally. =over 4 =item $app->generate_run_sub($symbol_name) This tells App::Yath to generate a subroutine at the specified symbol name which can be run and be expected to return an exit value. =item $lib_path = $app->app_path() Get the include directory App::Yath was loaded from. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 COPYRIGHT Copyright 2020 Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut yath_script.t100755001750001750 2250215267772575 20005 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t#!/usr/bin/perl # HARNESS-NO-FORK use strict; use warnings; my %ORIG_INC = (%INC); @ARGV = (); my $in_section; my %sections; { local $.; my ($script) = grep { -f $_ } 'lib/App/Yath/Script/V1.pm', '../lib/App/Yath/Script/V1.pm'; die "Could not find App::Yath::Script::V1 module" unless $script; open(my $fh, '<', $script) or die "Could not open V1 module: $!"; my ($tdir) = grep { -d $_ } 't/yath_script', 'yath_script'; die "Could not find the t/yath_script directory" unless $tdir; chdir("$tdir/nested") or die "Could not change directory: $!"; while (my $line = <$fh>) { chomp($line); if ($line =~ m/^\s*# ==START TESTABLE CODE (\S+)==\s*$/) { $in_section = $1; push @{$sections{lc($in_section)}} => ("use strict;", "use warnings FATAL => 'all';", "#line " . ($. + 1) . ' "' . $script . '"'); next; } if ($line =~ m/^\s*# ==END TESTABLE CODE\s?(\S+)==\s*$/) { die "In section '$in_section' but found end of section '$1'" unless $1 eq $in_section; $sections{lc($in_section)} = join "\n" => @{delete $sections{lc($in_section)}}; $in_section = undef; } next unless $in_section; push @{$sections{lc($in_section)}} => $line; } } my @RESULTS; sub is($$;$) { push @RESULTS => ['is', [@_], [caller()]] } sub like($$;$) { push @RESULTS => ['like', [@_], [caller()]] } sub ok($;$) { push @RESULTS => ['ok', [@_], [caller()]] } our %T; sub T() { \%T } test_parse_config_files(); sub test_parse_config_files { my ($config_args, $to_clean); my $code = delete $sections{parse_config_files}; local @ARGV = ('START', 'END'); my %CONFIG; eval <<" EOT" or die $@; my \$config_file = './../.yath.rc'; my \$user_config_file = './.yath.user.rc'; $code \$config_args = \\\@CONFIG_ARGS; \$to_clean = \\\@TO_CLEAN; 1; EOT is( $config_args, [ '-Dpre_lib', '-D=./../pre/xxx/lib', '-D=./../pre/yyy/lib', '-D=SPLIT', '--no-scan-plugins', '-Dpre_user_lib', '-D=./pre/xxx/user/lib', '-D=./pre/yyy/user/lib', ], "Got pre-args from all config files" ); is( [@ARGV], [ '-Dpre_lib', '-D=./../pre/xxx/lib', '-D=./../pre/yyy/lib', '-D=SPLIT', '--no-scan-plugins', '-Dpre_user_lib', '-D=./pre/xxx/user/lib', '-D=./pre/yyy/user/lib', 'START', 'END', ], "Prepended args to \@ARGV" ); is( {%CONFIG}, { '~' => [ '-pXXX', '-p' => 'YYY', '-pUSER_XXX', '-p' => 'USER_YYY', ], test => [ '-Itest_lib', '-I=./../test/xxx/lib', '-I' => './../test/yyy/lib', (map {('--default-search' => $_)} glob('./../../*.t')), '-xxxx', 'foo', 'bar', 'baz' => 'bat', '-Itest_user_lib', '-I=./test/xxx/user/lib', '-I' => './test/yyy/user/lib', '-user_xxxx', 'user_foo', 'user_bar', 'user_baz' => 'user_bat', ], run => [ '-Irun_lib', '-I=./../run/xxx/lib', '-I' => './../run/yyy/lib', '-xxxx', 'foo', 'bar', '-Irun_user_lib', '-I=./run/xxx/user/lib', '-I' => './run/yyy/user/lib', '-user_xxxx', 'user_foo', 'user_bar', ], }, "Parsed all command args properly" ); is( $to_clean, [ ['test', T, '-I', '=', './../test/xxx/lib'], ['test', T, '-I', ' ', './../test/yyy/lib'], (map { ['test', T, '--default-search', ' ', $_] } glob('./../../*.t')), ['run', T, '-I', '=', './../run/xxx/lib'], ['run', T, '-I', ' ', './../run/yyy/lib'], ['test', T, '-I', '=', './test/xxx/user/lib'], ['test', T, '-I', ' ', './test/yyy/user/lib'], ['run', T, '-I', '=', './run/xxx/user/lib'], ['run', T, '-I', ' ', './run/yyy/user/lib'], ], "Will come back and clean these later" ); } test_pre_parse_d_args(); sub test_pre_parse_d_args { my $code = delete $sections{pre_parse_d_args}; local @INC = ('START', 'END'); local @ARGV = ('START', '-D=aaa', '-Dbbb', '--no-scan-plugins', '--no-dev-lib', '-D', '--dev-lib', '-Dxxx', '-Dxxx', '--dev-lib=foo', '-Dbbb', '::', '-Doops', 'END'); my @DEVLIBS; my $NO_PLUGINS; my ($libs, $done); eval $code . <<' EOT' or die $@; $libs = \@libs; $done = \%done; 1; EOT is( [@ARGV], ['START', '::', '-Doops', 'END'], "Modified \@ARGV" ); is( $libs, ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb'], "Got expected libs" ); is( [@DEVLIBS], ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb'], "Got expected devlibs" ); is( [@INC], ['lib', 'blib/lib', 'blib/arch', 'xxx', 'foo', 'bbb', 'START', 'END'], "prepended libs to \@INC" ); is( $NO_PLUGINS, 1, "Set no plugins" ); is( $done, { 'lib' => 2, 'blib/lib' => 2, 'blib/arch' => 2, 'xxx' => 2, 'foo' => 1, 'bbb' => 1, }, "Saw each arg as many times as we expected (including the reset mid-way wiping previously seen out)" ); local @INC = ('START', 'END'); local @ARGV = ('START', '-Dbbb', '--', '-Doops', 'END'); @DEVLIBS = (); eval $code . <<' EOT' or die $@; $libs = \@libs; $done = \%done; 1; EOT is( [@ARGV], ['START', '--', '-Doops', 'END'], "Modified \@ARGV" ); is( $libs, ['bbb'], "Got expected libs" ); is( [@INC], ['bbb', 'START', 'END'], "prepended libs to \@INC" ); is( $done, { 'bbb' => 1, }, "Saw each arg as many times as we expected" ); } is({%INC}, {%ORIG_INC}, "Did not load anything."); require Test2::V0; # such a dirty hack! # Turn %T into an instance of the T check. my $t = Test2::V0::T(); %T = %$t; bless(\%T, ref($t)); for my $res (@RESULTS) { my ($func, $args, $caller) = @$res; my $sub = Test2::V0->can($func) or die "No such test function: $func at $caller->[1] line $caller->[2]\n"; $sub->(@$args) or warn "Actual assertion at $caller->[1] line $caller->[2]\n"; } test_cleanup_paths(); sub test_cleanup_paths { my $code = delete $sections{cleanup_paths}; require Cwd; require File::Spec; my @libs = ('../../lib', './', '../'); my @DEVLIBS = @libs; local @INC = (@libs, 'START', 'END'); my %CONFIG = ( test => [ '-I' => '../../lib', '-I=../../lib', ], ); my @TO_CLEAN = ( ['test', 1, '-I', ' ', '../../lib'], ['test', 2, '-I', '=', '../../lib'], ); eval $code . "\n1;" or die $@; Test2::V0::is( \@INC, [(map { Cwd::realpath($_) } @libs), 'START', 'END'], "Cleaned up \@INC" ); Test2::V0::is( \@DEVLIBS, [(map { Cwd::realpath($_) } @libs)], "Cleaned up \@DEVLIBS" ); Test2::V0::is( \%CONFIG, { test => [ '-I' => Cwd::realpath('../../lib'), '-I=' . Cwd::realpath('../../lib'), ], }, "Cleaned up \%CONFIG" ); } test_create_app(); sub test_create_app { my $code = delete $sections{create_app}; my $args; require App::Yath; my $control = Test2::V0::mock( 'App::Yath' => ( override => { generate_run_sub => sub { $args = [@_] }, }, ) ); my (%ORIG_SIG, @ORIG_ARGV, @ORIG_INC, @DEVLIBS, @ARGV, %CONFIG, $NO_PLUGINS, $ORIG_TMP, $ORIG_TMP_PERMS, $config_file, $user_config_file); my $script = "foobar"; $NO_PLUGINS = 2; eval $code or die $@; my ($app, $symbol) = @$args; Test2::V0::isa_ok($app, 'App::Yath'); Test2::V0::is($symbol, 'App::Yath::Script::V1::_run', "Got correct symbol"); Test2::V0::ref_is($app->_argv, \@ARGV, "Used ARGV"); Test2::V0::ref_is($app->config, \%CONFIG, "Used CONFIG"); my $settings = $app->settings; is( $settings, { yath => { orig_sig => Test2::V0::exact_ref(\%ORIG_SIG), orig_argv => Test2::V0::exact_ref(\@ORIG_ARGV), orig_inc => Test2::V0::exact_ref(\@ORIG_INC), dev_libs => Test2::V0::exact_ref(\@DEVLIBS), script => $script, no_scan_plugins => 2, start => Test2::V0::T(), }, }, "Got settings" ); } die "The following sections were not tested: " . join(', ', keys %sections) if keys %sections; Test2::V0::done_testing(); ipc_reexec.t100644001750001750 44215267772575 17600 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2# HARNESS-NO-FORK # HARNESS-DURATION-SHORT BEGIN { $INC{'Test2/Formatter/Stream.pm'} && exec($^X, $0); }; # Force into stdout BEGIN { delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_FORMATTER}; } use Test::Builder; use Test2::V0; ok 1, "test runs correctly in IPC mode"; done_testing; magic_vars.t100644001750001750 27315267772575 17607 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; # HARNESS-DURATION-SHORT skip_all "Test breaks Devel::Cover db" if $ENV{T2_DEVEL_COVER}; $\ = '|'; $, = '|'; is($\, '|', 'set $\\'); is($,, '|', 'set $,'); done_testing App000755001750001750 015267772575 16602 5ustar00exodistexodist000000000000Test2-Harness-1.000182/t/unitYath.t100644001750001750 2413715267772575 20063 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/unit/Appuse Test2::V0 -target => 'App::Yath'; use Data::Dumper; use Carp; use App::Yath; use Test2::Harness::Util qw/clean_path/; use Test2::Tools::GenTemp qw/gen_temp/; $ENV{'YATH_SELF_TEST'} = 1; subtest init => sub { my $one = $CLASS->new(argv => [foo => 'bar']); isa_ok($one, $CLASS); isa_ok($one->settings, 'Test2::Harness::Settings'); is($one->settings->harness->script, clean_path(__FILE__), "Yath script set to this test file"); is($one->_argv, [foo => 'bar'], "Grabbed argv"); is($one->config, {}, "Default empty config"); my $two = App::Yath->new(); is($two->_argv, [], "default to empty argv"); }; { require App::Yath::Command; $INC{'App/Yath/Command/NOGEN.pm'} = __FILE__; $INC{'App/Yath/Command/GEN.pm'} = __FILE__; package App::Yath::Command::NOGEN; use App::Yath::Options; option 'verbose' => ( type => 'c', prefix => 'foo', short => 'v', ); post sub { $main::POST++ }; use Test2::Harness::Util::HashBase qw/settings argv/; our @ISA = ('App::Yath::Command'); sub run { 123 } package App::Yath::Command::GEN; our @ISA = ('App::Yath::Command::NOGEN'); sub generate_run_sub { ('ran gen_run_sub', @_) } } subtest generate_run_sub => sub { my $one = $CLASS->new(argv => ['GEN']); my @out = $one->generate_run_sub('main::RUNSUB'); is( \@out, [ 'ran gen_run_sub', 'App::Yath::Command::GEN', 'main::RUNSUB', [], exact_ref($one->settings), ['GEN'], ], "Ran command generate_run_sub with correct args" ); my $two = $CLASS->new(argv => ['NOGEN', '-vv']); $two->generate_run_sub('main::RUNSUB'); is($two->settings->foo->verbose, 2, "Set verbose with CLI args"); ok(defined(&main::RUNSUB), "Added the runsub to the provided symbol"); is(main::RUNSUB(), 123, "runsub does what we expect (runs the command run method) and we get the exit value"); is($main::POST, 1, "Ran post-process callbacks"); }; subtest run_command => sub { my $one = $CLASS->new(); my $cmd = mock {run => undef, name => 'acmd'}; is( dies { $one->run_command($cmd) }, "Command 'acmd' did not return an exit value.\n", "Command must return an exit value" ); $cmd->{run} = 12; is($one->run_command($cmd), 12, "Returned the proper exit code"); }; subtest command_class => sub { my $one = $CLASS->new(argv => ['GEN']); is($one->command_class, 'App::Yath::Command::GEN', "Got command class from args"); $one->{_command_class} = 'foo'; is($one->command_class, "foo", "A cache is used"); }; subtest load_command => sub { my $one = $CLASS->new(); is($one->load_command('GEN'), 'App::Yath::Command::GEN', "Works for valid command (inline)"); is($one->load_command('test'), 'App::Yath::Command::test', "Works for valid command (real)"); is($one->load_command('gsdfgsdfgsd', check_only => 1), undef, "Missing module is ok in 'check_only' mode"); is( dies { $one->load_command('dgfsdfgsdf') }, "yath command 'dgfsdfgsdf' not found. (did you forget to install App::Yath::Command::dgfsdfgsdf?)\n", "Correct message for missing command" ); is( dies { local @INC = (sub { die "module failed\n" }); $one->load_command('jgjgjfdfk'); }, "module failed\n", "If a module load throws an exception we pass it along" ); }; subtest load_options => sub { local @INC = (@INC, 't/lib'); my $one = $CLASS->new(); $one->settings->harness->field(no_scan_plugins => 1); my $options = $one->load_options(); is( $options->included, { 'App::Yath::Options::Debug' => 1, 'App::Yath::Options::PreCommand' => 1, }, "Included Debug and PreCommand, but not plugins" ); my $two = $CLASS->new(); $two->settings->harness->field(no_scan_plugins => 0); my @ignore = warns { $options = $two->load_options() }; like( $options->included, { 'App::Yath::Options::Debug' => 1, 'App::Yath::Options::PreCommand' => 1, 'App::Yath::Plugin::Options' => 1, }, "Included Debug and PreCommand, as well as the plugin" ); ref_is($options, $two->load_options, "Cached options result"); }; subtest load_options_conflict => sub { # Two plugins, neither of them ours, that lay claim to the same option name. # Nothing can include both, but yath must still run. my $plugin = sub { my ($name) = @_; return join "\n" => ( "package App::Yath::Plugin::$name;", "use strict;", "use warnings;", "use App::Yath::Options;", "option collide => (prefix => 'conflict', type => 'b');", "1;", "", ); }; my $tmp = gen_temp( App => { Yath => { Plugin => { 'ConflictA.pm' => $plugin->('ConflictA'), 'ConflictB.pm' => $plugin->('ConflictB'), }, }, }, ); local @INC = ($tmp, @INC); my $one = $CLASS->new(); $one->settings->harness->field(no_scan_plugins => 0); my $options; my $warnings = warnings { $options = $one->load_options() }; like( $warnings, bag { item match qr/Failed to include options from module .*ConflictB\.pm.*Option 'conflict-collide' was already defined/s; etc; }, "Warned about the plugin that could not be included" ); like( $options->included, { 'App::Yath::Options::Debug' => 1, 'App::Yath::Options::PreCommand' => 1, 'App::Yath::Plugin::ConflictA' => 1, }, "Included everything up to the conflict" ); ok(!$options->included->{'App::Yath::Plugin::ConflictB'}, "Did not include the conflicting plugin"); }; subtest process_argv => sub { local @INC = (@INC, 't/lib'); my $one = $CLASS->new( argv => [qw/-Dfoo -Dbar fake -x -y blah uhg/], config => {fake => [qw/-Dbaz -z/], other => [qw/-noop/]}, ); my @ignore = warns { is($one->process_argv(), $one->_argv, "remaining args are returned") }; is($one->command_class, 'App::Yath::Command::fake', "Set command class"); is( ${$one->settings->fake}, { x => 1, y => 1, z => 1, }, "Added 'fake' command settings" ); like( $one->settings->harness->dev_libs, bag { item qr/foo$/; item qr/bar$/; item qr/baz$/; }, "Added the dev libs" ); is($one->_argv, [qw/blah uhg/], "Remaining args"); no warnings 'once'; is($main::POST_HOOK, F(), "Did not run hook yet (requires command instance)"); }; subtest command_from_argv => sub { my $one = $CLASS->new(); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); like( warning { is($one->_command_from_argv, 'test', "Default to test") }, qr/Defaulting to the 'test' command/, "Warning about default" ); my $control = mock $CLASS => ( override => [ find_pfile => sub { 1 } ] ); like( warning { is($one->_command_from_argv, 'run', "Default to run if we have a persistence file") }, qr/Persistent runner detected, defaulting to the 'run' command/, "Warning about default" ); $control = undef; $one = $CLASS->new(argv => ['-f', '--foo', 'test', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "test", "Found 'test' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', 'hfajhdajshfj', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "hfajhdajshfj", "Found 'hfajhdajshfj' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', '--help', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "help", "Found 'help' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', '-h', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); is($one->_command_from_argv(), "help", "Found 'help' command"); is($one->_argv, ['-f', '--foo', '-b', '--bar'], "Command was removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', 'foo.jsonl.bz2', '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); my @ignore = warns { is($one->_command_from_argv(), "replay", "Found 'replay' command because we got a log") }; is($one->_argv, ['-f', '--foo', 'foo.jsonl.bz2', '-b', '--bar'], "log was not removed from argv"); $one = $CLASS->new(argv => ['-f', '--foo', __FILE__, '-b', '--bar']); $one->settings->harness->vivify_field('persist_file'); $one->settings->harness->vivify_field('project'); $one->settings->harness->vivify_field('persist_dir'); @ignore = warns { is($one->_command_from_argv(), "test", "Found 'test' command because we got a path") }; is($one->_argv, ['-f', '--foo', __FILE__, '-b', '--bar'], "path was not removed"); }; done_testing; require_file.t100644001750001750 40415267772575 20143 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use strict; use warnings; use Test2::Tools::Tiny; use File::Spec; # HARNESS-DURATION-SHORT my $file = __FILE__; $file =~ s/\.t$/.pm/; $file = File::Spec->rel2abs($file); require $file; ok(file_loaded(), "file loaded, proper namespace, etc"); done_testing; child_exit_282.t100644001750001750 27615267772575 20124 0ustar00exodistexodist000000000000Test2-Harness-1.000182/tuse Test2::V0; plan tests => 1; sub checks_exit_code { diag $?; if ( $? != 0 ) { die 'exit code is not 0'; } } ok(lives { checks_exit_code() }, 'exit code OK'); done_testing; no_stdout_eol.t100644001750001750 13215267772575 20343 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2#!/usr/bin/perl use strict; use warnings; # HARNESS-DURATION-SHORT print "1..2\nok\nok"; non_perl000755001750001750 015267772575 17001 5ustar00exodistexodist000000000000Test2-Harness-1.000182/t2test.c100755001750001750 15015267772575 20243 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2/non_perl#include int main() { printf("ok 1 - assertion\n"); printf("1..1\n"); return 0; } require_file.pm100644001750001750 14215267772575 20313 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use strict; use warnings; sub file_loaded { 1 } is(__PACKAGE__, 'main', "in main package"); 1; test.sh100755001750001750 11315267772575 20432 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2/non_perl#!/usr/bin/bash # HARNESS-DURATION-SHORT echo "ok 1"; echo "1..1"; exit 0; relative_paths.t100644001750001750 60615267772575 20506 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t2use Test2::V0; use File::Spec; # HARNESS-DURATION-SHORT my $path = File::Spec->canonpath('t2/relative_paths.t'); skip_all "This test must be run from the project root." unless -f $path; is(__FILE__, $path, "__FILE__ is relative"); is(__FILE__, $0, "\$0 is relative"); sub { my ($pkg, $file) = caller(0); is($file, $path, "file in caller is relative"); }->(); done_testing; AI_AND_LLM_POLICY.md100644001750001750 1661115267772575 20105 0ustar00exodistexodist000000000000Test2-Harness-1.000182# AI/LLM Contribution Policy ## TL;DR - Use whatever tools you like, AI/LLM included. We care about the result, not your workflow. - A human must understand every change start to finish and stand behind it. AI assists; it does not replace you. No 'vibe' coded final product. - Keep contributions in chunks small enough for a human to actually review. - Note significant AI/LLM use in the commit message, PR description, or ticket. A plain sentence is enough. - Bot and AI accounts stay out of pull requests and tickets. Two narrow exceptions: filing a complete, clearly labeled initial bug report, and a restricted-availability model answering on a security issue when a human directly asks it to. - This project is open source, and you may use its source and documentation as AI/LLM training data. ## Why these rules exist Two goals. Everything below follows from them. ### The code stays understandable Someone will read this code years from now, with whoever wrote it long gone, and have to work out what it does and why. AI/LLM tools are very good at producing code that works and that nobody understands. Code like that is a debt, and the maintainers pay it at the worst possible moment. ### The maintainers' burden stays manageable Every outside contribution is a request for the maintainers' time, judgment, and years of ownership after the contributor has moved on. A one-time contributor cannot carry any of that, and cannot be asked to. These rules exist so that what arrives is something the people who stay can actually take on. ## How strictly this applies This policy manages a burden; it does not certify a repository-wide standard. The core maintainers are not bound by it. In practice they mostly work this way anyway, as they are the ones who would pay for not doing so. A core maintainer who does something differently is not being a hypocrite: they are already accountable, and committed to the long-term maintenance. The more someone contributes, and the more they prove they will stick around, the more leeway we will give them to deviate from the policy. We want more long-term trusted contributors, and once trust is built that is reflected in what they are allowed to do and how much supervision they need. After significant vetted contributions someone may be added as a core maintainer, though that can also be revoked if their contributions become unmaintainable. ## Use whatever tools you like Contributors may use whatever tools they decide are necessary for their work, AI/LLM tools included. The project does not micromanage a contributor's workflow. ## What the work must look like **A human understands it, start to finish.** No 'vibe' coding in the final product: AI may assist and be used as a tool, but it cannot do all the work, and it cannot replace your own understanding of the code you are contributing. Vibe coding is fine for rapid experimentation — just not for what you submit. **It arrives in digestible chunks.** This applies to any code, but LLMs are especially good at producing PRs too big for a human to digest and verify. Oversized PRs get broken into smaller commits, and into smaller PRs where possible. If humans cannot reasonably verify it, it is not accepted. **It gets human vetting before merge.** Maintainers who merge a pull request must verify its accuracy and utility. If AI/LLM generated code needs edits or corrections before or during merge, those land as a separate commit saying what human action was required. **Documentation meets the same bar as everything else.** Documentation may be AI written, and may even be identifiably so, but it must meet the same readability and content standards as human-written documentation: concise, natural to read, useful to its audience, and free of needless repetition. ## Tickets and pull requests are for humans Pull requests and tickets are where humans discuss the project with each other. Do not use a bot, AI, or LLM account to open a pull request, review one, comment on one, or interact with a ticket. A maintainer who wants an agent's take can run their own agent; they do not need one posting in the thread. This restricts who takes part in the conversation, not what wrote the code. A human may absolutely open a pull request containing AI-assisted work. What the human cannot do is hand the conversation off: if you submit it, you answer for it — you respond to review, explain the decisions, and make the corrections. The same assist-versus-replace line applies here as everywhere else: use whatever tools help you write a reply, but the reply must be one you understand and stand behind, not one you relayed. There is one exception: an initial bug report may be filed by a bot, AI, or LLM account. That is welcome, and especially so for security issues. Such a report must: - State plainly, in the report itself, that the account is a bot and that an AI/LLM wrote the report. - Carry the full context needed to understand and debug the issue — affected versions, environment, reproduction steps, and the observed and expected behavior. A report a human cannot act on without asking the bot follow-up questions defeats the exception. - Stop there. No further comments, no answering questions, no arguing, no submitting a fix. Humans take it from that point. A security issue may warrant more than that. Where the bot runs a restricted model that can answer questions or give feedback no publicly available model can, it may keep interacting with that ticket — but only when a human directly asks it to. It must say who it is: that it is a bot, that its model may not be publicly available, and that under this policy it responds only when asked. ## Note significant AI/LLM use Say so in the commit message, the pull request description, or the ticket. A plain sentence is enough. The reason is mundane. The maintainers want a rough sense of how much incoming work is AI/LLM generated or assisted versus purely human. That is tracked loosely and mentally, from what the pull requests and tickets happen to say over time. It is not counted, not audited, not recorded anywhere in the code, and no number it produces triggers anything. What to note is work written primarily by or with an LLM, as opposed to work a human wrote with a little AI help. The middle ground is not a concern. You do not need to note: - Using AI for code review. - Using AI to correct a minor syntax issue. - Using AI to translate or write small code snippets. A good rule of thumb: if it is small enough that you could reasonably ask a peer for it on short notice, or find it quickly with a search, it probably needs no note. Code that reads as AI-written but is presented as human-written will draw a request to clarify or correct it. This is not an exhaustive audit and not a way to single out contributors who use or reject AI assistance. Using this rule as an excuse to troll or attack a contributor will not be tolerated. Someone who missed the mark on noting AI use gets asked kindly to clarify and update. ## Using this code as training data This project is open source, and its license governs what you may do with the code. On top of that license, permission is granted to use this project's source and documentation as training data for developing AI/LLM models. You do not need to ask, and you do not need to tell us. That permission covers what this project distributes under its own license. It does not extend to third-party code the project bundles or depends on, which carries its own terms. Yath000755001750001750 015267772575 17033 5ustar00exodistexodist000000000000Test2-Harness-1.000182/lib/AppUtil.pm100644001750001750 3352615267772575 20477 0ustar00exodistexodist000000000000Test2-Harness-1.000182/lib/App/Yathpackage App::Yath::Util; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use Sys::Hostname qw/hostname/; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::File::JSON; use Cwd qw/realpath/; use Importer Importer => 'import'; use Config qw/%Config/; use Carp qw/croak/; our @EXPORT_OK = qw{ find_pfile find_in_updir is_generated_test_pl fit_to_width isolate_stdout find_yath }; my @CONFIG_SCRIPT_KEYS = qw{ bin binexp initialinstalllocation installbin installscript installsitebin installsitescript installusrbinperl installvendorbin scriptdir scriptdirexp sitebin sitebinexp sitescript sitescriptexp vendorbin vendorbinexp }; sub find_yath { return $App::Yath::Script::SCRIPT if defined $App::Yath::Script::SCRIPT; my @searched; my $script = _find_yath(\@searched); return $App::Yath::Script::SCRIPT = $script if $script; die _find_yath_error(\@searched); } sub _find_yath { my ($searched) = @_; for my $candidate (_yath_scripts()) { my ($script, $need_exec) = @$candidate; push @$searched => $script; next unless -f $script && -r _; next if $need_exec && !-x _; return clean_path($script); } return undef; } # Callers run the script as an argument to perl, so it only needs to be # readable. PATH is the exception: a yath without the exec bit is not the # command someone typing 'yath' would get. sub _yath_scripts { my @scripts; # Set by the yath script itself, so it names the script running this # process tree. Under a yath run this is also how a checkout's own script # gets here: App::Yath::Script re-execs into an executable './scripts/yath' # when the current directory has one, and that script sets this to itself. push @scripts => [$ENV{YATH_SCRIPT}, 0] if $ENV{YATH_SCRIPT}; push @scripts => map { [File::Spec->catfile($_, 'yath'), 0] } _yath_script_dirs(); push @scripts => map { [File::Spec->catfile($_, 'yath'), 1] } File::Spec->path(); my %seen; return grep { !$seen{$_->[0]}++ } @scripts; } sub _yath_script_dirs { my @dirs; # An uninstalled dist is never in a Config path, so it comes first. push @dirs => _yath_dirs_from_inc(qr{^(.*)[/\\]blib[/\\](?:lib|arch)$}, 'blib', 'script'); push @dirs => grep { $_ } @Config{@CONFIG_SCRIPT_KEYS}; # A guess at the layout, so it comes after anything authoritative. push @dirs => _yath_dirs_from_inc(qr{^(.*)[/\\]lib[/\\]perl5(?:[/\\][^/\\]+)*$}, 'bin'); my %seen; return grep { $_ && !$seen{$_}++ } @dirs; } # The script may live next to the libs it belongs to without ever being # installed. CPAN smokers do this: they add each prerequisite's uninstalled # '/blib/lib' to PERL5LIB, leaving the script in '/blib/script'. # local::lib and 'cpanm -l' trees pair '/lib/perl5' with '/bin'. sub _yath_dirs_from_inc { my ($pattern, @subdirs) = @_; my @dirs; for my $inc (@INC) { next if ref $inc; next unless $inc =~ $pattern; push @dirs => File::Spec->catdir($1, @subdirs); } return @dirs; } # Failing to find the script is nearly always an environment we have not # taught find_yath about yet. Dump everything needed to teach it. sub _find_yath_error { my ($searched) = @_; my $msg = "Could not find the yath script.\n"; $msg .= "Searched:\n"; $msg .= " $_\n" for @$searched; my @mods = grep { -f File::Spec->catfile($_, 'App', 'Yath', 'Script.pm') } grep { !ref $_ } @INC; $msg .= "App::Yath::Script loaded from: " . ($INC{'App/Yath/Script.pm'} // '(not loaded)') . "\n"; $msg .= "App::Yath::Script found in: " . (@mods ? join(', ' => @mods) : '(nowhere in @INC)') . "\n"; # Some candidates are relative to the current directory, so it is needed to # make sense of them. $msg .= "Cwd: " . clean_path('.') . "\n"; $msg .= "PATH: " . ($ENV{PATH} // '(not set)') . "\n"; $msg .= "PERL5LIB: " . ($ENV{PERL5LIB} // '(not set)') . "\n"; $msg .= "\@INC:\n"; $msg .= " $_\n" for grep { !ref $_ } @INC; $msg .= "Please report this at https://github.com/Test-More/Test2-Harness/issues along with the output above.\n"; return $msg; } sub isolate_stdout { # Make $fh point at STDOUT, it is our primary output open(my $fh, '>&', STDOUT) or die "Could not clone STDOUT: $!"; select $fh; $| = 1; # re-open STDOUT redirected to STDERR open(STDOUT, '>&', STDERR) or die "Could not redirect STDOUT to STDERR: $!"; select STDOUT; $| = 1; # Yes, we want to keep STDERR selected select STDERR; $| = 1; return $fh; } sub is_generated_test_pl { my ($file) = @_; open(my $fh, '<', $file) or die "Could not open '$file': $!"; my $count = 0; while (my $line = <$fh>) { last if $count++ > 5; next unless $line =~ m/^# THIS IS A GENERATED YATH RUNNER TEST$/; return 1; } return 0; } sub find_in_updir { my $path = shift; return clean_path($path) if -f $path; my %seen; while(1) { $path = File::Spec->catdir('..', $path); my $check = eval { realpath(File::Spec->rel2abs($path)) }; last unless $check; last if $seen{$check}++; return $check if -f $check; } return; } sub _find_pfile { my ($settings, %params) = @_; croak "Settings is a required argument" unless $settings; # First do the entire search without vivify if ($params{vivify}) { my $found = find_pfile($settings, %params, vivify => 0); return $found if $found; } my $yath = $settings->harness; if (my $pfile = $yath->persist_file) { return $pfile if -f $pfile || $params{vivify}; return; # Specified, but not found and no vivify } my $basename = "yath-persist.json"; my $user = $ENV{USER}; my $hostname = hostname(); my $project = $yath->project; my @names = ($basename); @names = (@names, map { "$project-$_" } @names) if $project; @names = (@names, map { "$hostname-$_" } @names) if $hostname; @names = (@names, map { "$user-$_" } @names) if $user; @names = reverse map { ".$_" } @names; my $set_dir = $yath->persist_dir // $ENV{YATH_PERSISTENCE_DIR}; my $dir = $set_dir // $ENV{TMPDIR} // $ENV{TEMPDIR} // File::Spec->tmpdir; # If a dir was specified, or if the current dir is not writable then we must use $dir/$name if ($project || $set_dir || !-w '.') { for my $name (@names) { my $pfile = clean_path(File::Spec->catfile($dir, $name)); return $pfile if -f $pfile; } return clean_path(File::Spec->catfile($dir, $names[0])) if $params{vivify}; return; # Not found } # Fall back to using the current dir (which must be writable) for my $name (@names) { my $pfile = find_in_updir($name); return $pfile if $pfile && -f $pfile; } # Creating it here! return clean_path(File::Spec->catfile('.', $names[0])) if $params{vivify}; # Nope, nothing. return; } sub fit_to_width { my ($width, $join, $text) = @_; my @parts = ref($text) ? @$text : split /\s+/, $text; my @out; my $line = ""; for my $part (@parts) { my $new = $line ? "$line$join$part" : $part; if ($line && length($new) > $width) { push @out => $line; $line = $part; } else { $line = $new; } } push @out => $line if $line; return join "\n" => @out; } my $SEEN_ERROR = 0; sub find_pfile { my ($settings, %params) = @_; my $pfile = _find_pfile($settings, %params) or return; return $pfile unless -e $pfile; return $pfile if $params{no_checks}; return $pfile if $SEEN_ERROR; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); $data->{version} //= ''; $data->{hostname} //= ''; $data->{user} //= ''; $data->{pid} //= ''; $data->{dir} //= ''; my $hostname = hostname(); my $user = $ENV{USER}; my @bad; push @bad => "** Version mismatch, persistent runner is version $data->{version}, current is version $VERSION. **" if $data->{version} ne $VERSION; push @bad => "** Hostname mismatch, persistent runner hostname is '$data->{hostname}', current hostname is '$hostname'. **" if $data->{hostname} ne $hostname; push @bad => "** User mismatch, persistent runner user is '$data->{user}', current user is '$user'. **" if $data->{user} ne $user; push @bad => "** Workdir missing, persistent runner is supposed to be at '$data->{dir}', but it does not exist. **" unless -d $data->{dir}; push @bad => "** PID not running, persistent runner is supposed to be running with PID '$data->{pid}', but it is not. **" unless kill(0, $data->{pid}); return $pfile unless @bad; my $break = ('=' x 120) . "\n"; my $msg = join "\n" => $break, @bad, <<" EOT", $break; Errors like this usually indicate that the persistent runner has gone away. Maybe the system was shut down improperly, or maybe the process was killed too quickly to clean up after itself. Here is the information indicated by the persistence file: Runner PID: $data->{pid} Runner Vers: $data->{version} Runner user: $data->{user} Runner host: $data->{hostname} Working dir: $data->{dir} If the persistent runner is truly gone you should delete the following file to continue: $pfile EOT $SEEN_ERROR = 1; die $msg unless $params{no_fatal}; warn $msg unless $params{no_warn}; return $pfile; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Util - General utilities for yath that do not fit anywhere else. =head1 DESCRIPTION This package exports several tools used throughout yath that did not fit into any other package. =head1 SYNOPSIS use App::Yath::Util qw{ find_pfile find_in_updir is_generated_test_pl fit_to_width isolate_stdout find_yath }; =head1 EXPORTS Note that nothing is exported by default, you must request each function to import. =over 4 =item $path_to_pfile = find_pfile($settings, %params) The first argument must be an instance of L. Currently the only supported param is C, when set to true the pfile will be created if one does not already exist. The pfile is a file that tells yath that a persistent runner is active, and how to communicate with it. =item $path_to_file = find_in_updir($file_name) Look for C<$file_name> in the current directory or any parent directory. =item $bool = is_generated_test_pl($path_to_test_file) Check if the specified test file was generated by the C command. =item fit_to_width($width, $join, $text) This will split the C<$text> on space, and then recombine it using C<$join> inserting newlines as necessary in an attempt to fit the text into C<$width> horizontal characters. If any words are larger than C<$width> they will not be split and text-wrapping may occur if used for terminal display. =item $stdout = isolate_stdout() This will close STDOUT and reopen it to point at STDERR. The result of this is that any print statement that does not specify a filehandle will print to STDERR instead of STDOUT, in addition any print directly to STDOUT will instead go to STDERR. A filehandle to the real STDOUT is returned for you to use when you actually want to write to STDOUT. This is used by some yath processes that need to print structured data to STDOUT without letting any third part modules they may load write to the real STDOUT. =item $path_to_script = find_yath() This will attempt to find the C command line script. When possible this will return the path that was used to launch yath. If C<$App::Yath::Script::SCRIPT> is not set the following are searched, in order: =over 8 =item The C environment variable The yath script sets this, so it identifies the script that launched the current process tree. Under a yath run this also covers a checkout's own script: L re-execs into an executable C<./scripts/yath> of its own accord when the current directory has one, and the script it re-execs into sets this variable to itself. =item C<< /blib/script >> for any C<< /blib/lib >> or C<< /blib/arch >> in C<@INC> This finds the script when the L distribution is being used uninstalled from its build directory, as CPAN smokers do. =item The paths specified in the L module =item C<< /bin >> for any C<< /lib/perl5 >> in C<@INC> Anything after C is ignored, so C<< /lib/perl5/5.36.0/x86_64-linux >> also gives C<< /bin >>. This finds the script in a L or C tree. =item The C environment variable =back Every candidate but the C ones only needs to be readable, because the script is run as an argument to perl rather than executed. A candidate found via C must also be executable. This will throw an exception if the script cannot be found. The exception lists every path that was checked, along with the current directory, C<@INC>, C, and C, so the missing case can be reported. Note: The result is cached so that subsequent calls will return the same path even if something installs a new yath script in another location that would otherwise be found first. This guarantees that a single process will not switch scripts. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 COPYRIGHT Copyright 2020 Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut Test2000755001750001750 015267772575 16407 5ustar00exodistexodist000000000000Test2-Harness-1.000182/libHarness.pm100644001750001750 203415267772575 20507 0ustar00exodistexodist000000000000Test2-Harness-1.000182/lib/Test2package Test2::Harness; use strict; use warnings; our $VERSION = '1.000182'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness - A new and improved test harness with better L integration. =head1 DESCRIPTION Test2::Harness is the backend code that handles running/processing the tests. In general a user will not use it directly, instead you should probably be looking at L which is the UI layer built around Test2::Harness. =head1 SEE ALSO The primary documentation can be found in L. =head1 SOURCE The source code repository for Test2-Harness can be found at F. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist7@gmail.comE =back =head1 COPYRIGHT Copyright 2020 Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut integration000755001750001750 015267772575 17426 5ustar00exodistexodist000000000000Test2-Harness-1.000182/thelp.t100644001750001750 471015267772575 20705 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; yath( command => 'help', args => [], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{^Usage: .*yath COMMAND \[options\]$}m, "Found usage statement"); like($out->{output}, qr{^Available Commands:$}m, "available commands"); # Sample some essential commands like($out->{output}, qr{^\s+help: Show the list of commands$}m, "'help' command is listed"); like($out->{output}, qr{^\s+test: Run tests$}m, "'test' command is listed"); like($out->{output}, qr{^\s+start: Start the persistent test runner$}m, "'start' command is listed"); }, ); yath( command => 'help', args => ['help'], exit => 0, test => sub { my $out = shift; my $script = find_yath(); $out->{output} =~ s/^Detected App::Yath::Script::V# modules in local.*\n//m; is($out->{output}, <<" EOT", "Got output for the help command"); help - Show the list of commands This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. Usage: $script help EOT }, ); yath( command => 'help', args => ['test'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{^test - Run tests$}m, "Found summary"); like($out->{output}, qr{^\[YATH OPTIONS\]$}m, "Found yath options"); like($out->{output}, qr{^ Developer$}m, "Found Developer category"); like($out->{output}, qr{^ Help and Debugging$}m, "Found help category"); like($out->{output}, qr{^ Plugins$}m, "Found plugin category"); like($out->{output}, qr{^\[COMMAND OPTIONS\]$}m, "Found command options"); like($out->{output}, qr{^ Display Options$}m, "Found display category"); like($out->{output}, qr{^ Formatter Options$}m, "Found formatter category"); like($out->{output}, qr{^ Logging Options$}m, "Found logging category"); like($out->{output}, qr{^ Run Options$}m, "Found run category"); like($out->{output}, qr{^ Runner Options$}m, "Found runner category"); like($out->{output}, qr{^ Workspace Options$}m, "Found workspace category"); }, ); done_testing; init.t100644001750001750 137215267772575 20721 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use Cwd qw/cwd/; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $orig = cwd(); my $dir = tempdir(CLEANUP => 1); chdir($dir); yath( command => 'init', args => [], exit => 0, test => sub { like($_, qr/Writing test\.pl/, "Short message"); ok(-e 'test.pl', "Added test.pl"); open(my $fh, '<', 'test.pl') or die $!; my $found = 0; while (my $line = <$fh>) { next unless $line =~ m/THIS IS A GENERATED YATH RUNNER TEST/; $found++; last; } ok($found, "Found generated note"); }, ); chdir($orig); done_testing; test.t100644001750001750 1707615267772575 20765 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; use Config qw/%Config/; use File::Temp qw/tempfile/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '--ext=tx'], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); unlike($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'test', args => [$dir, '-vvv'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/No tests were seen!/, "Got error message"); }, ); note q[Checking --exclude-file option when a file is provided on the command line]; yath( command => 'test', args => [ "--exclude-file=$dir/fail.txx", "$dir/pass.tx", "$dir/fail.txx" ], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-file' option"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); note q[Checking --exclude-list option when a file is provided on the command line]; my ($fh, $list_name) = tempfile(UNLINK => 1); print $fh "# GENERATED YATH TEST EXCLUSION LIST\n#$dir/pass.tx\n$dir/fail.txx"; close($fh); yath( command => 'test', args => ["--exclude-list=$list_name", "$dir/pass.tx", "$dir/fail.txx"], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-list' option with a file"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); { note q[Testsuite using symlinks: check that $0 is preserved]; my $sdir = $dir . '-symlinks'; my $base = "$sdir/_base.xt"; my $symlink = "$sdir/symlink_to_base.xt"; unlink $symlink if -e $symlink; if ( eval{ symlink('_base.xt', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=xt' ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); }, ); yath( command => 'test', args => [ $base, $symlink ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); }, ); } } { note q[Testsuite checking broken symlinks #103]; my $sdir = $dir . '-broken-symlinks'; my $symlink = "$sdir/broken-symlink.tx"; unlink $symlink if -e $symlink; if ( eval{ symlink('nothing-there', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=tx' ], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED}, q[no failures]); unlike($out->{output}, qr{\Qbroken-symlink.tx\E}, q[no mention of broken-symlink.tx] ); like($out->{output}, qr{PASSED.*\Qt/integration/test-broken-symlinks/pass.tx\E}, q[t/integration/test-broken-symlinks/pass.tx PASSED]); }, ); } } { note "Testing durations when provided using a json file"; my $sdir = $dir . '-durations'; # using a directory yath( command => 'test', args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', $sdir, ], exit => 0, test => sub { my $out = shift; my @lines = sort { my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; return $aj <=> $bj; } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; is \@lines, array { item match qr{\Qslow-01.tx\E}; item match qr{\Qslow-02.tx\E}; item match qr{\Qfast-01.tx\E}; item match qr{\Qfast-02.tx\E}; item match qr{\Qfast-03.tx\E}; item match qr{\Qfast-04.tx\E}; end; }, "tests are run in order from slow to fast - using a directory"; }, ); # using a list of files my @files = ( "$sdir/fast-01.tx", "$sdir/fast-02.tx", "$sdir/fast-03.tx", "$sdir/fast-04.tx", "$sdir/slow-01.tx", "$sdir/slow-02.tx" ); my %hfiles = map { $_ => 1 } @files; yath( command => 'test', args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', keys %hfiles, # random order ], exit => 0, test => sub { my $out = shift; my @lines = sort { my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; return $aj <=> $bj; } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; is \@lines, array { item match qr{\Qslow-01.tx\E}; item match qr{\Qslow-02.tx\E}; item match qr{\Qfast-01.tx\E}; item match qr{\Qfast-02.tx\E}; item match qr{\Qfast-03.tx\E}; item match qr{\Qfast-04.tx\E}; end; }, "tests are run in order from slow to fast - using a list of files"; }, ); } if ("$]" >= 5.026) { note q[Checking %INC and @INC setup]; local @INC = map { clean_path( $_ ) } grep { $_ ne '.' } @INC; local $ENV{PERL5LIB} = join $Config{path_sep}, map { clean_path( $_ ) } grep { $_ ne '.' } split( $Config{path_sep}, $ENV{PERL5LIB} ); local $ENV{PERL_USE_UNSAFE_INC}; delete $ENV{PERL_USE_UNSAFE_INC}; my $sdir = $dir . '-inc'; yath( command => 'test', args => ['--ext=tx', '--no-unsafe-inc', $sdir], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } yath( command => 'test', args => [$dir, '--ext=txxx', '::', 'foobar', 'baz' ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED}, 'Args after arisdottle are added to @ARGV'); }, ); done_testing; lib000755001750001750 015267772575 15651 5ustar00exodistexodist000000000000Test2-Harness-1.000182/tTestBarrier.pm100644001750001750 333115267772575 20575 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/libpackage TestBarrier; use strict; use warnings; use Time::HiRes qw/sleep time/; use Exporter qw/import/; our @EXPORT_OK = qw/barrier_wait/; # Fixtures that have to be running at the same time as their siblings used to # sleep and hope the overlap landed inside the sleep. That makes the fixture # slow, and it makes the assertion a coin flip on a machine slow enough to # spend the whole sleep starting the next job. # # This makes the overlap a fact instead: every participant records that it # arrived, then waits until as many participants have arrived as the run # expects. # # Markers are never removed. A participant that starts after enough others # have already arrived therefore does not wait at all, which is what keeps a # run with more tests than slots from stalling on its last, unpaired test. sub barrier_wait { my %params = @_; my $dir = $params{dir} // $ENV{TEST_BARRIER_DIR} or die "No barrier directory (pass one, or set TEST_BARRIER_DIR)"; my $want = $params{count} // $ENV{TEST_BARRIER_COUNT} // 2; # A ceiling, not a wait. It only comes into play when something is wrong # and the other participants are never going to arrive; reaching it fails # the assertion the barrier exists to make, which is the point. my $ceiling = $params{ceiling} // $ENV{TEST_BARRIER_CEILING} // 30; open(my $fh, '>', "$dir/$$") or die "Could not write barrier marker: $!"; close($fh); my $start = time; while (1) { opendir(my $dh, $dir) or die "Could not open barrier dir '$dir': $!"; my $have = grep { !m/^\.\.?$/ } readdir($dh); closedir($dh); return $have if $have >= $want; return $have if time - $start > $ceiling; sleep 0.05; } } 1; author000755001750001750 015267772575 16575 5ustar00exodistexodist000000000000Test2-Harness-1.000182/xtpod-spell.t100644001750001750 431315267772575 21022 0ustar00exodistexodist000000000000Test2-Harness-1.000182/xt/authoruse strict; use warnings; use Test2::Require::AuthorTesting; use Test2::Require::Module 'Test::Spelling'; use Test::Spelling; my @stopwords; for () { chomp; push @stopwords, $_ unless /\A (?: \# | \s* \z)/msx; # skip comments, whitespace } print "### adding stopwords @stopwords\n"; add_stopwords(@stopwords); local $ENV{LC_ALL} = 'C'; set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok; __DATA__ ## personal names binkley Bowden Daly dfs Eryq EXODIST Fergal Glew Granum Oxley Pritikin Schwern Skoll Slaymaker ZeeGee Exodist ## proper names Fennec ICal xUnit ## test jargon Diag diag isnt subtest subtests testsuite testsuites TODO todo todos untestable EventFacet EventFacets renderers xt ## computerese blackbox BUF codeblock combinatorics dir getline getlines getpos Getter getters HashBase heisenbug IPC NBYTES param perlish perl-qa POS predeclaring rebless refactoring refcount Reinitializes SCALARREF setpos Setter SHM sref subevent subevents testability TIEHANDLE tie-ing unoverload VMS vmsperl YESNO ansi html HASHBASE renderer SHBANG JSONL YATH jsonl rc tmpdir utils workdir Postfix env bz bzip preloaded Yath vv PRELOAD yath preloads Preload pPlugin tlib preload loadim preloading shm qvf mem addons argv arrayref backcompat cli cmd daemonize dep dev dirs entrypoint libs params Params parsable pfile sha shbang subref uncompress yaml durations affordance ## module and class names DepTracer SharedJobSlots TimeTracker timetracker YathUI ## acronyms and platform names CI UI ENVVAR bsd macos ## other jargon, slang 17th AHHHHHHH Dummy globalest Hmmm cid tid pid SIGINT SIGALRM SIGHUP SIGTERM SIGUSR1 SIGUSR2 webhook integrations IMMISCIBLE POSTEXIT lff backfill ESYNC muxed ## option names, flags, and values, from the auto-generated command POD. ## These only appear in a built distribution, not in the source tree. agg api ByRun ByTest dbi depmap Dfoo Dlib Dt io iso msg MyFinder nonsub nytprof pPLUGIN proc procname ps qvfd sharedjobslots speedtag tmp ui yathui YathUIDB ## halves of the example git sha in --git-change-base abe df ## Spelled correctly according to google: recognise recognises judgement ## stall diagnostics Ctrl immiscible exec'd ptrace stateful unparseable Yama retry.t100644001750001750 1065515267772575 21147 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; # HARNESS-DURATION-LONG use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; run_tests('test'); run_test_command_only_cases(); my $project = "asgadfgds"; yath( command => 'start', pre => ['--project', $project], args => [], exit => 0, test => sub { run_tests('run'); yath(command => 'stop', args => [], exit => 0); } ); sub run_tests { my ($cmd) = @_; yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3'], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; is($final->{facet_data}->{harness_final}->{pass}, T(), "Passed in log"); }, ); yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3', '--env-var' => "FAIL_ONCE=1", '-v'], log => 1, exit => 0, debug => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; ok($retry_data, "got retry data") or return; my ($uuid, $tries, $file, $status) = @$retry_data; is($tries, 2, "Tried twice"); like($file, qr{retry\.tx}, "Retried the right file"); is($status, 'YES', "Eventually passed"); }, ); yath( command => $cmd, pre => ['--project', $project], args => [$dir, '--ext=tx', '-r3', '--env-var' => "FAIL_ALWAYS=1"], log => 1, exit => T(), test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; is($tries, 4, "Tried 4 times: 1 run + 3 retries"); like($file, qr{retry\.tx}, "Retried the right file"); is($status, 'NO', "Never passed"); }, ); } # Both cases below always use the "test" command, so the "run" pass of # run_tests() used to repeat them unchanged -- including a full 20 second # event timeout -- and assert the same things about the same run. sub run_test_command_only_cases { { note q[Retrying a symlink]; my $sdir = $dir . '-symlinks'; my $symlink = "$sdir/symlink.tl"; unlink $symlink if -e $symlink; if ( eval{ symlink('retry.tx', $symlink) } ) { yath( command => 'test', args => [$sdir, '--ext=tl', '--retry' => 1, '--env-var' => "FAIL_ONCE=1", '-v' ], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; is $tries, 2, 'retried a broken symlink'; is $file, 't/integration/retry-symlinks/symlink.tl', "using symlink name"; is $status, 'YES', 'Succeeded Eventually: YES'; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } } { note q[Retrying a test failing due to a timeout]; my $sdir = $dir . '-timeout'; yath( command => 'test', args => [$sdir, '--ext=tx', '--retry' => 1, '--env-var' => "FAIL_ONCE=1", '-v' ], log => 1, exit => 0, test => sub { my $out = shift; my $final = ($out->{log}->poll())[-2]; my $retry_data = $final->{facet_data}->{harness_final}->{retried}->[0]; my ($uuid, $tries, $file, $status) = @$retry_data; #note $out->{output}; is $tries, 2, 'retried a test when failing due to a timeout'; is $file, 't/integration/retry-timeout/retry.tx', "retry.txt test"; is $status, 'YES', 'Succeeded Eventually: YES'; unlike($out->{output}, qr{FAILED}, q[no failures]); }, ); } } done_testing; smoke.t100644001750001750 363315267772575 21076 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', pre => ['-p+SmokePlugin'], args => [$dir, '--ext=tx'], log => 1, exit => 0, test => \&the_test, ); yath( command => 'test', pre => ['-p+SmokePlugin'], args => [$dir, '-j3', '--ext=tx'], log => 1, exit => 0, test => \&the_test, ); sub the_test { my $out = shift; my $log = $out->{log}; my @order; my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; if (my $l = $f->{harness_job_start}) { push @order => $l; } } # Check for additional events, probably should not have any, but we may hit # a buffering limit in the log reader and need additional polls. push @events => $log->poll; } # We care about the order in which events happened based on time stamp, not the # order in which they were collected, which may be different. Here we will sort # based on stamp. @order = sort { $a->{stamp} <=> $b->{stamp} } @order; is( [map { $_->{rel_file} } @order[0 .. 3]], bag { item match qr/a\.tx$/; item match qr/c\.tx$/; item match qr/e\.tx$/; item match qr/g\.tx$/; end; }, "The 4 smoke tests ran first" ); is( [map { $_->{rel_file} } @order[4 .. 7]], bag { item match qr/b\.tx$/; item match qr/d\.tx$/; item match qr/f\.tx$/; item match qr/h\.tx$/; end; }, "The 4 non-smoke tests ran later" ); } done_testing; times.t100644001750001750 155315267772575 21100 0ustar00exodistexodist000000000000Test2-Harness-1.000182/t/integrationuse Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $out = yath( command => 'test', args => [$dir, '--ext=tx'], log => 1, exit => 0, ); my $log = $out->{log}->name; yath( command => 'times', args => [$log], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{Total .* Startup .* Events .* Cleanup .* File}m, "Got header"); like($out->{output}, qr{t/integration/times/pass\.tx}m, "Got pass line"); like($out->{output}, qr{t/integration/times/pass2\.tx}m, "Got pass2 line"); like($out->{output}, qr{TOTAL}m, "Got total line"); }, ); done_testing; Option.pm100644001750001750 10013515267772575 21041 0ustar00exodistexodist000000000000Test2-Harness-1.000182/lib/App/Yathpackage App::Yath::Option; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/confess/; use Test2::Harness::Util::HashBase qw{ 1, c => 1, s => 1, m => 1, d => 1, D => 1, h => 1, H => 1, ); sub valid_type { $TYPES{$_[-1]} } my %LONG_TO_SHORT_TYPES = ( bool => 'b', boolean => 'b', count => 'c', counter => 'c', counting => 'c', scalar => 's', string => 's', number => 's', multi => 'm', multiple => 'm', list => 'm', array => 'm', default => 'd', def => 'd', 'multi-def' => 'D', 'multiple-default' => 'D', 'list-default' => 'D', 'array-default' => 'D', 'hash' => 'h', 'hash-list' => 'H', ); sub canon_type { $LONG_TO_SHORT_TYPES{$_[-1]} } my %REQUIRES_ARG = (s => 1, m => 1, h => 1, H => 1); sub requires_arg { $REQUIRES_ARG{$_[0]->{+TYPE}} } my %ALLOWS_ARG = (d => 1, D => 1); sub allows_arg { $ALLOWS_ARG{$_[0]->{+TYPE}} || $REQUIRES_ARG{$_[0]->{+TYPE} } } sub init { my $self = shift; confess "You must specify 'title' or both 'field' and 'name'" unless $self->{+TITLE} || ($self->{+FIELD} && $self->{+NAME}); confess "The 'prefix' attribute is required" unless $self->{+PREFIX}; confess "The 'alt' attribute must be an array-ref" if $self->{+ALT} && ref($self->{+ALT}) ne 'ARRAY'; if (my $title = $self->{+TITLE}) { $self->{+FIELD} //= $title; $self->{+NAME} //= ($self->{+FROM_PLUGIN} && $self->{+PREFIX}) ? "$self->{+PREFIX}-$title" : $title; } $self->{+FIELD} =~ s/-/_/g; $self->{+NAME} =~ s/_/-/g; if (my $class = $self->{+BUILDS}) { confess "class '$class' does not have a '$self->{+FIELD}' method" unless $class->can($self->{+FIELD}) || $self->{+IGNORE_FOR_BUILD}; } $self->{+TYPE} //= 'b'; $self->{+TYPE} = $self->canon_type($self->{+TYPE}) // $self->{+TYPE} if length($self->{+TYPE}) > 1; confess "Invalid type '$self->{+TYPE}'" unless $self->valid_type($self->{+TYPE}); if ($self->{+TYPE} eq 'd' || $self->{+TYPE} eq 'D') { $self->{+AUTOFILL} //= 1; } elsif(defined $self->{+AUTOFILL}) { confess "'autofill' not supported for this type ('$self->{+TYPE}')"; } if (my $def = $self->{+DEFAULT}) { my $ref = ref($def); confess "'default' must be a simple scalar, or a coderef, got a '$ref'" if $ref && $ref ne 'CODE'; } for my $key (NORMALIZE(), ACTION()) { my $val = $self->{$key} or next; my $ref = ref($val) || 'not a ref'; next if $ref eq 'CODE'; confess "'$key' must be undef, or a coderef, got '$ref'"; } $self->{+TRACE} //= [caller(1)]; $self->{+CATEGORY} //= 'NO CATEGORY - FIX ME'; $self->{+DESCRIPTION} //= 'NO DESCRIPTION - FIX ME'; for my $key (sort keys %$self) { confess "'$key' is not a valid option attribute" unless $self->can(uc($key)); } return $self; } sub applicable { my $self = shift; my ($options) = @_; my $cb = $self->{+APPLICABLE} or return 1; return $self->$cb($options); } sub long_args { my $self = shift; return ($self->{+NAME}, @{$self->{+ALT} || []}); } sub option_slot { my $self = shift; my ($settings) = @_; confess "A settings instance is required" unless $settings; return $settings->define_prefix($self->{+PREFIX})->vivify_field($self->{+FIELD}); } sub get_default { my $self = shift; for my $var (@{$self->{+ENV_VARS} // []}) { my ($neg) = $var =~ s/^(!)//; next unless exists $ENV{$var}; return !$ENV{$var} if $neg; return $ENV{$var}; } if (defined $self->{+DEFAULT}) { my $def = $self->{+DEFAULT}; return $self->$def() if ref($def); return $def; } return 0 if $self->{+TYPE} eq 'c' || $self->{+TYPE} eq 'b'; return [] if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return {} if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; return undef; } sub get_normalized { my $self = shift; my ($raw) = @_; return $self->{+NORMALIZE}->($raw) if $self->{+NORMALIZE}; return $raw ? 1 : 0 if $self->{+TYPE} eq 'b'; if (lc($self->{+TYPE}) eq 'h') { my ($key, $val) = split /=/, $raw, 2; if ($self->{+TYPE} eq 'H') { $val //= ''; $val = [split /,/, $val]; return [$key, $val]; } return [$key, $val // 1]; } return $raw; } my %HANDLERS = ( c => sub { ${$_[0]}++ }, m => sub { push @{${$_[0]} //= []} => $_[1] && ref($_[1]) eq 'ARRAY' ? @{$_[1]} : $_[1] }, D => sub { push @{${$_[0]} //= []} => $_[1] && ref($_[1]) eq 'ARRAY' ? @{$_[1]} : $_[1] }, h => sub { my $hash = ${$_[0]} //= {}; my $key = $_[1]->[0]; my $val = $_[1]->[1]; push @{$hash->{'@'} //= []} => $key unless $hash->{$key}; $hash->{$key} = $val; }, H => sub { my $hash = ${$_[0]} //= {}; my $key = $_[1]->[0]; my $vals = $_[1]->[1]; push @{$hash->{'@'} //= []} => $key unless $hash->{$key}; push @{$hash->{$key} //= []} => @$vals; }, ); sub handle { my $self = shift; my ($raw, $settings, $options, $list) = @_; confess "A settings instance is required" unless $settings; confess "An options instance is required" unless $options; my $slot = $self->option_slot($settings); my $norm = $self->get_normalized($raw); my $handler = $HANDLERS{$self->{+TYPE}} //= sub { ${$_[0]} = $_[1] }; return $self->{+ACTION}->($self->{+PREFIX}, $self->{+FIELD}, $raw, $norm, $slot, $settings, $handler, $options) if $self->{+ACTION}; return $handler->($slot, $norm); } sub handle_negation { my $self = shift; my ($settings, $options) = @_; confess "A settings instance is required" unless $settings; confess "An options instance is required" unless $options; my $slot = $self->option_slot($settings); return $self->{+NEGATE}->($self->{+PREFIX}, $self->{+FIELD}, $slot, $settings, $options) if $self->{+NEGATE}; return $$slot = 0 if $self->{+TYPE} eq 'b' || $self->{+TYPE} eq 'c'; return @{$$slot //= []} = () if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return %{$$slot //= {}} = () if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; return $$slot = undef; } sub trace_string { my $self = shift; my $trace = $self->{+TRACE} or return "[UNKNOWN]"; return "$trace->[1] line $trace->[2]"; } my %TYPE_LONG_ARGS = ( b => [''], c => [''], s => [' ARG', '=ARG'], m => [' ARG', '=ARG'], d => ['[=ARG]'], D => ['[=ARG]'], h => [' KEY=VAL', '=KEY=VAL'], H => [' KEY=VAL1,VAL2,...', '=KEY=VAL1,VAL2,...'], ); my %TYPE_SHORT_ARGS = ( b => [''], c => [''], s => [' ARG', '=ARG'], m => [' ARG', '=ARG'], d => ['[=ARG]', '[ARG]'], D => ['[=ARG]', '[ARG]'], h => [' KEY=VAL', '=KEY=VAL'], H => [' KEY=VAL1,VAL2,...', '=KEY=VAL1,VAL2,...'], ); my %TYPE_NOTES = ( 'c' => "Can be specified multiple times", 'm' => "Can be specified multiple times", 'D' => "Can be specified multiple times", 'h' => "Can be specified multiple times", 'H' => "Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together.", ); sub cli_docs { my $self = shift; my @forms = (map { "--$self->{+NAME}$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); for my $alt (@{$self->{+ALT} || []}) { push @forms => (map { "--$alt$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); } push @forms => map { "-$self->{+SHORT}$_" } @{$self->{+SHORT_EXAMPLES} || $TYPE_SHORT_ARGS{$self->{+TYPE}}} if $self->{+SHORT}; push @forms => "--no-$self->{+NAME}"; my @out; require App::Yath::Util; require Test2::Util::Term; my $width = Test2::Util::Term::term_size() - 20; $width = 80 unless $width && $width >= 80; push @out => App::Yath::Util::fit_to_width($width, ", ", \@forms); my $desc = App::Yath::Util::fit_to_width($width, " ", $self->{+DESCRIPTION}); $desc =~ s/^/ /gm; push @out => $desc; push @out => "\n Can also be set with the following environment variables: " . join(", ", @{$self->{+ENV_VARS}}) if $self->{+ENV_VARS}; push @out => "\n Note: " . $TYPE_NOTES{$self->{+TYPE}} if $TYPE_NOTES{$self->{+TYPE}}; return join "\n" => @out; } sub pod_docs { my $self = shift; my @forms = (map { "--$self->{+NAME}$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); for my $alt (@{$self->{+ALT} || []}) { push @forms => (map { "--$alt$_" } @{$self->{+LONG_EXAMPLES} || $TYPE_LONG_ARGS{$self->{+TYPE}}}); } push @forms => map { "-$self->{+SHORT}$_" } @{$self->{+SHORT_EXAMPLES} || $TYPE_SHORT_ARGS{$self->{+TYPE}}} if $self->{+SHORT}; push @forms => "--no-$self->{+NAME}"; my @out = map { "=item $_" } @forms; push @out => $self->{+DESCRIPTION}; push @out => "Can also be set with the following environment variables: " . join(", ", map { "C<$_>" } @{$self->{+ENV_VARS}}) if $self->{+ENV_VARS}; push @out => $TYPE_NOTES{$self->{+TYPE}} if $TYPE_NOTES{$self->{+TYPE}}; return join("\n\n" => @out) . "\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Option - Representation of a yath option. =head1 DESCRIPTION This class represents a single command line option for yath. =head1 SYNOPSIS You usually will not be creating option instances directly. Usually you will use App::Yath::Options which provides sugar, and helps make sure options get to the right place. use App::Yath::Options; # You can specify a single option: option color => ( prefix => 'display', category => "Display Options", description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); # If you are specifying multiple options you can use an option_group to # define common parameters. option_group {prefix => 'display', category => "Display Options"} => sub { option color => ( description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); option verbose => ( short => 'v', type => 'c', description => "Be more verbose", default => 0, ); }; =head1 ATTRIBUTES These can be provided at object construction, or are generated internally. =head2 CONSTRUCTION ONLY =over 4 =item applicable => sub { ... } This is callback is used by the C<applicable()> method. option foo => ( ..., applicable => sub { my ($opt, $options) = @_; ... return $bool; }, ); =back =head2 READ-ONLY =head3 REQUIRED =over 4 =item $class->new(prefix => 'my_prefix') =item $scalar = $opt->prefix() A prefix is required. All options have their values inserted into the settings structure, an instance of L<Test2::Harness::Settings>. The structure is C<< $settings->PREFIX->OPTION >>. If you do not specify a C<name> attribute then the default name will be C<PREFIX-TITLE>. The name is the main command line argument, so C<--PREFIX-TITLE> is the default name. =item $class->new(type => $type) =item $type = $opt->type() All options must have a type, if non is specified the default is C<'b'> aka boolean. Here are all the possible types, along with their aliases. You may use the type character, or any of the aliases to specify that type. =over 4 =item b bool boolean True of false values, will be normalized to 0 or 1 in most cases. =item c count counter counting Counter, starts at 0 and then increments every time the option is used. =item s scalar string number Requires an argument which is treated as a scalar value. No type checking is done by the option itself, though you can check it using C<action> or C<normalize> callbacks which are documented under those attributes. =item m multi multiple list array Requires an argument which is treated as a scalar value. Can be used multiple times. All arguments provided are appended to an array. =item d def default Argument is optional, scalar when provided. C<--opt=arg> to provide an argument, C<--opt arg> will not work, C<arg> will be seen as its own item on the command line. Can be specified without an arg C<--opt> to signify a default argument should be used (set via the C<action> callback, not the C<default> attribute which is a default value regardless of if the option is used.) Real world example from the debug options (simplified for doc purposes): option summary => ( type => 'd', description => "Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/summary.json'], # New way to specify an auto-fill value for when no =VAL is provided. # If you do not specify this the default autofill is '1' for legacy support. autofill => 'VALUE', # Old way to autofill a value (default is 1 for auto-fill) # Using autofill is significantly better. # You can also use action for additional behavior along with autofill, # but the default will be your auto-fill value, not '1'. action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; # $norm will be '1' if option was used without an argument, so we # just use the provided value when it is not 1'. return $$slot = $norm unless $norm eq '1'; # $norm was 1, so this is our no-arg "default" behavior # Do nothing if a value is already set return if $$slot; # Set the default value of 'summary.json' return $$slot = 'summary.json'; }, ); }; =item D multi-def multiple-default list-default array-default This is a combination of C<d> and C<m>. You can use the opt multiple times to list multiple values, and you can call it without args to add a set of "default" values (not to be confused with THE default attribute, which is used even if the option never appears on the command line.) Real world example (simplified for doc purposes): option dev_libs => ( type => 'D', short => 'D', name => 'dev-lib', category => 'Developer', description => 'Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch.', long_examples => ['', '=lib'], short_examples => ['', '=lib', 'lib'], # New way to specify the auto-fill values. This may be a single scalar, # or an arrayref. autofill => [ 'lib', 'blib/lib', 'blib/arch' ], # Old way to specify the auto-fill values. action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; # If no argument was provided use the 'lib', 'blib/lib', and 'blib/arch' defaults. # If an argument was provided, use it. push @{$$slot} => ($norm eq '1') ? ('lib', 'blib/lib', 'blib/arch') : ($norm); }, ); =item h hash The hash type. Each time the option is used it is to add a single key/value pair to the hash. Use an C<=> sign to split the key and value. The option can be used multiple times. A value is required. yath --opt foo=bar --opt baz=bat =item H hash-list Similar to the 'h' type except the key/value pair expects a comma separated list for the value, and it will be placed under the key as an arrayref. yath --opt foo=a,b,c --opt bar=1,2,3 The yath command above would produce this structure: { foo => ['a', 'b', 'c'], bar => ['1', '2', '3'], } =back =item $class->new(title => 'my_title') =item $title = $opt->title() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. If your title is C<'foo-bar_baz'> then your field will be C<'foo_bar_baz'> and your name will be C<'$PREFIX-foo-bar-baz'>. Basically title is used to generate a sane field and/or name if neither are specified. For field all dashes are changed to underscores. The field is used as a key in the settings: C<< $settings->prefix->field >>. For the name all underscores are changed to dashes, if the option is provided by a plugin then C<'prefix-'> is prepended as well. The name is used for the command line argument C<'--name'>. If you do not want/like the name and field generated from a title then you can specify a name or title directly. =item $class->new(name => 'my-name') =item $name = $opt->name() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. This name is used as your primary command line argument. If your name is C<foo> then your command line argument is C<--foo>. =item $class->new(field => 'my_field') =item $field = $opt->field() You B<MUST> specify either a title, or BOTH a name and field. If you only specify a title it will be used to generate the name and field. The field is used in the settings hash. If your field is C<foo> then your settings path is C<< $setting->prefix->foo >>. =back =head3 OPTIONAL =over 4 =item $class->new(action => sub ...) =item $coderef = $opt->action() option foo => ( ..., action => sub { my ($prefix, $field_name, $raw_value, $normalized_value, $slot_ref, $settings, $handler, $options) = @_; # If no action is specified the following is all that is normally # done. Having an action means this is not done, so if you want the # value stored you must call this or similar. $handler->($slot, $normalized_value); }, ); =over 4 =item $prefix The prefix for the option, specified when the option was defined. =item $field_name The field for the option, specified when the option was defined. =item $raw_value The value/argument provided at the command line C<--foo bar> would give us C<"bar">. This is BEFORE any processing/normalizing is done. For options that do not take arguments, or where arguments are optional and none are provided, this will be '1'. =item $normalized_value If a normalize callback was provided this will be the result of putting the $raw_value through the normalize callback. =item $slot_ref This is a scalar reference to the settings slot that holds the option value(s). The default behavior when no action is specified is usually one of these: $$slot_ref = $normalized_value; push @{$$slot_ref} => $normalized_value; However, to save yourself trouble you can use the C<$handler> instead (see below). =item $settings The L<Test2::Harness::Settings> instance. =item $handler A callback that "does the right thing" as far as setting the value in the settings hash. This is what is used when you do not set an action callback. $handler->($slot, $normalized_value); =item $options The L<App::Yath::Options> instance this options belongs to. This is mainly useful if you have an option that may add even more options (such as the C<--plugin> option can do). Note that if you do this you should also set the C<adds_options> attribute to true, if you do not then the options list will not be refreshed and your new options may not show up. =back =item $class->new(adds_options => $bool) =item $bool = $opt->adds_options() If this is true then it means using this option could result in more options being available (example: Loading a plugin). =item $class->new(alt => ['alt1', 'alt2', ...]) =item $arrayref = $opt->alt() Provide alternative names for the option. These are aliases that can be used to achieve the same thing on the command line. This is mainly useful for backcompat if an option is renamed. =item $class->new(builds => 'My::Class') =item $my_class = $opt->builds() If this option is used in the construction of another object (such as the group it belongs to is composed of options that translate 1-to-1 to fields in another object to build) then this can be used to specify that. The ultimate effect is that an exception will be thrown if that class does not have the correct attribute. This is a safety net to catch errors early if field names change, or are missing between this representation and the object being composed. =item $class->new(category => 'My Category') =item $category = $opt->category() This is used to sort/display help and POD documentation for your option. If you do not provide a category it is set to C<'NO CATEGORY - FIX ME'>. The default value makes sure everyone knows that you do not know what you are doing :-). =item $class->new(clear_env_vars => $bool) =item $bool = $opt->clear_env_vars() This option is only useful when paired with the C<env_vars> attribute. Example: option foo => ( ... env_vars => ['foo', 'bar', 'baz'], clear_env_vars => 1, ): In this case you are saying option foo can be set to the value of C<$ENV{foo}>, C<$ENV{bar}>, or C<$ENV{baz}> vars if any are defined. The C<clear_env_vars> tell it to then delete the environment variables after they are used to set the option. This is useful if you want to use the env var to set an option, but do not want any tests to be able to see the env var after it is used to set the option. =item $class->new(default => $scalar) =item $class->new(default => sub { return $default }) =item $scalar_or_coderef = $opt->default() This sets a default value for the field in the settings hash, the default is set before any command line processing is done, so if the option is never used in the command line the default value will be there. Be sure to use the correct default value for your type. A scalar for 's', an arrayref for 'm', etc. Note, for any non-scalar type you want to use a subref to define the value: option foo => ( ... type => 'm', default => sub { [qw/a b c/] }, ); =item $class->new(description => "Fee Fie Foe Fum") =item $multiline_string = $opt->description() Description of your option. This is used in help output and POD. If you do not provide a value the default is C<'NO DESCRIPTION - FIX ME'>. =item $class->new(env_vars => \@LIST) =item $arrayref = $opt->env_vars() If set, this should be an arrayref of environment variable names. If any of the environment variables are defined then the settings will be updated as though the option was provided on the command line with that value. Example: option foo => ( prefix => 'blah', type => 's', env_vars => ['FOO', 'BAR'], ); Then command line: FOO="xxx" yath test Should be the same as yath test --foo "xxx" You can also ask to have the environment variables cleared after they are checked: option foo => ( prefix => 'blah', type => 's', env_vars => ['FOO', 'BAR'], clear_env_vars => 1, # This tells yath to clear the env vars after they are used. ); If you would like the option set to the opposite of the environment variable you can prefix it with a C<'!'> character: option foo =>( ... env_vars => ['!FOO'], ); In this case these are equivalent: FOO=0 yath test yath test --foo=1 Note that this only works when the variable is defined. If C<$ENV{FOO}> is not defined then the variable is not used. =item $class->new(from_command => 'App::Yath::Command::COMMAND') =item $cmd_class = $opt->from_command() If your option was defined for a specific command this will be set. You do not normally set this yourself, the tools in L<App::Yath::Options> usually handle that for you. =item $class->new(from_plugin => 'App::Yath::Plugin::PLUGIN') =item $plugin_class = $opt->from_plugin() If your option was defined for a specific plugin this will be set. You do not normally set this yourself, the tools in L<App::Yath::Options> usually handle that for you. =item $class->new(long_examples => [' foo', '=bar', ...]) =item $arrayref = $opt->long_examples() Used for documentation purposes. If your option takes arguments then you can give examples here. The examples should not include the option itself, so C<--foo bar> would be wrong, you should just do C< bar>. =item $class->new(negate => sub { ... }) =item $coderef = $opt->negate() If you want a custom handler for negation C<--no-OPT> you can provide one here. option foo => ( ... negate => sub { my ($prefix, $field, $slot, $settings, $options) = @_; ... }, ); The variables are the same as those in the C<action> callback. =item $class->new(normalize => sub { ... }) =item $coderef = $opt->normalize() The normalize attribute holds a callback sub that takes the raw value as input and returns the normalized form. option foo => ( ..., normalize => sub { my $raw = shift; ... return $norm; }, ); =item $class->new(pre_command => $bool) =item $bool = $opt->pre_command() Options are either command-specific, or pre-command. Pre-command options are ones yath processes even if it has not determined what command is being used. Good examples are C<--dev-lib> and C<--plugin>. yath --pre-command-opt COMMAND --command-opt Most of the time this should be false, very few options qualify as pre-command. =item $class->new(pre_process => sub { ... }) =item $coderef = $opt->pre_process() This is essentially a BEGIN block for options. This callback is called as soon as the option is parsed from the command line, well before the value is normalized and added to settings. A good use for this is if your option needs to inject additional L<App::Yath::Option> instances into the L<App::Yath::Options> instance. option foo => ( ... pre_process => sub { my %params = @_; my $opt = $params{opt}; my $options = $params{options}; my $action = $params{action}; my $type = $params{type}; my $val = $params{val}; ...; }, ); Explanation of parameters: =over 4 =item $params{opt} The op instance =item $params{options} The L<App::Yath::Options> instance. =item $params{action} A string, usually either "handle" or "handle_negation" =item $params{type} A string, usually C<"pre-command"> or C<"command ($CLASS)"> where the second has the command package in the parentheses. =item $params{val} The value being set, if any. For options that do not take arguments, or in the case of negation this key may not exist. =back =item $class->new(short => $single_character_string) =item $single_character_string = $opt->short() If you want your option to be usable as a short option (single character, single dash C<-X>) then you can provide the character to use here. If the option does not require an argument then it can be used along with other no-argument short options: C<-xyz> would be equivalent to C<-x -y -z>. There are only so many single-characters available, so options are restricted to picking only 1. B<Please note:> Yath reserves the right to add any single-character short options in the main distribution, if they conflict with third party plugins/commands then the third party must adapt and change its options. As such it is not recommended to use any short options in third party addons. =item $class->new(short_examples => [' foo', ...]) =item $arrayref = $opt->short_examples() Used for documentation purposes. If your option takes arguments then you can give examples here. The examples should not include the option itself, so C<-f bar> would be wrong, you should just do C< bar>. This attribute is not used if you do not provide a C<short> attribute. =item $class->new(trace => [$package, $file, $line]) =item $arrayref = $opt->trace() This is almost always auto-populated for you via C<caller()>. It should be an arrayref with a package, filename and line number. This is used if there is a conflict between parameter names and/or short options. If such a situation arises the file/line number of all conflicting options will be reported so it can be fixed. =back =head1 METHODS =over 4 =item $bool = $opt->allows_arg() True if arguments can be provided to the option (based on type). This does not mean the option MUST accept arguments. 'D' type options can accept arguments, but can also be used without arguments. =item $bool = $opt->applicable($options) If an option provides an applicability callback this will use it to determine if the option is applicable given the L<App::Yath::Options> instance. If no callback was provided then this returns true. =item $character = $opt->canon_type($type_name) Given a long alias for an option type this will return the single-character canonical name. This will return undef for any unknown strings. This will not translate single character names to themselves, so C<< $opt->canon_type('s') >> will return undef while C<< $opt->canon_type('string') >> will return C<'s'>. =item $val = $opt->get_default() This will return the proper default value for the option. If a custom default was provided it will be returned, otherwise the correct generic default for the option type will be used. Here is a snippet showing the defaults for types: # First check env vars and return any values from there ... # Then check for a custom default and use it. ... return 0 if $self->{+TYPE} eq 'c' || $self->{+TYPE} eq 'b'; return [] if $self->{+TYPE} eq 'm' || $self->{+TYPE} eq 'D'; return {} if $self->{+TYPE} eq 'h' || $self->{+TYPE} eq 'H'; # All others get undef return undef; =item $val $opt->get_normalized($raw) This converts a raw value to a normalized one. If a custom C<normalize> attribute was set then it will be used, otherwise it is normalized in accordance to the type. This is where booleans are turned into 0 or 1, hashes are split, hash-lists are split further, etc. =item $opt->handle($raw, $settings, $options, $list) This method handles setting the value in $settings. You should not normally need to call this yourself. =item $opt->handle_negation() This method is used to handle a negated option. You should not normally need to call this yourself. =item @list = $opt->long_args() Returns the name and any aliases. =item $ref = $opt->option_slot($settings) Get the settings->prefix->field reference. This creates the setting field if necessary. =item $bool = $opt->requires_arg() Returns true if this option requires an argument when used. =item $string = $opt->trace_string() return a string like C<"somefile.pm line 42"> based on where the option was defined. =item $bool = $opt->valid_type($character) Check if a single character type is valid. =back =head2 DOCUMENTATION GENERATION =over 4 =item $string = $opt->cli_docs() Get the option documentation in a format that works for the C<yath help COMMAND> command. =item $string = $opt->pod_docs() Get the option documentation in POD format. =item .... .. option details ... =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 12044�15267772575� 21010� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin; use strict; use warnings; our $VERSION = '1.000182'; use parent 'Test2::Harness::Plugin'; # We do not want this defined by default, but it should be documented #sub handle_event {} #sub sort_files {} #sub sort_files_2 {} sub finish {} sub finalize {} 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin - Base class for yath plugins =head1 DESCRIPTION This is a base class for yath plugins. Note this class also subclasses L<Test2::Harness::Plugin>. This class holds the methods specific to yath, which is the UI layer. L<Test2::Harness::Plugin> holds the methods specific to L<Test2::Harness> which is the backend. =head1 SYNOPSIS package App::Yath::Plugin::MyPlugin; use parent 'App::Yath::Plugin'; # ... Define methods 1; Then to use it at the command line: $ yath -pMyPlugin ... =head1 NOTE ON INSTANCE VS CLASS None of the plugin base classes provide a C<new()> method. By default plugins are not instantiated and only the plugin package name is passed around. All methods are then called on the class. If you want your plugin to be instantiated as an object you need only define a C<new()> method. If this method is defined yath will call it and create an instance. The instance created will then be used when calling all the methods. To pass arguments to the constructor you can use C<yath -pYourPlugin=arg1,arg2,arg3...>. Your plugin can also define options using L<App::Yath::Options> which will be dropped into the C<$settings> that get passed around. =head1 METHODS B<Note:> See L<Test2::Harness::Plugin> for additional method you can implement/override =over 4 =item $plugin->handle_event($event, $settings) Called for every single event that yath sees. Note that this method is not defined by default for performance reasons, however it will be called if you define it. =item @sorted = $plugin->sort_files_2(settings => $settings, files => \@unsorted) This gives your plugin a chance to sort the files before they are added to the queue. Other things are done later to re-order the files optimally based on length or category, so this sort is just for initial job numbering, and to define a base order before optimization takes place. All files to sort will be instances of L<Test2::Harness::TestFile>. This method is normally left undefined, but will be called if you define it. If this is present then C<sort_files()> will be ignored. =item @sorted = $plugin->sort_files(@unsorted) B<DEPRECATED> Use C<sort_files_2()> instead. This gives your plugin a chance to sort the files before they are added to the queue. Other things are done later to re-order the files optimally based on length or category, so this sort is just for initial job numbering, and to define a base order before optimization takes place. All files to sort will be instances of L<Test2::Harness::TestFile>. This method is normally left undefined, but will be called if you define it. =item $plugin->finish(%args) This is what arguments are received: ( settings => $settings, # The settings final_data => $final_data, # See below pass => $pass ? 1 : 0, # Always a 0 or 1 tests_seen => $self->{+TESTS_SEEN} // 0, # Integer 0 or greater asserts_seen => $self->{+ASSERTS_SEEN} // 0, # Integer 0 or greater ) The final_data looks like this, note that some data may not be present if it is not applicable. The data structure can be as simple as C<< { pass => $bool } >>. { pass => $pass, # boolean, did the test run pass or fail? failed => [ # Jobs that failed, and did not pass on a retry [$job_id1, $file1], # Failing job 1 [$job_id2, $file2], # Failing job 2 ... ], retried => [ # Jobs that failed and were retried [$job_id1, $times_run1, $file1, $passed_eventually1], # Passed_eventually is a boolean [$job_id2, $times_run2, $file2, $passed_eventually2], ... ], hatled => [ # Jobs that caused the entire test suite to halt [$job_id1, $file1, $halt_reason1], # halt_reason is a human readible string [$job_id2, $file2, $halt_reason2], ], } =item $plugin->finalize($settings) This is called as late as possible before exit. This is mainly useful for outputting messages such as "Extra log file written to ..." which are best put at the end of output. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Tester.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 33560�15267772575� 21026� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Tester; use strict; use warnings; our $VERSION = '1.000182'; use Test2::API qw/context run_subtest/; use Test2::Tools::Compare qw/is/; use Carp qw/croak/; use File::Spec; use File::Temp qw/tempfile tempdir/; use POSIX; use Fcntl qw/SEEK_CUR/; use Time::HiRes qw/sleep/; use App::Yath::Util qw/find_yath/; use Test2::Harness::Util qw/clean_path apply_encoding/; use Test2::Harness::Util::IPC qw/run_cmd/; use Test2::Harness::Util::File::JSONL; use Importer Importer => 'import'; our @EXPORT = qw/yath make_example_dir/; my $pdir = tempdir(CLEANUP => 1); require App::Yath; my $apppath = App::Yath->app_path; sub cover { return unless $ENV{T2_DEVEL_COVER}; $ENV{T2_COVER_SELF} = 1; return '-MDevel::Cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; } sub yath { my %params = @_; local $?; my $ctx = context(); my $cmd = delete $params{cmd} // delete $params{command}; my $cli = delete $params{cli} // delete $params{args} // []; my $pre = delete $params{pre} // delete $params{pre_command} // []; my $env = delete $params{env} // {}; my $enc = delete $params{encoding}; my $prefix = delete $params{prefix}; my $subtest = delete $params{test} // delete $params{tests} // delete $params{subtest}; my $exittest = delete $params{exit}; my $debug = delete $params{debug} // 0; my $inc = delete $params{inc} // 1; my $capture = delete $params{capture} // 1; my $log = delete $params{log} // 0; my $no_app_path = delete $params{no_app_path}; my $lib = delete $params{lib} // []; if (keys %params) { croak "Unexpected parameters: " . join (', ', sort keys %params); } my (@inc, @dev); if ($inc) { my ($pkg, $file) = caller(); my $dir = $file; $dir =~ s/\.t2?$//g; my $inc = File::Spec->catdir($dir, 'lib'); push @dev => "-D$inc" if -d $inc; } my ($wh, $cfile); if ($capture) { ($wh, $cfile) = tempfile("yath-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.out'); $wh->autoflush(1); } my (@log, $logfile); if ($log) { my $fh; ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl'); close($fh); @log = ('-F' => $logfile); print "DEBUG: log file = '$logfile'\n" if $debug; } unless ($no_app_path) { push @inc => "-I$apppath" if $cmd =~ m/^(test|start|projects)$/; push @dev => "-D$apppath"; } my @cover = cover(); my $yath = find_yath; my @cmd = ($^X, @$lib, @cover, $yath, @$pre, @dev, $cmd ? ($cmd) : (), @inc, @log, @$cli); print "DEBUG: Command = " . join(' ' => @cmd) . "\n" if $debug; local %ENV = %ENV; # App::Yath::Script (2.0) prints a message and sets PERL_HASH_SEED when # it is not already set, which pollutes captured output. $ENV{PERL_HASH_SEED} //= POSIX::strftime('%Y%m%d', localtime); $ENV{YATH_PERSISTENCE_DIR} = $pdir; $ENV{YATH_CMD} = $cmd; $ENV{NESTED_YATH} = 1; $ENV{'YATH_SELF_TEST'} = 1; $ENV{$_} = $env->{$_} for keys %$env; my $pid = run_cmd( no_set_pgrp => 1, $capture ? (stderr => $wh, stdout => $wh) : (), command => \@cmd, run_in_parent => [sub { close($wh) }], ); my (@lines, $exit); if ($capture) { open(my $rh, '<', $cfile) or die "Could not open output file: $!"; # Do not apply encoding here — non-blocking reads can split # multi-byte characters, corrupting the :utf8 decode. $rh->blocking(0); my $start = time(); my $timeout = $ENV{YATH_TESTER_TIMEOUT} // 120; # Everything this run prints is captured, so a test that spends a # couple of minutes in here says nothing at all to whatever harness is # running it, and a harness that sees nothing assumes a hang and kills # the test. Say something now and then instead. my $heartbeat = $ENV{YATH_TESTER_HEARTBEAT} // 10; my $last_beat = $start; while (1) { seek($rh, 0, SEEK_CUR); # CLEAR EOF my @new = <$rh>; push @lines => @new; print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1; waitpid($pid, WNOHANG) or do { if ($timeout && time() - $start > $timeout) { push @lines => "yath tester timeout after ${timeout}s\n"; $exit = _reap_stuck_yath($pid); last; } if ($heartbeat && time() - $last_beat >= $heartbeat) { $last_beat = time(); $ctx->note("Still waiting on yath, " . int($last_beat - $start) . "s so far"); } sleep 0.02; next; }; $exit = $?; last; } # Child is done — re-read the complete file with proper encoding. # This avoids partial multi-byte sequences from non-blocking reads. if ($enc) { open(my $fh, '<', $cfile) or die "Could not re-open output file: $!"; apply_encoding($fh, $enc); @lines = <$fh>; close($fh); } else { seek($rh, 0, SEEK_CUR); # CLEAR EOF while (my @new = <$rh>) { push @lines => @new; print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1; } } } else { print "DEBUG: Waiting for $pid\n" if $debug; waitpid($pid, 0); $exit = $?; } print "DEBUG: Exit: $exit\n" if $debug; my $out = { exit => $exit, $capture ? (output => join('', @lines)) : (), $log ? (log => Test2::Harness::Util::File::JSONL->new(name => $logfile)) : (), }; my $name = join(' ', map { length($_) < 30 ? $_ : substr($_, 0, 10) . "[...]" . substr($_, -10) } grep { defined($_) } $prefix, 'yath', @$pre, $cmd ? ($cmd) : (), @$cli); run_subtest( $name, sub { if (defined $exittest) { my $ictx = context(level => 3); is($exit, $exittest, "Exit Value Check"); $ictx->release; } if ($subtest) { local $_ = $out->{output}; local $? = $out->{exit}; $subtest->($out); } my $ictx = context(level => 3); $ictx->diag("Command = " . join(' ' => grep { defined $_ } @cmd) . "\nExit = $exit\n==== Output ====\n$out->{output}\n========") unless $ictx->hub->is_passing; $ictx->release; }, {buffered => 1}, $out, ) if $subtest || defined $exittest; $ctx->release; return $out; } # A yath wedged badly enough to hit the timeout above may also be wedged badly # enough to ignore TERM, and a blocking waitpid on one that does hangs the test # file with no ceiling of its own -- turning a slow suite into one that never # finishes. Escalate instead, and only to this process: the tester deliberately # leaves yath in its own process group, so signalling the group would take the # test process with it. sub _reap_stuck_yath { my ($pid) = @_; for my $sig (qw/TERM TERM KILL/) { kill($sig, $pid); my $deadline = time() + 5; while (time() < $deadline) { return $? if waitpid($pid, WNOHANG) > 0; sleep 0.05; } } # It outlived a KILL, so it is unkillable (stuck in the kernel) and there # is nothing else to try. Block, and let the caller see what it gets. waitpid($pid, 0); return $?; } sub _gen_passing_test { my ($dir, $subdir, $file) = @_; my $path = File::Spec->catdir($dir, $subdir); my $full = File::Spec->catfile($path, $file); mkdir($path) or die "Could not make $subdir subdir: $!" unless -d $path; open(my $fh, '>', $full); print $fh "use Test2::Tools::Tiny;\nok(1, 'a passing test');\ndone_testing\n"; close($fh); return $full; } sub make_example_dir { my $dir = tempdir(CLEANUP => 1, TMP => 1); _gen_passing_test($dir, 't', 'test.t'); _gen_passing_test($dir, 't2', 't2_test.t'); _gen_passing_test($dir, 'xt', 'xt_test.t'); return $dir; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Tester - Tools for testing yath =head1 DESCRIPTION This package provides utilities for running yath from within tests to verify its behavior. This is primarily used for integration testing of yath and for third party components. =head1 SYNOPSIS use App::Yath::Tester qw/yath/; my $result = yath( # Command and arguments command => 'test', args => ['-pMyPlugin', 'path/to/test', ...], # Exit code we expect from yath exit => 0, # Subtest to verify results test => sub { my $result = shift; # Redundant since we have the exit check above is($result->{exit}, 0, "Verify exit"); is($result->{output}, $expected_output, "Got the expected output from yath"); }, ); =head1 EXPORTS There are 2 exports from this module. =head2 $result = yath(...) my $result = yath( # Command and arguments command => 'test', args => ['-pMyPlugin', 'path/to/test', ...], # Exit code we expect from yath exit => 0, # Subtest to verify results test => sub { my $result = shift; # Redundant since we have the exit check above is($result->{exit}, 0, "Verify exit"); is($result->{output}, $expected_output, "Got the expected output from yath"); }, ); =head3 ARGUMENTS =over 4 =item cmd => $command =item command => $command Either 'cmd' or 'command' can be used. This argument takes a string that should be a command name. =item cli => \@ARGS =item args => \@ARGS Either 'cli' or 'args' can be used. If none are provided an empty arrayref is used. This argument takes an arrayref of arguments to the yath command. $ yath [PRE_COMMAND] [COMMAND] [ARGS] =item pre => \@ARGS =item pre_command => \@ARGS Either 'pre' or 'pre_command' can be used. An empty arrayref is used if none are provided. These are arguments provided to yath BEFORE the command on the command line. $ yath [PRE_COMMAND] [COMMAND] [ARGS] =item env => \%ENV Provide custom environment variable values to set before running the yath command. =item encoding => $encoding_name If you expect your yath command's output to be in a specific encoding you can specify it here to make sure the C<< $result->{output} >> text has been read properly. =item test => sub { ... } =item tests => sub { ... } =item subtest => sub { ... } These 3 arguments are all aliases for the same thing, only one should be used. The codeblock will be called with C<$result> as the only argument. The codeblock will be run as a subtest. If you specify the C<'exit'> argument that check will also happen in the same subtest. test => sub { my $result = shift; ... verify result ... }, =item exit => $integer Verify that the yath command exited with the specified exit code. This check will be run in a subtest. If you specify a custom subtest then this check will appear to come from that subtest. =item debug => $integer Output debug info in realtime, depending on the $integer value this may include the output from the yath command being run. 0 - No debugging 1 - Output the command and other action being taken by the tool 2 - Echo yath output as it happens =item inc => $bool This defaults to true. When true the tool will look for a directory next to your test file with an identical name except that '.t' or '.t2' will be stripped from it. If that directory exists it will be added as a dev-lib to the yath command. If your test file is 't/foo/bar.t' then your yath command will look like this: $ yath -D=t/foo/bar [PRE-COMMAND] [COMMAND] [ARGS] =item capture => $bool Defaults to true. When true the yath output will be captured and put into C<< $result->{output} >>. =item log => $bool Defaults to false. When true yath will be instructed to produce a log, the log will be accessible via C<< $result->{log} >>. C<< $result->{log} >> will be an instance of L<Test2::Harness::Util::File::JSONL>. =item no_app_path => $bool Default to false. Normally C<< -D=/path/to/lib >> is added to the yath command where C<'/path/to/lib'> is the path the the lib dir L<App::Yath> was loaded from. This normally insures the correct version of yath libraries is loaded. When this argument is set to true the path is not added. =item lib => [...] This poorly named argument allows you to inject command line arguments between C<perl> and C<yath> in the command. perl [LIB] path/to/yath [PRE-COMMAND] [COMMAND] [ARGS] =back =head3 RESULT The result hashref may contain the following fields depending on the arguments passed into C<yath()>. =over 4 =item exit => $integer Exit value returned from yath. =item output => $string The output produced by the yath command. =item log => $jsonl_object An instance of L<Test2::Harness::Util::File::JSONL> opened from the log file produced by the yath command. B<Note:> By default no logging is done, you must specify the C<< log => 1 >> argument to enable it. =back =head2 $path = make_example_dir() This will create a temporary directory with 't', 't2', and 'xt' subdirectories each of which will contain a single passing test. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������failed.t��������������������������������������������������������������������������������������������100644��001750��001750�� 3007�15267772575� 21177� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx'], log => 1, exit => T(), test => sub { my $out = shift; my $logfile = $out->{log}->name; $out = yath( command => 'failed', args => [$logfile], env => {TABLE_TERM_SIZE => 1000, TS_TERM_SIZE => 1000}, exit => 0, test => sub { my $out = shift; ok(!$out->{exit}, "'failed' command exits true"); like($out->{output}, qr{fail\.tx}, "'fail.tx' was seen as a failure when reading the log"); unlike($out->{output}, qr{pass\.tx}, "'pass.tx' was not seen as a failure when reading the log"); }, ); # GH #300: 'yath failed --interactive' should not crash with # "The 'quiet' field does not exist" $out = yath( command => 'failed', args => ['-i', $logfile], exit => 0, test => sub { my $out = shift; ok(!$out->{exit}, "'failed -i' command exits true"); unlike($out->{output}, qr{field does not exist}, "'failed -i' does not crash on missing display fields"); }, ); }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������plugin.t��������������������������������������������������������������������������������������������100644��001750��001750�� 6447�15267772575� 21264� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; sub verify { my (@outputs) = @_; my $text = ''; for my $out (@outputs) { $text .= $out->{output}; } like($text, qr/TEST PLUGIN: Loaded Plugin/, "Yath loaded the plugin"); like($text, qr/TEST PLUGIN: duration_data/, "duration_data() was called"); like($text, qr/TEST PLUGIN: changed_files\(Test2::Harness::Settings\)/, "changed_files() was called"); like($text, qr/TEST PLUGIN: get_coverage_tests\(Test2::Harness::Settings, HASH\(5\)\)/, "get_coverage_tests() was called"); like($text, qr/TEST PLUGIN: munge_files/, "munge_files() was called"); like($text, qr/TEST PLUGIN: munge_search/, "munge_search() was called"); like($text, qr/TEST PLUGIN: inject_run_data/, "inject_run_data() was called"); like($text, qr/TEST PLUGIN: handle_event/, "handle_event() was called"); like($text, qr/TEST PLUGIN: claim_file .*test\.tx$/m, "claim_file(test.tx) was called"); like($text, qr/TEST PLUGIN: claim_file .*TestPlugin\.pm$/m, "claim_file(TestPlugin.pm) was called"); like($text, qr/TEST PLUGIN: setup Test2::Harness::Settings/, "setup() was called with settings"); like($text, qr/TEST PLUGIN: teardown Test2::Harness::Settings/, "teardown() was called with settings"); like($text, qr/\(TESTPLUG\)\s+STDERR WRITE$/m, "Got the STDERR write from the shellcall"); like($text, qr/\(TESTPLUG\)\s+STDOUT WRITE$/m, "Got the STDOUT write from the shellcall"); like( $text, qr/TEST PLUGIN: finish asserts_seen => 10, final_data => HASH, pass => 1, settings => Test2::Harness::Settings, tests_seen => 5/, "finish() was called with necessary args" ); is(@{[$text =~ m/TEST PLUGIN: setup/g]}, 1, "Only ran setup once"); is(@{[$text =~ m/TEST PLUGIN: teardown/g]}, 1, "Only ran teardown once"); is(@{[$text =~ m/TEST PLUGIN: finish/g]}, 1, "Only ran finish once"); if (ok($text =~ m/^FIELDS:(.*)$/m, "Found fields")) { my $data = decode_json($1); is( $data, [{ name => 'test_plugin', details => 'foo', raw => 'bar', data => 'baz', }], "Injected the run data" ); } my %rank = ( test => 1, c => 2, b => 3, a => 4, d => 5, ); my %jobs = reverse($text =~ m{job\s+(\d+)\s+.*\W(\w+)\.tx}g); is(\%jobs, \%rank, "Ran jobs in specified order"); } yath( command => 'test', args => [$dir, '--ext=tx', '-A', '--durations-threshold' => 1, '--no-plugins', '-pTestPlugin', '--changes-plugin', 'TestPlugin'], exit => 0, test => \&verify, ); unless ($ENV{AUTOMATED_TESTING} || $ENV{AUTHOR_TESTING}) { subtest persist => sub { verify( yath(command => 'start', args => ['--no-plugins', '-pTestPlugin'], exit => 0), yath(command => 'run', args => ['--no-plugins', '-pTestPlugin', '--changes-plugin', 'TestPlugin', exit => 0, $dir, '--ext=tx', '-A']), yath(command => 'stop', args => ['--no-plugins', '-pTestPlugin'], exit => 0), ); }; } done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������reload.t��������������������������������������������������������������������������������������������100644��001750��001750�� 57656�15267772575� 21264� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use File::Temp qw/tempdir/; use File::Spec; use Time::HiRes qw/sleep/; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $fqdir = clean_path($dir); my $pdir = $fqdir; $pdir =~ s{\W{0,2}t\W{1,2}integration\W{1,2}reload$}{}g; my $tmpdir = tempdir(CLEANUP => 1); mkdir("$tmpdir/Preload") or die "($tmpdir/Preload) $!"; # The runner has to see each touch as its own change, so the gap between them # cannot be closed entirely. What sets it: # # 1. The preloader does not check for changes more than once a second. # 2. The stage has to finish reloading before the next file changes, or two # changes collapse into one reload. # # Whole-second mtimes used to be a third constraint: stat reports seconds, so # two touches landing in the same second looked identical and the gap had to # clear a second boundary with margin. Giving each touch an mtime past what # the file already had removes that, so the gap only has to cover 1 and 2. sub bump_mtime { my ($path) = @_; my $stamp = (stat($path))[9] + 1; utime($stamp, $stamp, $path) or die "Could not set mtime on '$path': $!"; } sub touch_files { note "About to touch files with a delay between each, this will take a while"; for my $file (qw/A B A B ExceptionA ExceptionB WarningA WarningB ExporterA ExporterB IncChange Churn nonperl1 nonperl2/) { my $path = "$dir/lib/Preload/${file}"; $path .= '.pm' unless $file =~ m/nonperl/; note "Touching $file..."; sleep 1.25; if ($file eq 'IncChange') { open(my $fh, '>', "$tmpdir/Preload/IncChange.pm") or die $!; print $fh <<' EOT'; package Preload::IncChange; use strict; use warnings; BEGIN { print "$$ $0 Loaded (DIFFERENT) ${ \__PACKAGE__ }\n"; } 1; EOT close($fh); } bump_mtime($path); } sleep 1.25; } sub parse_output { my ($output) = @_; # On macOS, these days, /var is actually a symlink to /private/var. # Somewhere along the lines, something is turning /var into /private/var in # the runner, which makes the "strip out the tmpdir" code (marked below) # leave behind a /private. This fix is inelegant, but probably fixes the # overwhelming majority of macOS test failures without introducing any # further problems. A better fix might be to track down and eliminate the # rewriting of the path, or to uniformly make this check match the behavior # under the hood. For now: let's just let macOS users install # TAP2::Harness! -- rjbs, 2022-02-20 my $safe_tmpdir = $tmpdir; if ($safe_tmpdir =~ m{\A/var/} && -l '/var') { my $target = File::Spec->rel2abs(readlink('/var'), '/'); $target =~ s{/\z}{}; $safe_tmpdir =~ s{\A/var}{$target}; } my %by_proc; for my $line (split /\n/, $output) { next unless $line =~ m/^\s*(\d+) yath-nested-runner(?:-(\S+))? - (.+)$/; my ($pid, $proc, $text) = ($1, $2, $3); $proc //= ''; $text =~ s/$pid yath-nested-runner-$proc(\s*-\s*)//g; $text =~ s{(\Q$fqdir\E|\Q$dir\E|\Q$pdir\E)/*}{}g; $text =~ s{\Q$safe_tmpdir\E(/)?}{TEMP$1}g; # <-- strip out the tmpdir $text =~ s{ line \d+.*$}{}g; push @{$by_proc{$proc || 'default'}} => $text; } return \%by_proc; } subtest no_in_place => sub { unlink("$tmpdir/Preload/IncChange.pm") if -e "$tmpdir/Preload/IncChange.pm"; yath( command => 'start', args => ['-PPreload'], pre => ["-D$tmpdir"], exit => 0, ); touch_files(); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; my $parsed = parse_output($out->{output}); is( $parsed, { 'default' => [ 'Loaded Preload', ], 'A' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::A...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionA...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningA...', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/Churn.pm\'...', 'Changed file \'Preload/Churn.pm\' contains churn sections, running them instead of a full reload...', 'Churn 1', 'FOO: foo 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 8 -> 16)', 'Churn 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 18 -> 20)', 'Error reloading churn block (lib/Preload/Churn.pm lines 22 -> 28): Died on count 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl1\'...', 'Changed file \'lib/Preload/nonperl1\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl1', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl2\'...', 'Changed file \'lib/Preload/nonperl2\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl2', ], 'B' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::A...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::B...', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionA...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExceptionB...', 'Loaded Preload::WarningA', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningA...', 'Loaded Preload::ExporterA', 'Loaded Preload::WarningB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::WarningB...', 'Loaded Preload::ExporterA', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterB...', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/IncChange.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::IncChange...', ], }, "Reload happened as expected", ); }, ); yath(command => 'stop', exit => 0); }; subtest in_place => sub { unlink("$tmpdir/Preload/IncChange.pm") if -e "$tmpdir/Preload/IncChange.pm"; yath( command => 'start', args => ['-PPreload', '-r'], pre => ["-D$tmpdir"], exit => 0, ); touch_files(); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; my $parsed = parse_output($out->{output}); is( $parsed, { 'default' => [ 'Loaded Preload', ], 'A' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA', 'Runner failed to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionA.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA', 'Runner failed to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Churn 1', 'FOO: foo 1', 'Churn 2', 'Churn 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/Churn.pm\'...', 'Changed file \'Preload/Churn.pm\' contains churn sections, running them instead of a full reload...', 'Churn 1', 'FOO: foo 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 8 -> 16)', 'Churn 2', 'Success reloading churn block (lib/Preload/Churn.pm lines 18 -> 20)', 'Error reloading churn block (lib/Preload/Churn.pm lines 22 -> 28): Died on count 3', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl1\'...', 'Changed file \'lib/Preload/nonperl1\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl1', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/nonperl2\'...', 'Changed file \'lib/Preload/nonperl2\' has a reload callback, executing it instead of regular reloading...', 'RELOAD CALLBACK nonperl2' ], 'B' => [ 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::ExporterA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'Runner attempting to reload \'lib/Preload/B.pm\' in place...', 'Loaded Preload::B', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/A.pm\'...', 'Runner attempting to reload \'lib/Preload/A.pm\' in place...', 'Loaded Preload::A', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/B.pm\'...', 'Runner attempting to reload \'lib/Preload/B.pm\' in place...', 'Loaded Preload::B', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionA.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA', 'Runner failed to reload \'lib/Preload/ExceptionA.pm\' in place...', 'Loaded Preload::ExceptionA again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionA.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExceptionB.pm\'...', 'Runner attempting to reload \'lib/Preload/ExceptionB.pm\' in place...', 'Loaded Preload::ExceptionB', 'Runner failed to reload \'lib/Preload/ExceptionB.pm\' in place...', 'Loaded Preload::ExceptionB again.', 'BEGIN failed--compilation aborted at lib/Preload/ExceptionB.pm', 'Compilation failed in require at lib/Test2/Harness/Runner/Reloader.pm', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningA.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA', 'Runner failed to reload \'lib/Preload/WarningA.pm\' in place...', 'Loaded Preload::WarningA again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/WarningB.pm\'...', 'Runner attempting to reload \'lib/Preload/WarningB.pm\' in place...', 'Loaded Preload::WarningB', 'Runner failed to reload \'lib/Preload/WarningB.pm\' in place...', 'Loaded Preload::WarningB again.', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterA.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterA...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::ExporterB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/ExporterB.pm\'...', 'blacklisting changed files and reloading stage...', 'Blacklisting Preload::ExporterB...', 'Loaded Preload::A', 'Loaded Preload::WarningA', 'Loaded Preload::ExceptionA', 'Loaded Preload::B', 'Loaded Preload::WarningB', 'Loaded Preload::ExceptionB', 'Loaded Preload::IncChange', 'Runner detected a change in one or more preloaded modules...', 'Runner detected changes in file \'lib/Preload/IncChange.pm\'...', 'Runner attempting to reload \'lib/Preload/IncChange.pm\' in place...', 'Runner failed to reload \'lib/Preload/IncChange.pm\' in place...', 'Reloading \'Preload/IncChange.pm\' loaded \'TEMP/Preload/IncChange.pm\' instead of \'lib/Preload/IncChange.pm\', @INC must have been altered at lib/Test2/Harness/Runner/Reloader.pm' ], }, "Reload happened as expected", ); }, ); yath(command => 'stop', exit => 0); }; done_testing; ����������������������������������������������������������������������������������replay.t��������������������������������������������������������������������������������������������100644��001750��001750�� 2673�15267772575� 21257� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; sub clean_output { my $out = shift; $out->{output} =~ s/^.*duration.*$//m; $out->{output} =~ s/^.*Wrote log file:.*$//m; $out->{output} =~ s/^.*Symlinked to:.*$//m; $out->{output} =~ s/^\s*Wall Time:.*seconds//m; $out->{output} =~ s/^\s*CPU Time:.*s\)//m; $out->{output} =~ s/^\s*CPU Usage:.*%//m; $out->{output} =~ s/^\s*-+$//m; $out->{output} =~ s/^\s+$//m; $out->{output} =~ s/\n+/\n/g; $out->{output} =~ s/^\s+//mg; } my $out1 = yath( command => 'test', args => [$dir, '--ext=tx'], log => 1, exit => T(), test => sub { my $out = shift; clean_output($out); like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the log"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the log"); }, ); my $logfile = $out1->{log}->name; yath( command => 'replay', args => [$logfile], exit => $out1->{exit}, test => sub { my $out2 = shift; clean_output($out2); clean_output($out1); is($out2->{output}, $out1->{output}, "Replay has identical output to original"); }, ); done_testing; ���������������������������������������������������������������������shares.t��������������������������������������������������������������������������������������������100644��001750��001750�� 4515�15267772575� 21245� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; use File::Temp qw/tempdir/; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # HARNESS-SHARES-DB tests may run alongside each other, but never alongside a # HARNESS-CONFLICTS-DB test. Read the window each test was live for out of the # log and check which windows were allowed to overlap. my $barrier = tempdir(CLEANUP => 1); yath( command => 'test', args => [ $dir, '--ext=tx', '-j4', '-It/lib', '--env-var' => "TEST_BARRIER_DIR=$barrier", '--env-var' => "TEST_BARRIER_COUNT=2", ], log => 1, exit => 0, test => sub { my $out = shift; my $log = $out->{log}; my (%name, %start, %stop); my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; my $job_id = $event->{job_id} // next; if (my $s = $f->{harness_job_start}) { $name{$job_id} = (File::Spec->splitpath($s->{rel_file}))[-1]; $start{$job_id} = $s->{stamp}; } if (my $e = $f->{harness_job_exit}) { $stop{$job_id} = $e->{stamp}; } } # Check for additional events, probably should not have any, but we # may hit a buffering limit in the log reader and need additional # polls. push @events => $log->poll; } my %window; for my $job_id (keys %name) { $window{$name{$job_id}} = [$start{$job_id}, $stop{$job_id}]; } is([sort keys %window], [sort qw/exclusive.tx shared_a.tx shared_b.tx/], "Found all three tests in the log"); my $overlap = sub { my ($x, $y) = @_; my ($xa, $xb) = @{$window{$x}}; my ($ya, $yb) = @{$window{$y}}; return $xa < $yb && $ya < $xb; }; ok(!$overlap->('exclusive.tx', 'shared_a.tx'), "exclusive did not run alongside shared_a"); ok(!$overlap->('exclusive.tx', 'shared_b.tx'), "exclusive did not run alongside shared_b"); ok($overlap->('shared_a.tx', 'shared_b.tx'), "the two shared tests did run alongside each other"); }, ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������stamps.t��������������������������������������������������������������������������������������������100644��001750��001750�� 1237�15267772575� 21265� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-A', '--no-plugins', '-pTestPlugin', '-v'], exit => T(), log => 1, test => sub { my $out = shift; while (my @events = $out->{log}->poll()) { for my $event (@events) { last unless $event; ok($event->{stamp}, "Event had a timestamp"); } } }, ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-w.t��������������������������������������������������������������������������������������������100644��001750��001750�� 765�15267772575� 21166� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # assert that, regardless of order, the `perl -w` shebang only applies # to the test file it appears in; see # https://github.com/Test-More/Test2-Harness/issues/266 yath( command => 'test', args => ["$dir/a.tx", "$dir/b.tx", '--ext=tx'], exit => 0, ); yath( command => 'test', args => ["$dir/b.tx", "$dir/a.tx", '--ext=tx'], exit => 0, ); done_testing; �����������Yath������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 17507� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App��������������������������������������������������������������������������������������������������������������������������������������Util.t����������������������������������������������������������������������������������������������100644��001750��001750�� 21651�15267772575� 20776� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Util'; use Test2::Tools::Spec; use Test2::Util qw/CAN_REALLY_FORK/; use Test2::Tools::GenTemp qw/gen_temp/; use Test2::Harness::Util qw/clean_path/; use File::Temp qw/tempfile/; use Cwd qw/cwd/; use POSIX qw/_exit/; use File::Spec; use App::Yath::Util qw{ find_pfile is_generated_test_pl fit_to_width isolate_stdout find_yath find_in_updir }; imported_ok qw{ find_pfile is_generated_test_pl fit_to_width isolate_stdout find_yath find_in_updir }; my $initial_dir = cwd(); after_each chdir => sub { chdir($initial_dir); }; tests find_yath => sub { local $App::Yath::Script::SCRIPT = 'foobar'; is(find_yath, 'foobar', "Use \$App::Yath::Script::SCRIPT if set"); $App::Yath::Script::SCRIPT = undef; my $tmp = gen_temp('bin' => {'yath' => 'xxx'}); my $yath = clean_path(File::Spec->catfile($tmp, 'bin', 'yath')); eval { chmod(0755, File::Spec->catfile($tmp, 'bin', 'yath')); 1 } or warn $@; { local $ENV{YATH_SCRIPT} = $yath; is(find_yath, $yath, "found the yath script named by \$ENV{YATH_SCRIPT}"); is($App::Yath::Script::SCRIPT, $yath, "cached result"); } # An uninstalled dist: the script lives in blib/script, next to the libs # in blib/lib. A local::lib style tree pairs lib/perl5 with bin. my $tmp2 = gen_temp( blib => {lib => {}, script => {yath => 'xxx'}}, lib => {perl5 => {}}, bin => {yath => 'xxx'}, ); my $blib_yath = clean_path(File::Spec->catfile($tmp2, 'blib', 'script', 'yath')); my $bin_yath = clean_path(File::Spec->catfile($tmp2, 'bin', 'yath')); eval { chmod(0755, $blib_yath, $bin_yath); 1 } or warn $@; # Each search source is checked in isolation: only what the params provide # is visible to find_yath. my $find = sub { my %params = @_; $App::Yath::Script::SCRIPT = undef; local %ENV = %ENV; delete $ENV{YATH_SCRIPT}; $ENV{YATH_SCRIPT} = $params{env_script} if $params{env_script}; $ENV{PATH} = defined $params{path} ? $params{path} : ''; local @INC = @{$params{inc} || []}; local *App::Yath::Util::Config = $params{config} || {}; return dies { find_yath } if $params{dies}; return find_yath; }; # An empty dir as a config path, so the error has a candidate to list. my $empty = gen_temp(); my $not_found = File::Spec->catfile($empty, 'yath'); my $err = $find->(dies => 1, config => {scriptdir => $empty}); like($err, qr/Could not find the yath script/, "No yath found"); like($err, qr/^\s+\Q$not_found\E$/m, "Error reports each path it checked"); like($err, qr/^Cwd:/m, "Error reports the current directory"); like($err, qr/^PATH:/m, "Error reports PATH"); like($err, qr/^PERL5LIB:/m, "Error reports PERL5LIB"); like($err, qr/^\@INC:/m, "Error reports \@INC"); is($find->(env_script => $yath), $yath, "Found it via \$ENV{YATH_SCRIPT}"); is( $find->(env_script => $yath, inc => [File::Spec->catdir($tmp2, 'blib', 'lib')]), $yath, "\$ENV{YATH_SCRIPT} outranks the search paths", ); is( $find->(inc => [File::Spec->catdir($tmp2, 'blib', 'lib')]), $blib_yath, "Found blib/script beside a blib/lib in \@INC", ); is( $find->(inc => [File::Spec->catdir($tmp2, 'lib', 'perl5')]), $bin_yath, "Found bin beside a lib/perl5 in \@INC", ); is( $find->(config => {scriptdir => File::Spec->catdir($tmp, 'bin')}), $yath, "Found it in a config path", ); is($find->(path => File::Spec->catdir($tmp, 'bin')), $yath, "Found it in PATH"); # App::Yath::Script re-execs into a checkout's own script and names it in # YATH_SCRIPT, so find_yath does not look for one itself. my $checkout = gen_temp('scripts' => {'yath' => 'xxx'}); eval { chmod(0755, File::Spec->catfile($checkout, 'scripts', 'yath')); 1 } or warn $@; chdir($checkout) or die "$!"; like( $find->(dies => 1), qr/Could not find the yath script/, "A scripts/ dir in the current directory is not searched", ); chdir($initial_dir) or die "$!"; # The script is run as an argument to perl, so it need not be executable, # except when PATH is what named it. my $tmp3 = gen_temp(bin => {yath => 'xxx'}); my $unexecutable = clean_path(File::Spec->catfile($tmp3, 'bin', 'yath')); eval { chmod(0644, $unexecutable); 1 } or warn $@; is( $find->(config => {scriptdir => File::Spec->catdir($tmp3, 'bin')}), $unexecutable, "A config path yath does not need the exec bit", ); like( $find->(dies => 1, path => File::Spec->catdir($tmp3, 'bin')), qr/Could not find the yath script/, "A PATH yath without the exec bit is not used", ); # An uninstalled script is never in a config path, a lib/perl5 pairing is a # guess, so they sit on either side of the config paths. is( $find->( inc => [File::Spec->catdir($tmp2, 'blib', 'lib')], config => {scriptdir => File::Spec->catdir($tmp, 'bin')}, ), $blib_yath, "A blib/script dir outranks a config path", ); is( $find->( inc => [File::Spec->catdir($tmp2, 'lib', 'perl5')], config => {scriptdir => File::Spec->catdir($tmp, 'bin')}, ), $yath, "A config path outranks a lib/perl5 pairing", ); }; tests isolate_stdout => sub { my ($stdout_r, $stdout_w, $stderr_r, $stderr_w); pipe($stdout_r, $stdout_w) or die "Could not open pipe: $!"; pipe($stderr_r, $stderr_w) or die "Could not open pipe: $!"; my $pid = fork; die "Could not fork" unless defined $pid; unless ($pid) { # child close($stdout_r); close($stderr_r); open(STDOUT, '>&', $stdout_w) or die "Could not redirect STDOUT"; open(STDERR, '>&', $stderr_w) or die "Could not redirect STDOUT"; my $fh = isolate_stdout(); print $fh "Should go to STDOUT\n"; print "Should go to STDERR 1\n"; print STDOUT "Should go to STDERR 2\n"; print STDERR "Should go to STDERR 3\n"; # Flush and _exit() instead of exit(): global destruction in this # process can write to these pipes (Math::Random::MT::Auto complains # about a double DESTROY on some systems) and the parent asserts on # exactly what came through. close($fh) or _exit(255); close(STDOUT) or _exit(255); close(STDERR) or _exit(255); _exit(0); } close($stdout_w); close($stderr_w); waitpid($pid, 0); is($?, 0, "Clean exit"); is( [<$stdout_r>], ["Should go to STDOUT\n"], "Got expected STDOUT" ); is( [<$stderr_r>], [ "Should go to STDERR 1\n", "Should go to STDERR 2\n", "Should go to STDERR 3\n", ], "Got expected STDERR" ); } if CAN_REALLY_FORK; subtest is_generated_test_pl => sub { ok(!is_generated_test_pl(__FILE__), "This is not a generated test file"); my ($fh, $name) = tempfile(UNLINK => 1); print $fh "use strict;\nuse warnings;\n# THIS IS A GENERATED YATH RUNNER TEST\ndfasdafas\n"; close($fh); ok(is_generated_test_pl($name), "Found a generated file"); }; subtest find_in_updir => sub { my $tmp = gen_temp( thefile => 'xxx', nest => { nest_a => { thefile => 'xxx' }, nest_b => {}, }, ); chdir(File::Spec->catdir($tmp, 'nest', 'nest_a')) or die "$!"; my $file = File::Spec->catfile($tmp, 'nest', 'nest_a', 'thefile'); like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot"); chdir(File::Spec->catdir($tmp, 'nest', 'nest_b')) or die "$!"; $file = File::Spec->catfile($tmp, 'thefile'); like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot"); }; subtest fit_to_width => sub { is(fit_to_width(100, " ", "hello there"), "hello there", "No change for short string"); is(fit_to_width(2, " ", "hello there"), "hello\nthere", "Split across multiple lines"); is( fit_to_width(20, " ", "hello there, this is a longer string that needs splitting."), "hello there, this is\na longer string that\nneeds splitting.", "Split across multiple lines" ); is( fit_to_width(100, " ", ["hello there", "this is a", "longer string that", "needs no splitting."]), "hello there this is a longer string that needs no splitting.", "Split across multiple lines" ); is( fit_to_width(50, " ", ["hello there", "this is a", "longer string that", "needs splitting."]), "hello there this is a longer string that\nneeds splitting.", "Split across multiple lines" ); }; done_testing; ���������������������������������������������������������������������������������������yath_script�����������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 17434� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t�����������������������������������������������������������������������������������������������������������������������������������������������.yath.rc��������������������������������������������������������������������������������������������100644��001750��001750�� 540�15267772575� 21124� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/yath_script����������������������������������������������������������������������������������������������������������������������������������� ; comment! -Dpre_lib; comment! -D=rel(pre/xxx/lib) ;comment! -D=rel( pre/yyy/lib ) -pXXX -p YYY -D SPLIT --no-scan-plugins [test] -Itest_lib; comment! -I=rel(test/xxx/lib) ;comment! -I rel( test/yyy/lib ) --default-search relglob(../*.t) -xxxx;comment! foo bar baz bat [run] -Irun_lib -I=rel(run/xxx/lib) -I rel( run/yyy/lib ) -xxxx foo bar ����������������������������������������������������������������������������������������������������������������������������������������������������������������subtests_buffered.t���������������������������������������������������������������������������������100644��001750��001750�� 377�15267772575� 21217� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t2����������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use strict; use warnings; use Test2::Tools::Tiny; use Test2::Tools::Subtest qw/subtest_buffered/; # HARNESS-DURATION-SHORT subtest_buffered foo => sub { subtest_buffered bar => sub { ok(1, 'baz'); }; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������subtests_streamed.t���������������������������������������������������������������������������������100644��001750��001750�� 377�15267772575� 21241� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t2����������������������������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use strict; use warnings; use Test2::Tools::Tiny; use Test2::Tools::Subtest qw/subtest_streamed/; # HARNESS-DURATION-SHORT subtest_streamed foo => sub { subtest_streamed bar => sub { ok(1, 'baz'); }; }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pod-syntax.t����������������������������������������������������������������������������������������100644��001750��001750�� 251�15267772575� 21206� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/xt/author���������������������������������������������������������������������������������������������������������������������������������������#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Command.pm������������������������������������������������������������������������������������������100644��001750��001750�� 22456�15267772575� 21140� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Command; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use Carp qw/croak/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Util::HashBase qw/-settings -args/; use App::Yath::Options(); use Test2::Harness::Util::File::JSON(); sub internal_only { 0 } sub always_keep_dir { 0 } sub summary { "No Summary" } sub description { "No Description" } sub group { "Z-UNFINISHED" } sub doc_args { () } sub only_cmd_opts { 0 } sub handle_invalid_option { 0 } sub munge_opts { } sub name { $_[0] =~ m/([^:=]+)(?:=.*)?$/; $1 || $_[0] } sub run { my $self = shift; warn "This command is currently empty"; return 1; } sub cli_help { my $class = shift; my %params = @_; my $settings = $params{settings} // {}; my $script = $settings->harness->script // $0; my $cmd = $class->name; my (@args) = $class->doc_args; my $options = $params{options}; unless ($options) { $options = App::Yath::Options->new; $options->set_command_class($class); } my ($pre_opts, $cmd_opts); if ($options) { $pre_opts = $options->pre_docs('cli'); $cmd_opts = $options->cmd_docs('cli'); } my $usage = "Usage: $script"; my @out; if ($pre_opts) { $usage .= ' [YATH OPTIONS]'; $pre_opts =~ s/^/ /mg; push @out => "[YATH OPTIONS]\n$pre_opts"; } $usage .= " $cmd"; if ($cmd_opts) { $usage .= " [COMMAND OPTIONS]"; $cmd_opts =~ s/^/ /mg; push @out => "[COMMAND OPTIONS]\n$cmd_opts"; } if (@args) { $usage .= " [COMMAND ARGUMENTS]"; my @desc; for my $arg (@args) { if (ref($arg)) { my ($name, $text) = @$arg; push @desc => $name; $text =~ s/^/ /mg; push @desc => "$text\n"; } else { push @desc => "$arg\n"; } } my $desc = join "\n" => @desc; $desc =~ s/^/ /mg; push @out => "[COMMAND ARGUMENTS]\n$desc"; } chomp(my $desc = $class->description); unshift @out => ("$cmd - " . $class->summary, $desc, $usage); return join("\n\n" => grep { $_ } @out) . "\n"; } sub generate_pod { my $class = shift; my $cmd = $class->name; my (@args) = $class->doc_args; my $options = App::Yath::Options->new(); require App::Yath; my $ay = App::Yath->new(); $options->include($ay->load_options); $options->set_command_class($class); my $pre_opts = $options->pre_docs('pod', 3); my $cmd_opts = $options->cmd_docs('pod', 3); my $usage = " \$ yath [YATH OPTIONS] $cmd"; my @head2s; push @head2s => ("=head2 YATH OPTIONS", $pre_opts) if $pre_opts; if ($cmd_opts) { $usage .= " [COMMAND OPTIONS]"; push @head2s => ("=head2 COMMAND OPTIONS", $cmd_opts); } if (@args) { $usage .= " [COMMAND ARGUMENTS]"; push @head2s => ( "=head2 COMMAND ARGUMENTS", "=over 4", (map { ref($_) ? ( "=item $_->[0]", $_->[1] ) : ("=item $_") } @args), "=back" ); } my @out = ( "=head1 NAME", "$class - " . $class->summary, "=head1 DESCRIPTION", $class->description, "=head1 USAGE", $usage, @head2s ); return join("\n\n" => grep { $_ } @out); } sub write_settings_to { my $self = shift; my ($dir, $file) = @_; croak "'directory' is a required parameter" unless $dir; croak "'filename' is a required parameter" unless $file; my $settings = $self->settings; my $settings_file = Test2::Harness::Util::File::JSON->new(name => File::Spec->catfile($dir, $file)); $settings_file->write($settings); return $settings_file->name; } sub setup_resources { my $self = shift; my $settings = $self->settings; return unless $settings->check_prefix('runner'); my $runner = $settings->runner; my $res = $runner->resources or return; return unless @$res; for my $res (@$res) { require(mod2file($res)) unless ref $res; $res->setup($settings); } } sub setup_plugins { my $self = shift; $_->setup($self->settings) for @{$self->settings->harness->plugins}; } sub teardown_plugins { my $self = shift; my ($renderers, $logger) = @_; $_->teardown($self->settings, $renderers, $logger) for @{$self->settings->harness->plugins}; } sub finalize_plugins { my $self = shift; $_->finalize($self->settings) for @{$self->settings->harness->plugins}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command - Base class for yath commands =head1 DESCRIPTION This is the base class for any/all yath commands. If you wish to add a new yath command you should subclass this package. =head1 SYNOPSIS package App::Yath::Command::mycommand; use strict; use warnings; use App::Yath::Options(); use parent 'App::Yath::Command'; # Include existing option sets include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', ..., ); # Add some custom options option_group {prefix => 'mycommand', category => 'mycommand options'} => sub { option foo => ( description => "the foo option", default => 0, ); }; # This is used to sort/group commands in the "yath help" output sub group { 'thirdparty' } # Brief 1-line summary sub summary { "This is a third party command, it does stuff..." } # Longer description of the command (used in yath help mycommand) sub description { return <<" EOT"; This command does: This That Those EOT } # Entrypoint sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; print "Hello Third Party!\n" # Return an exit value. return 0; } =head1 CLASS METHODS =over 4 =item $string = $cmd_class->cli_help(settings => $settings, options => $options) This method generates the command line help for any given command. In general you will NOT want to override this. $settings should be an instance of L<Test2::Harness::Settings>. $options should be an instance of L<App::Yath::Options> if provided. This method is usually capable of filling in the details when this is omitted. =item $multi_line_string = $cmd_class->description() Long-form description of the command. Used in C<cli_help()>. =item @list = $cmd_class->doc_args() A list of argument names to the command, used to generate documentation. =item $string = $cmd_class->generate_pod() This can be used to generate POD documentation from the command itself using the other fields listed in this section, as well as all applicable command lines options specified in the command. =item $string = $cmd_class->group() Used for sorting/grouping commands in the C<yath help> output. Existing groups: ' test' # Space in front to make sure test related command float up 'log' # Log processing commands 'persist' # Commands related to the persistent runner 'zinit' # The init command and related command sink to the bottom. Unless your command OBVIOUSLY and CLEARLY belongs in one of the above groups you should probably create your own. Please do not prefix it with a space to make it float, C<' test'> is a special case, you are not that special. =item $string = $cmd_class->name() Name of the command. By default this is the last part of the package name. You will probably never want to override this. =item $short_string = $cmd_class->summary() A short summary of what this command is. =back =head1 OBJECT METHODS =over 4 =item $bool = $cmd->always_keep_dir() By default the working directory is deleted when yath exits. Some commands such as L<App::Yath::Command::start> need to keep the directory. Override this method to return true if your command uses the workdir and needs to keep it. =item $arrayref = $cmd->args() Get an arrayref of command line arguments B<AFTER> options have been process/removed. =item $bool = $cmd->internal_only() Set this to true if you do not want your command to show up in the help output. =item $exit_code = $cmd->run() This is the main entrypoint for the command. You B<MUST> override this. This method should return an exit code. =item $settings = $cmd->settings() Get the settings as populated by the command line options. =item $cmd->write_settings_to($directory, $filename) A helper method to write the settings to a specified directory and filename. File is written as JSON. If you are subclassing another command such as L<App::Yath::Command::test> you may want to override this to a no-op to prevent the settings file from being written, the L<App::Yath::Command:run> command does this. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Options.pm������������������������������������������������������������������������������������������100644��001750��001750�� 56454�15267772575� 21222� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Options; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use App::Yath::Option(); use Test2::Harness::Settings(); use Test2::Harness::Util::HashBase qw{ <all <lookup <pre_list <cmd_list <post_list <post_list_sorted <settings <args <command_class <pending_pre <pending_cmd <pending_post <used_plugins <included <set_by_cli }; sub import { my $class = shift; my $caller = caller(); croak "$caller already has an 'options' method" if defined(&{"$caller\::options"}); my @common; my $instance; my $options = sub { ($instance //= $class->new()) }; my $option = sub { ($instance //= $class->new())->_option([caller()], shift(@_), @common ? (%{$common[-1]}) : (), @_) }; my $include = sub { ($instance //= $class->new())->include_from(@_) }; my $post = sub { my $cb = pop; my $weight = shift // 0; my ($applicable) = @_; $applicable //= $common[-1]->{applicable} if @common; croak "You must provide a callback coderef" unless $cb && ref($cb) eq 'CODE'; ($instance //= $class->new())->_post($weight, $applicable, $cb); }; my $group = sub { my ($set, $sub) = @_; my $common = {@common ? (%{$common[-1]}) : (), %$set}; if (my $class = $common->{builds}) { require(mod2file($class)); } push @common => $common; my $ok = eval { $sub->(); 1 }; my $err = $@; pop @common; die $err unless $ok; }; { no strict 'refs'; *{"$caller\::post"} = $post; *{"$caller\::option"} = $option; *{"$caller\::options"} = $options; *{"$caller\::option_group"} = $group; *{"$caller\::include_options"} = $include; } return 1; } sub init { my $self = shift; $self->{+ALL} //= []; $self->{+LOOKUP} //= {}; $self->{+USED_PLUGINS} //= []; $self->{+PRE_LIST} //= []; $self->{+CMD_LIST} //= []; $self->{+POST_LIST} //= []; $self->{+SETTINGS} //= Test2::Harness::Settings->new(); $self->{+INCLUDED} //= {}; $self->{+SET_BY_CLI} //= {}; return $self; } sub option { my $self = shift; $self->_option([caller()], @_); } sub include { my $self = shift; my ($inc) = @_; croak "Include must be an instance of ${ \__PACKAGE__ }, got ${ defined($inc) ? \qq['$inc'] : \'undef' }" unless $inc && blessed($inc) && $inc->isa(__PACKAGE__); $self->include_option($_) for @{$inc->all}; $self->{+POST_LIST_SORTED} = 0; push @{$self->{+POST_LIST}} => @{$inc->post_list}; return; } sub include_from { my $self = shift; for my $pkg (@_) { require(mod2file($pkg)) unless $pkg->can('options'); next unless $pkg->can('options'); my $options = $pkg->options or next; $self->include($options); $self->{+INCLUDED}->{$pkg}++; $self->{+INCLUDED}->{$_}++ for keys %{$options->included}; } return; } sub populate_pre_defaults { my $self = shift; for my $opt (@{$self->_pre_command_options}) { my $slot = $opt->option_slot($self->{+SETTINGS}); my $val = $opt->get_default($self->{+SETTINGS}); $$slot //= $val; } } sub populate_cmd_defaults { my $self = shift; croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; for my $opt (@{$self->_command_options()}) { my $slot = $opt->option_slot($self->{+SETTINGS}); my $val = $opt->get_default($self->{+SETTINGS}); $$slot //= $val; } } sub grab_pre_command_opts { my $self = shift; my %config = @_; $self->populate_pre_defaults(); unshift @{$self->{+PENDING_PRE} //= []} => $self->_grab_opts( '_pre_command_options', 'pre-command', stop_at_non_opt => 1, passthrough => 1, %config, ); } sub process_pre_command_opts { my $self = shift; return unless $self->{+PENDING_PRE}; $self->_process_opts(delete $self->{+PENDING_PRE}); } sub set_command_class { my $self = shift; my ($in) = @_; croak "Command class has already been set" if $self->{+COMMAND_CLASS}; my $class = blessed($in) || $in; croak "Invalid command class: $class" unless $class->isa('App::Yath::Command'); $self->include_from($class) if $class->can('options'); return $self->{+COMMAND_CLASS} = $class; } sub set_args { my $self = shift; my ($in) = @_; croak "'args' has already been set" if $self->{+ARGS}; return $self->{+ARGS} = $in; } sub grab_command_opts { my $self = shift; my %config = @_; croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; $self->populate_cmd_defaults(); push @{$self->{+PENDING_CMD} //= []} => $self->_grab_opts( '_command_options', "command (" . $self->{+COMMAND_CLASS}->name . ")", %config, ); } sub process_command_opts { my $self = shift; return unless $self->{+PENDING_CMD}; $self->_process_opts(delete $self->{+PENDING_CMD}); } sub process_option_post_actions { my $self = shift; my ($cmd) = @_; croak "The 'args' attribute has not yet been set" unless $self->{+ARGS}; if ($cmd) { croak "The 'command_class' attribute has not yet been set" unless $self->{+COMMAND_CLASS}; croak "The process_option_post_actions requires an App::Yath::Command instance, got: " . ($cmd // "undef") unless blessed($cmd) && $cmd->isa('App::Yath::Command'); croak "The command '$cmd' dos not match the expected class '$self->{+COMMAND_CLASS}'" unless blessed($cmd) eq $self->{+COMMAND_CLASS}; } unless ($self->{+POST_LIST_SORTED}++) { @{$self->{+POST_LIST}} = sort { $a->[0] <=> $b->[0] } @{$self->{+POST_LIST}}; } for my $post (@{$self->{+POST_LIST}}) { next if $post->[1] && !$post->[1]->($post->[2], $self); $post->[2]->( options => $self, args => $self->{+ARGS}, settings => $self->{+SETTINGS}, $cmd ? (command => $cmd) : (), ); } } sub _pre_command_options { $_[0]->{+PRE_LIST} } sub _command_options { my $self = shift; my $class = $self->{+COMMAND_CLASS} or croak "The 'command_class' attribute has not yet been set"; my $cmd = $class->name; my $cmd_options = $self->{+CMD_LIST} // []; my $pre_options = $self->{+PRE_LIST} // []; return [grep { $_->applicable($self) } @$cmd_options, @$pre_options]; } sub _process_opts { my $self = shift; my ($list) = @_; while (my $opt_set = shift @$list) { my ($opt, $meth, @args) = @$opt_set; $opt->$meth(@args, $self->{+SETTINGS}, $self, $list); $self->{+SET_BY_CLI}->{$opt->prefix}->{$opt->field}++; push @{$self->{+USED_PLUGINS}} => $opt->from_plugin if $opt->from_plugin; } } sub _parse_long_option { my $self = shift; my ($arg) = @_; $arg =~ m/^--((?:no-)?([^=]+))(=(.*))?$/ or confess "Invalid long option: $arg"; #return (main, full, val); return ($2, $1, $3 ? $4 // '' : undef); } sub _parse_short_option { my $self = shift; my ($arg) = @_; $arg =~ m/^-([^-])(=)?(.+)?$/ or confess "Invalid short option: $arg"; #return (main, remain, assign); return ($1, $3, $2); } sub _handle_long_option { my $self = shift; my ($arg, $lookup, $args) = @_; my ($main, $full, $val) = $self->_parse_long_option($arg); my $opt; if ($opt = $lookup->{long}->{$full}) { if ($opt->requires_arg) { $val //= shift(@$args) // die "Option --$full requires an argument.\n"; } elsif($opt->allows_arg) { $val //= $opt->autofill // 1; } else { die "Option --$full does not take an argument\n" if defined $val; $val = 1; } return [$opt, 'handle', $val]; } elsif ($opt = $lookup->{long}->{$main}) { die "Option --$full does not take an argument\n" if defined $val; return [$opt, 'handle_negation']; } return undef; } sub _handle_short_option { my $self = shift; my ($arg, $lookup, $args) = @_; my ($main, $remain, $assign) = $self->_parse_short_option($arg); if (my $opt = $lookup->{short}->{$main}) { if ($opt->allows_arg) { my $val = $remain; $val //= '' if $assign; if ($opt->requires_arg) { $val //= shift(@$args) // die "Option -$main requires an argument.\n"; } else { $val //= $opt->autofill // 1; } $val //= 1; return [$opt, 'handle', $val]; } elsif ($assign) { die "Option -$main does not take an argument\n"; } elsif(defined($remain) && length($remain)) { unshift @$args => "-$remain"; } return [$opt, 'handle', 1]; } return undef; } my %ARG_ENDS = ('--' => 1, '::' => 1); sub _grab_opts { my $self = shift; my ($opt_fetch, $type, %config) = @_; croak "The opt_fetch callback is required" unless $opt_fetch; croak "The arg type is required" unless $type; my $args = $config{args} || $self->{+ARGS} or confess "The 'args' attribute has not yet been set"; my $lookup = $self->_build_lookup($self->$opt_fetch()); my (@keep_args, @opts); while (@$args) { my $arg = shift @$args; if ($ARG_ENDS{$arg}) { push @keep_args => $arg; last; } if (substr($arg, 0, 1) eq '-') { my $handler = (substr($arg, 1, 1) eq '-') ? '_handle_long_option' : '_handle_short_option'; if(my $opt_set = $self->$handler($arg, $lookup, $args)) { my ($opt, $action, @val) = @$opt_set; if (my $pre = $opt->pre_process) { $pre->( opt => $opt, options => $self, action => $action, type => $type, @val ? (val => $val[0]) : (), ); } $lookup = $self->_build_lookup($self->$opt_fetch()) if $opt->adds_options; push @opts => $opt_set; next; } elsif (!$config{passthrough}) { my $err = "Invalid $type option: $arg"; my $handled = $self->{+COMMAND_CLASS} && $self->{+COMMAND_CLASS}->handle_invalid_option($type, $arg, $err); die "$err\n" unless $handled; } } if ($config{die_at_non_opt}) { my $err = "Invalid $type option: $arg"; my $handled = $self->{+COMMAND_CLASS} && $self->{+COMMAND_CLASS}->handle_invalid_option($type, $arg, $err); die "$err\n" unless $handled; } push @keep_args => $arg; last if $config{stop_at_non_opt}; } unshift @$args => @keep_args; return @opts; } sub _build_lookup { my $self = shift; my ($opts) = @_; my $lookup = {long => {}, short => {}}; my %seen; for my $opt (@$opts) { next if $seen{$opt}++; for my $long ($opt->long_args) { $lookup->{long}->{$long} //= $opt; } my $short = $opt->short or next; $lookup->{short}->{$short} //= $opt; } return $lookup; } sub _post { my $self = shift; my ($weight, $applicable, $cb) = @_; $self->{+POST_LIST_SORTED} = 0; $weight //= 0; push @{$self->{+POST_LIST} //= []} => [$weight, $applicable, $cb]; } sub _option { my $self = shift; my ($trace, @spec) = @_; my %proto = $self->_parse_option_args(@spec); my $opt = App::Yath::Option->new( trace => $trace, $self->_parse_option_caller($trace->[0], \%proto), %proto, ); $self->include_option($opt); } sub include_option { my $self = shift; my ($opt) = @_; my $trace = $opt->trace or confess "Options must have a trace!"; push @{$self->{+ALL}} => $opt; my $new = $self->_index_option($opt); $self->_list_option($opt) if $new; return $opt; } sub _parse_option_caller { my $self = shift; my ($caller, $proto) = @_; my ($from_plugin, $from_command, $from_prefix, $prefix, $is_top); $prefix = $proto->{prefix} if exists $proto->{prefix}; $prefix //= $caller->option_prefix() if $caller->can('option_prefix'); if ($caller->isa('App::Yath::Command')) { $from_command = $caller->name() unless $caller eq 'App::Yath::Command'; $is_top = 1; } elsif ($caller =~ m/App::Yath::Command::([^:]+)::.*Options(?:::.*)?$/) { $from_command = $1; $is_top = 1; } elsif ($caller eq 'App::Yath') { $is_top = 1; } elsif ($caller =~ m/^(App::Yath::Plugin::([^:]+))$/) { $from_plugin = $1; $from_prefix = $2; unless (defined $prefix) { $prefix = $from_prefix; $prefix =~ s/::.*$//g; } } $prefix = lc($prefix) if $prefix; croak "Could not find an option prefix and option is not top-level ($proto->{title})" unless $is_top || defined($prefix) || defined($proto->{prefix}); return ( $from_plugin ? (from_plugin => $from_plugin) : (), $from_command ? (from_command => $from_command) : (), ($prefix || !$is_top) ? (prefix => $prefix) : (), ); } sub _parse_option_args { my $self = shift; my @spec = @_; my %args; if (@spec == 1) { my ($title, $type) = $spec[0] =~ m/^([\w-]+)(?:=(.+))?$/ or croak "Invalid option specification: $spec[0]"; return (title => $title, type => $type); } elsif (@spec == 2) { my ($title, $type) = @spec; return (title => $title, type => $type); } my $title = shift @spec; return (title => $title, @spec); } sub _index_option { my $self = shift; my ($opt) = @_; my $index = $self->{+LOOKUP}; my $out = 0; for my $n ($opt->name, @{$opt->alt || []}) { if (my $existing = $index->{$n}) { next if "$existing" eq "$opt"; croak "Option '$n' was already defined (" . $existing->trace_string . ")"; } $out++; $index->{$n} = $opt; } if (my $short = $opt->short) { if (my $existing = $index->{$short}) { return $out if "$existing" eq "$opt"; croak "Option '$short' was already defined (" . $existing->trace_string . ")"; } $out++; $index->{$short} = $opt; } return $out; } sub _list_option { my $self = shift; my ($opt) = @_; return push @{$self->{+PRE_LIST}} => $opt if $opt->pre_command; push @{$self->{+CMD_LIST}} => $opt; } sub pre_docs { my $self = shift; return $self->_docs($self->_pre_command_options(), @_); } sub cmd_docs { my $self = shift; return unless $self->{+COMMAND_CLASS}; return $self->_docs([grep { !$_->pre_command } @{$self->_command_options()}], @_); } my %DOC_FORMATS = ( 'cli' => [ 'cli_docs', # Method to call on opt "\n", # how to join lines sub { "\n$_[1]" }, # how to render the category sub { $_[0] =~ s/^/ /mg; "$_[0]\n" }, # transform the value from the opt sub { }, # add this at the end ], 'pod' => [ 'pod_docs', # Method to call on opt "\n\n", # how to join lines sub { ($_[0] ? ("=back") : (), "=head$_[2] $_[1]", "=over 4") }, # how to render the category sub { $_[0] }, # transform the value from the opt sub { $_[0] ? ("=back") : () }, # add this at the end ], ); sub _docs { my $self = shift; my ($opts, $format, @args) = @_; $format //= "UNDEFINED"; my $fset = $DOC_FORMATS{$format} or croak "Invalid documentation format '$format'"; my ($fmeth, $join, $fcat, $ftrans, $fend) = @$fset; return unless $opts; return unless @$opts; my @opts = sort _doc_sort_ops @$opts; my @out; my $cat; for my $opt (@opts) { if (!$cat || $opt->category ne $cat) { push @out => $fcat->($cat, $opt->category, @args); $cat = $opt->category; } my $help = $opt->$fmeth(); push @out => $ftrans->($help); } push @out => $fend->($cat); return join $join => @out; } sub _doc_sort_ops($$) { my ($a, $b) = @_; my $anc = $a->category eq 'NO CATEGORY - FIX ME'; my $bnc = $b->category eq 'NO CATEGORY - FIX ME'; if($anc xor $bnc) { return 1 if $anc; return -1; } my $ret = $a->category cmp $b->category; $ret ||= ($a->prefix || '') cmp ($b->prefix || ''); $ret ||= $a->field cmp $b->field; $ret ||= $a->name cmp $b->name; return $ret; } sub clear_env { my $self = shift; for my $opt (@{$self->{+ALL}}) { next unless $opt->clear_env_vars; my $env = $opt->env_vars or next; for my $var (@$env) { $var =~ s/^!//; delete $ENV{$var}; } } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options - Tools for defining and tracking yath CLI options. =head1 DESCRIPTION This class represents a collection of options, and holds the logic for processing them. This package also exports sugar to help you define options. =head1 SYNOPSIS package My::Options; use App::Yath::Options; # This package now has a package instance of options, which can be obtained # via the options() method. my $options = __PACKAGE__->options; # We can include options from other packages include_options( 'Package::With::Options::A', 'Package::With::Options::B', ..., ); # Define an option group with some options option_group { %common_fields } => sub { # Define an option option foo => ( type => 's', default => "FOOOOOOO", category => 'foo', description => "This is foo" long_examples => [' value'], ... ); option bar => ( ... ); ... }; # Action to call right after options are parsed. post sub { my %params = @_; ... }; =head1 EXPORTS =over 4 =item $opts = options() =item $opts = $class->options() This returns the options instance associated with your package. =item include_options(@CLASSES) This lets you include options defined in other packages. =item option_group \%COMMON_FIELDS => sub { ... } An option group is simply a block where all calls to C<option()> will have common fields added automatically, this makes it easier to define multiple options that share common fields. Common fields can be overridden inside the option definition. These are both equivalent: # Using option group option_group { category => 'foo', prefix => 'foo' } => sub { option a => (type => 'b'); option b => (type => 's'); }; # Not using option group option a => (type => 'b', category => 'foo', prefix => 'foo'); option b => (type => 's', category => 'foo', prefix => 'foo'); =item option TITLE => %FIELDS Define an option. The first argument is the C<title> attribute for the new option, all other arguments should be attribute/value pairs used to construct the option. See L<App::Yath::Option> for the documentation of attributes. =item post sub { ... } =item post $weight => sub { ... } C<post> callbacks are run after all command line arguments have been processed. This is a place to verify the result of several options combined, sanity check, or even add short-circuit behavior. This is how the C<--help> and C<--show-opts> options are implemented. If no C<$weight> is specified then C<0> is used. C<post> callbacks or sorted based on weight with higher values being run later. =back =head1 OPTIONS INSTANCES In general you should not be using the options instance directly. Options instances are mostly an implementation detail that should be treated as a black box. There are however a few valid reasons to interact with them directly. In those cases there are a few public attributes/methods you can work with. This section documents the public interface. =head2 ATTRIBUTES This section only lists attributes that may be useful to people working with options instances. There are a lot of internal (to yath) attributes that are implementation details that are not listed here. Attributes not listed here are not intended for external use and may change at any time. =over 4 =item $arrayref = $options->all Arrayref containing all the L<App::Yath::Option> instances in the options instance. =item $settings = $options->settings Get the L<Test2::Harness::Settings> instance. =item $arrayref = $options->args Get the reference to the list of command line arguments. This list is modified as arguments are processed, there are no guarantees about what is in here at any given stage of argument processing. =item $class_name = $options->command_class If yath has determined what command is being executed this will be populated with that command class. This will be undefined if the class has not been determined yet. =item $arrayref = $options->used_plugins This is a list of all plugins who's options have been used. Plugins may appear more than once. =item $hashref = $options->included A hashref where every key is a package who's options have been included into this options instance. The values are an implementation detail, do not rely on them. =back =head2 METHODS This section only lists methods that may be useful to people working with options instances. There are a lot of internal (to yath) methods that are implementation details that are not listed here. Methods not listed here are not intended for external use and may change at any time. =over 4 =item $opt = $options->option(%OPTION_ATTRIBUTES) This will create a new option with the provided attributes and add it to the options instance. A C<trace> attribute will be automatically set for you. =item $options->include($options_instance) This method lets you directly include options from a second instance into the first. =item $options->include_from(@CLASSES) This lets you include options from multiple classes that have options defined. =item $options->include_option($opt) This lets you include a single already defined option instance. =item $options->pre_docs($format, @args) Get documentation for pre-command options. $format may be 'cli' or 'pod'. =item $options->cmd_docs($format, @args) Get documentation for command options. $format may be 'cli' or 'pod'. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������log_dir.t�������������������������������������������������������������������������������������������100644��001750��001750�� 1370�15267772575� 21373� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use File::Spec; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $tmpdir = tempdir(CLEANUP => 1); yath( command => 'test', args => ["--log-dir=$tmpdir", '-L', '--ext=tx', $dir], exit => 0, test => sub { my $out = shift; opendir(my $dh, $tmpdir) or die "Could not open dir $tmpdir: $!"; my @files; for my $file (readdir($dh)) { next if $file =~ m/^\.+$/; next unless -f File::Spec->catfile($tmpdir, $file); push @files => $file; } is(@files, 1, "Only 1 file present"); like($files[0], qr{\.jsonl$}, "File is a jsonl file"); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������persist.t�������������������������������������������������������������������������������������������100644��001750��001750�� 5006�15267772575� 21445� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; skip_all "This test is not run under automated testing" if $ENV{AUTOMATED_TESTING}; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath(command => 'start', exit => 0); yath( command => 'run', args => [$dir, '--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'run', args => [$dir, '--ext=tx'], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr{fail\.tx}, "'fail.tx' was not seen when reading the output"); like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); }, ); yath( command => 'which', exit => 0, test => sub { my $out = shift; like($out->{output}, qr/^\s*Found: .*yath-persist\.json$/m, "Found the persist file"); like($out->{output}, qr/^\s*PID: /m, "Found the PID"); like($out->{output}, qr/^\s*Dir: /m, "Found the Dir"); }, ); yath(command => 'reload', exit => 0); yath( command => 'watch', args => ['STOP'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{yath-nested-runner \(default\) Runner caught SIGHUP, reloading}, "Reloaded runner"); }, ); yath( command => 'run', args => [$dir, '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); unlike($out->{output}, qr{pass\.tx}, "'pass.tx' was not seen when reading the output"); }, ); yath( command => 'run', args => [$dir, '-vvv'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/No tests were seen!/, "Got error message"); }, ); yath(command => 'stop', exit => 0); yath( command => 'which', exit => 0, test => sub { my $out = shift; like($out->{output}, qr/No persistent harness was found for the current path\./, "No active runner"); }, ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������preload.t�������������������������������������������������������������������������������������������100644��001750��001750�� 12155�15267772575� 21425� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/CAN_REALLY_FORK/; skip_all "Cannot fork, skipping preload test" unless CAN_REALLY_FORK; skip_all "This test requires forking" if $ENV{T2_NO_FORK}; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestSimplePreload', '-PTestPreload'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestSimplePreload', '-PTestPreload', '-PBroken'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{This is broken}, "Reported the error"); like($out->{output}, qr{No tests were seen!}, "No tests were run"); }, ); yath( command => 'test', args => [$dir, '--ext=tx', '-A', '-PTestBadPreload' ], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{Child stage 'BAD' did not exit cleanly}, "Reported the error"); }, ); unless ($ENV{AUTOMATED_TESTING}) { yath( command => 'start', args => ['-PTestSimplePreload', '-PTestPreload'], exit => 0, test => sub { yath( command => 'run', args => [$dir, '--ext=tx', '-A'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath(command => 'stop', exit => 0); }, ); # Persistent mode ignored broken preloads as they may be under active development yath( command => 'start', args => ['-PTestSimplePreload', '-PTestPreload', '-PBroken'], exit => 0, test => sub { yath( command => 'run', args => [$dir, '--ext=tx', '-A'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{This is broken}, "Reported the error"); like($out->{output}, qr{PASSED.*no_preload\.tx}, 'Ran file "no_preload.tx"'); like($out->{output}, qr{PASSED.*aaa\.tx}, 'Ran file "aaa.tx"'); like($out->{output}, qr{PASSED.*bbb\.tx}, 'Ran file "bbb.tx"'); like($out->{output}, qr{PASSED.*ccc\.tx}, 'Ran file "ccc.tx"'); like($out->{output}, qr{PASSED.*simple_test\.tx}, 'Ran file "simple_test.tx"'); like($out->{output}, qr{PASSED.*preload_test\.tx}, 'Ran file "preload_test.tx"'); like($out->{output}, qr{PASSED.*fast\.tx}, 'Ran file "fast.tx"'); like($out->{output}, qr{PASSED.*slow\.tx}, 'Ran file "slow.tx"'); like($out->{output}, qr{TO RETRY.*retry\.tx}, 'Ran file "retry.tx" with a failure'); like($out->{output}, qr{PASSED.*retry\.tx}, 'Ran file "retry.tx" again with a pass'); }, ); yath(command => 'stop', exit => 0); }, ); } done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������signals.t�������������������������������������������������������������������������������������������100644��001750��001750�� 1052�15267772575� 21411� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; for ( 1..10 ) { # the tests are flapping when using something like '%INC = %INC'.... # make sure the issue is fixed by running them a few times my $out = yath( prefix => "Try $_: ", command => 'test', args => [$dir], log => 0, exit => 0, ); } done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Harness���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20012� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2���������������������������������������������������������������������������������������������������������������������������������������IPC.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 25605�15267772575� 21153� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::IPC; use strict; use warnings; our $VERSION = '1.000182'; use POSIX; use Config qw/%Config/; use Carp qw/croak confess/; use Time::HiRes qw/sleep time/; use Test2::Harness::Util::IPC qw/run_cmd USE_P_GROUPS/; use Test2::Harness::IPC::Process; BEGIN { my %SIG_MAP; my @SIGNAMES = split /\s+/, $Config{sig_name}; my @SIGNUMS = split /\s+/, $Config{sig_num}; while (@SIGNAMES) { $SIG_MAP{shift(@SIGNAMES)} = shift @SIGNUMS; } *SIG_MAP = sub() { \%SIG_MAP }; } use Test2::Harness::Util::HashBase qw{ <pid <handlers <procs <procs_by_cat <waiting <wait_time <started <sig_count }; sub init { my $self = shift; $self->{+PID} = $$; $self->{+PROCS} //= {}; $self->{+PROCS_BY_CAT} //= {}; $self->{+WAIT_TIME} = 0.02 unless defined $self->{+WAIT_TIME}; $self->{+HANDLERS} //= {}; $self->{+HANDLERS}->{CHLD} //= sub { 1 }; $self->{+SIG_COUNT} //= 0; } sub start { my $self = shift; my @caller = caller(1); return if $self->{+STARTED}; $self->{+STARTED} = 1; $self->check_for_fork(); for my $sig (qw/INT HUP TERM CHLD/) { croak "Signal '$sig' was already set by something else" if defined $SIG{$sig} && $SIG{$sig} ne 'IGNORE' && $SIG{$sig} ne 'DEFAULT'; $SIG{$sig} = sub { $self->handle_sig($sig) }; } } sub stop { my $self = shift; $self->wait(all => 1); delete $SIG{$_} for qw/INT HUP TERM CHLD/; $self->{+STARTED} = 0; } sub set_sig_handler { my $self = shift; my ($sig, $sub) = @_; $self->{+HANDLERS}->{$sig} = $sub; } sub handle_sig { my $self = shift; my ($sig) = @_; $self->{+SIG_COUNT}++ unless $sig eq 'CHLD'; return $self->{+HANDLERS}->{$sig}->($sig) if $self->{+HANDLERS}->{$sig}; $self->stop(); exit(SIG_MAP->{$sig}); } sub killall { my $self = shift; my ($sig) = @_; $sig //= 'TERM'; $self->check_for_fork(); if (USE_P_GROUPS) { kill($sig, map { -$_ } keys %{$self->{+PROCS}}); } else { kill($sig, keys %{$self->{+PROCS}}); } } sub check_timeouts {} sub check_for_fork { my $self = shift; return 0 if $self->{+PID} == $$; $self->{+PROCS} = {}; $self->{+PROCS_BY_CAT} = {}; $self->{+WAITING} = {}; $self->{+PID} = $$; return 1; } sub _bring_out_yer_dead { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $waiting = $self->{+WAITING} //= {}; local $?; # Wait on any/all pids my $found = 0; while ((my $pid = waitpid(-1, WNOHANG)) > 0) { my $exit = $?; die "waitpid returned pid '$pid', but we are not monitoring that one!" unless $procs->{$pid}; $found++; $waiting->{$pid} = [$exit, time()]; } return $found; } sub _check_if_dead_yet { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; my $found = 0; for my $pid (keys %$waiting) { next if USE_P_GROUPS && kill(0, -$pid); $found++; my $args = delete $waiting->{$pid}; my $proc = delete $procs->{$pid}; delete $cat_procs->{$proc->category}->{$pid}; $self->set_proc_exit($proc, @$args); } return $found; } sub set_proc_exit { my $self = shift; my ($proc, @args) = @_; $proc->set_exit($self, @args); } sub _ex_parrots { my $self = shift; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; my $found = 0; for my $pid (keys %$procs) { next if $waiting->{$pid}; next if kill(0, $pid); $found++; warn "Process $pid vanished!"; $waiting->{$pid} = [-1, time()]; } return $found; } sub wait { my $self = shift; my %params = @_; $self->check_for_fork(); my $sig_count = $self->{+SIG_COUNT}; my $procs = $self->{+PROCS} //= {}; my $cat_procs = $self->{+PROCS_BY_CAT} //= {}; my $waiting = $self->{+WAITING} //= {}; return 0 unless keys(%$procs) || keys(%$waiting); my $cat_total = $params{cat} ? keys %{$cat_procs->{$params{cat}}} : 0; my $start = time; my $count = 0; my $found = 0; while (1) { $self->check_timeouts; $found += $self->_bring_out_yer_dead(); $found += $self->_check_if_dead_yet(); return $found if $self->_wait_done($found, $start, \%params); if (my $cat = $params{cat}) { my $cur_total = keys %{$cat_procs->{$cat}}; return 0 unless $cur_total; my $delta = $cat_total - $cur_total; return $delta if $delta; } # This is expensive, so only do it if we are gonna end up waiting # anyway If we do find anything here do not bother waiting. next if $self->_ex_parrots(); # Break the loop if we had a signal come in since starting last if $self->{+SIG_COUNT} > $sig_count; sleep($self->{+WAIT_TIME}) if $self->{+WAIT_TIME}; } warn "We escaped the wait cycle"; return $found; } sub _wait_done { my $self = shift; my ($found, $start, $params) = @_; my $all = keys(%{$self->{+PROCS}}); return 1 unless $all; return 1 if $params->{timeout} && time - $start >= $params->{timeout}; return 0 if $all && $params->{all}; return 0 if $params->{all_cat} && keys %{$self->{+PROCS_BY_CAT}->{$params->{all_cat}}}; return 0 if $params->{block} && !$found; # This gets validated outside this loop return 0 if $params->{cat}; return 1; } sub watch_pid { my $self = shift; my ($pid) = @_; my $proc = Test2::Harness::IPC::Process->new(pid => $pid); return $self->watch($proc); } sub watch { my $self = shift; my ($proc) = @_; $self->check_for_fork(); my $pid = $proc->pid or confess "Process has no pid"; $pid = abs($pid) if USE_P_GROUPS; croak "Already watching pid $pid" if exists $self->{+PROCS}->{$pid}; $self->{+PROCS}->{$pid} = $proc; $self->{+PROCS_BY_CAT}->{$proc->category}->{$pid} = $proc; } sub spawn { my $self = shift; my ($proc, $params); if (@_ == 1) { $proc = shift(@_); $params = $proc->spawn_params; } else { $params = {@_}; my $class = $params->{process_class} // 'Test2::Harness::IPC::Process'; $proc = $class->new(); } croak "No 'command' specified" unless $params->{command}; my $caller1 = [caller()]; my $caller2 = [caller(1)]; my $env = $params->{env_vars} // {}; $self->check_for_fork(); my $pid = run_cmd(env => $env, caller1 => $caller1, caller2 => $caller2, %$params); $proc->set_pid($pid); $self->watch($proc); return $proc; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::IPC - Base class for modules that control child processes. =head1 DESCRIPTION This module is the base class for all parts of L<Test2::Harness> that have to do process management. =head1 ATTRIBUTES =over 4 =item $pid = $ipc->pid The root PID of the IPC object. =item $hashref = $ipc->handlers Custom signal handlers specific to the IPC object. =item $hashref = $ipc->procs Hashref of C<< $pid => $proc >> where $proc is an instance of L<Test2::Harness::IPC::Proc>. =item $hashref = $ipc->procs_by_cat Hashref of C<< $category => { $pid => $proc } >>. =item $hashref = $ipc->waiting Hashref of processes that have finished, but have not been handled yet. This is an implementation detail you should not rely on. =item $float = $ipc->wait_time How long to sleep between loops when in a wait cycle. =item $bool = $ipc->started True if the IPC process has started. =item $ipc->sig_count Implementation detail, used to break wait loops when signals are received. =back =head1 METHODS =over 4 =item $ipc->start Start the IPC management (Insert signal handlers). =item $ipc->stop Stop the IPC management (Remove signal handlers). =item $ipc->set_sig_handler($sig, sub { ... }) Set a custom signal handler. This is a safer version of C<< local %SIG{$sig} >> for use with IPC. The callback will get exactly one argument, the name of the signal that was received. =item $ipc->handle_sig($sig) Handle the specified signal. Will cause process exit if the signal has no handler. =item $ipc->killall() =item $ipc->killall($sig) Kill all tracked child process with the given signal. C<TERM> is used if no signal is specified. This will not wait on the processes, you must call C<< $ipc->wait() >>. =item $ipc->check_timeouts This is a no-op on the IPC base class. This is called every loop of C<< $ipc->wait >>. If you subclass the IPC class you can fill this in to make processes timeout if needed. =item $ipc->check_for_fork This is used a lot internally to check if this is a forked process. If this is a forked process the IPC object is completely reset with no remaining internal state (except signal handlers). =item $ipc->set_proc_exit($proc, @args) Calls C<< $proc->set_exit(@args) >>. This is called by C<< $ipc->wait >>. You can override it to add custom tasks when a process exits. =item $int = $ipc->wait() =item $int = $ipc->wait(%params) Wait on processes, return the number found. Default is non-blocking. Options: =over 4 =item timeout => $float If a blocking parameter is provided this can be used to break the wait after a timeout. L<Time::HiRes> is used, so timeout is in seconds with decimals. =item all => $bool Block until B<ALL> processes are done. =item cat => $category Block until at least 1 process from the category is complete. =item all_cat => $category Block until B<ALL> processes from the category are complete. =item block => $bool Block until at least 1 process is complete. =back =item $ipc->watch($proc) Add a process to be monitored. =item $proc = $ipc->spawn($proc) =item $proc = $ipc->spawn(%params) In the first form $proc is an instance of L<Test2::Harness::IPC::Proc> that provides C<spawn_params()>. In the second form the following params are allowed: Anything supported by C<run_cmd()> in L<Test2::Harness::Util::IPC>. =over 4 =item process_class => $CLASS Default is L<Test2::Harness::IPC::Process>. =item command => $command Program command to call. This is required. =item env_vars => { ... } Specify custom environment variables for the new process. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������Log.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 17650�15267772575� 21262� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Log; use strict; use warnings; our $VERSION = '1.000182'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log - Documentation about the L<Test2::Harness> log file. =head1 DESCRIPTION L<Test2::Harness> aka L<App::Yath> produces a rich/complete log when asked to do so. This module documents the log format. =head1 COMPRESSION Test2::Harness can output log files uncompressed, compressed in gzip, or compressed in bzip2. =head1 FORMAT The log file is in jsonl format. Each line of the log can be independently parsed as json. Each line represents a single event Test2::Harness processed during a run. These events will be in the original order Test2::Harness processed them in (may not be chronological to when they were generated as generation, collection, processing, and rendering are handled in different processes. A complete log will be terminated by the string C<null>, which is also valid json. If a log is missing this terminator it is considered an incomplete log. =head2 EVENTS B<Please note:> Older versions of Test2::Harness produced less complete events, this covers all current fields, if you are attempting to handle very old logs some of these fields may be missing. Each event will have the following fields: { "event_id" : "CD01CD30-D535-11EA-9B6A-D90F9664FE12", "job_id" : 0, "job_try" : null, "run_id" : "CCF98E54-D535-11EA-915A-D70F9664FE12", "stamp" : 1596423763.76517, "facet_data" : { "harness" : { "event_id" : "CD01CD30-D535-11EA-9B6A-D90F9664FE12", "job_id" : 0, "job_try" : null, "run_id" : "CCF98E54-D535-11EA-915A-D70F9664FE12" }, ... } } =over 4 =item event_id : "UUID_OR_STRING" Typically this will be a UUID, but when UUIDs cannot be generated it may have a different unique identifier. This will always be a string. This may never be NULL, if it is NULL then that is a bug and should be reported. =item job_id : "0_OR_UUID_OR_STRING" ID C<0> is special in that it represents the test harness itself, and not an actual test being run. Normally the job_id will be a UUID, but may be another unique string if UUID generation is disabled or not available. =item job_try : INTEGER_OR_NULL For C<< job_id => 0 >> this will be C<NULL> for any other job this will be an integer of 0 or greater. This is 0 for the first time a test job is run, if a job is re-run due to failure (or any other reason) this will be incremented to tell you what run it is. When a job is re-run it keeps the same job ID, you can use this to distinguish events from each run of the job. =item run_id : "UUID_OR_STRING" This is the run_id of the entire yath test run. This should be the same for every event in any given log. =item stamp : UNIX_TIME_STAMP Timestamp of the event. This is NORMALLY set when an event is generated, however if an event does not have its own time stamp yath will give it a timestamp upon collection. Events without timestamps happen if the test outputs TAP instead of L<Test2::Event> objects, or if a tool misbehaves in some way. =item facet_data : HASH This contains all the the data of the event, such as if an assertion was made, what file name and line number generated it, etc. In addition to the original facets of the event, Test2::Harness may inject the following facets (or generate completely new events to convey these facets). =over 4 =item harness_final This will contain the final summary data from the end of the test run. { # Was the test run a success, or were there failures? pass => $BOOL, # What tests failed? failed => [ [ $job_id, # Job id of the job that failed $file, # Test filename ], ... ], # What tests had to be retried, and did they eventually pass? retried => [ [ $job_id, # Job id of the job that was retied $tries, # Number of tries attempted $file, # Test filename $eventually_passed, # 'YES' if it eventually passed, 'NO' if no try ever passed. ], ... ], # What tests setn a halt event (such as bail-out, or skip the rest) halted => [ [ $job_id, # Job id of the test $file, # Test filename $halt, # Halt code ], ... ], # What tests were never run (maybe because of a bail-out, or an internal error) unseen => [ [ $job_id, # Job id of the test $file, # Test filename ], ... ], } =item harness_watcher Internal use only, subject to change, do not rely on it. =item harness_job A hash representation of an L<Test2::Harness::Runner::Job> object. B<Note:> This is done via a transformation, several methods have their values stored in this hash when the original object does not directly store them. =item harness_job_end { file => $provided_path_to_test_file, rel_file => $relative_path_to_test_file, abs_file => $absolute_path_to_test_file, fail => $BOOL, retry => $INTEGER, # Number of retries left stamp => $UNIX_TIMESTAMP, # Timestamp of when the test completed # May not be present skip => $STRING, # Reason test was skipped (if it was skipped) times => $TIMING_DATA, # See below } The C<times> field is populated by calling C<data_dump()> on an L<Test2::Harness::Auditor::TimeTracker> Object. =item harness_job_exit This represents when the test job exited. { exit => $WSTAT, retry => $INTEGER stamp => $UNIX_TIMESTAMP } =item harness_job_fields Extra data attached to the harness job, usually from an L<Test2::Harness::Plugin> via C<inject_run_data()>. =item harness_job_launch This facet is almost always in the same event as the C<harness_job_start> facet. I<NOTE:> While writing these docs the author wonders if this facet is unnecessary... { stamp => $UNIX_TIMESTAMP, rety => $INTEGER, } =item harness_job_queued This data is produced by the C<queue_item> method in L<Test2::Harness::TestFile>. This contains the data about a test job conveyed by the queue. This usually contains data that will later be used by L<Test2::Harness::Runner::Job>. It is better to use the C<harness_job> facet, which contains the final data used to run the job. The following 3 fields are the only ones likely to be useful to most people: { file => $ORIGINAL_PATH_TO_FILE, job_id => $UUID_OR_STRING, stamp => $UNIX_TIMESTAMP, } =item harness_job_start This facet is sent in an event as soon as a job starts. The data in this facet is mainly intended to convey necessary information to a renderer so that it can render the fact that a job started. { file => $provided_path_to_test_file, rel_file => $relative_path_to_test_file, abs_file => $absolute_path_to_test_file, stamp => $UNIX_TIMESTAMP, # Timestamp of when the test completed job_id => $UUID_OR_STRING, details => "Job UUID_OR_STRING started at $UNIX_TIMESTAMP", } =item harness_run A hash representation of an L<Test2::Harness::Run> object. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������Run.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 5262�15267772575� 21261� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Run; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use File::Spec; use Test2::Harness::Util::HashBase qw{ <run_id <env_vars <author_testing <unsafe_inc <links <event_uuids <use_stream <mem_usage <io_events <dbi_profiling <input <input_file <test_args <load <load_import <fields <meta <retry <retry_isolated }; sub init { my $self = shift; croak "run_id is required" unless $self->{+RUN_ID}; } sub run_dir { my $self = shift; my ($workdir) = @_; return File::Spec->catfile($workdir, $self->{+RUN_ID}); } sub TO_JSON { +{ %{$_[0]} } } sub queue_item { my $self = shift; my ($plugins) = @_; croak "a plugins arrayref is required" unless $plugins; my $out = {%$self}; my $meta = $out->{+META} //= {}; my $fields = $out->{+FIELDS} //= []; for my $p (@$plugins) { $p->inject_run_data(meta => $meta, fields => $fields, run => $self); } return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Run - Representation of a set of tests to run, and their options. =head1 DESCRIPTION =head1 ATTRIBUTES These are set at construction time and cannot be modified. See L<App::Yath::Options::Run> for more documentation on these. =head2 FROM OPTIONS =over 4 =item $bool = $run->author_testing =item $hashref = $run->env_vars =item $bool = $run->event_uuids =item $arrayref = $run->fields =item $string = $run->input =item $path = $run->input_file =item $bool = $run->io_events =item $arrayref = $run->links =item $arrayref = $run->load =item $hashref = $run->load_import =item $bool = $run->mem_usage =item $int = $run->retry =item $bool = $run->retry_isolated =item $string = $run->run_id =item $arrayref = $run->test_args =item $bool = $run->unsafe_inc =item $bool = $run->use_stream =back =head2 OTHER =over 4 =item $hashref = $run->meta meta-data plugins may have attached. =back =head1 METHODS =over 4 =item $path = $run->run_dir($workdir) Returns the path C<"$workdir/$run_id">. =item $hashref = $run->queue_item(\@PLUGINS) Gets the queue item that represents this object. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������coverage.t������������������������������������������������������������������������������������������100644��001750��001750�� 32450�15267772575� 21572� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000029'; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my ($fh, $cfile) = tempfile(SUFFIX => '.json'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', "--cover-write=$cfile", '-v'], exit => 0, ); open($fh, '<', $cfile); my $json = join '' => <$fh>; my $coverage = decode_json($json); is( $coverage, { 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByRun', 'testmeta' => { 't/integration/coverage/a.tx' => {'manager' => 'Manager', 'type' => 'split'}, 't/integration/coverage/b.tx' => {'type' => 'flat'}, 't/integration/coverage/c.tx' => {'manager' => 'Manager', 'type' => 'split'}, 't/integration/coverage/once.tx' => {'type' => 'flat'}, 't/integration/coverage/open.tx' => {'type' => 'flat'}, 't/integration/coverage/x.tx' => {'type' => 'flat'}, }, 'files' => { 'Ax.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/c.tx' => [{'subtest' => 'a'}], }, 'a' => { 't/integration/coverage/a.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'b'}; item {'subtest' => 'a'}; end; }, 't/integration/coverage/c.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'a'}; end; }, }, 'aa' => {'t/integration/coverage/a.tx' => [{'subtest' => 'a'}]}, }, 'Bx.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/b.tx' => ['*'], 't/integration/coverage/x.tx' => ['*'], }, '<>' => {'t/integration/coverage/open.tx' => ['*']}, 'b' => { 't/integration/coverage/a.tx' => bag { item {'subtest' => 'c'}; item {'subtest' => 'b'}; end; }, 't/integration/coverage/b.tx' => ['*'], }, }, 'Cx.pm' => { '*' => { 't/integration/coverage/a.tx' => ['*'], 't/integration/coverage/c.tx' => [{'subtest' => 'c'}], }, 'c' => { 't/integration/coverage/a.tx' => bag { item '*'; item {'subtest' => 'c'}; end; }, 't/integration/coverage/c.tx' => [{'subtest' => 'c'}] }, }, }, }, "Got predicted coverage data", ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); # Add some tests that do not exist, coverage testing shoudl warn and should skip them. $coverage->{testmeta}->{'t/integration/coverage/mia1.tx'} = $coverage->{testmeta}->{'t/integration/coverage/a.tx'}; $coverage->{testmeta}->{'t/integration/coverage/mia2.tx'} = $coverage->{testmeta}->{'t/integration/coverage/b.tx'}; $coverage->{files}->{'Ax.pm'}->{'*'}->{'t/integration/coverage/mia1.tx'} = ['*']; $coverage->{files}->{'Ax.pm'}->{'*'}->{'t/integration/coverage/mia2.tx'} = ['*']; open($fh, '>', $cfile) or die "Could not open file: $!"; my $njson = encode_json($coverage); print $fh $njson; close($fh); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); like( $out->{output}, qr{Coverage wants to run test 't/integration/coverage/mia1\.tx', but it does not exist, skipping\.\.\.}, "Skipped mia1 because it does not exist", ); like( $out->{output}, qr{Coverage wants to run test 't/integration/coverage/mia2\.tx', but it does not exist, skipping\.\.\.}, "Skipped mia2 because it does not exist", ); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������encoding.t������������������������������������������������������������������������������������������100644��001750��001750�� 3550�15267772575� 21544� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; use File::Temp qw/tempdir/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; use POSIX qw/locale_h/; my $locale = setlocale(LC_CTYPE) || ''; skip_all "This test requires a UTF-8 locale (got: $locale)" unless $locale =~ /utf-?8/i; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $want = <<"EOT"; ( NOTE ) job 1 valid note [\x{201c}\x{201d}\x{ff}\x{ff}] ( NOTE ) job 1 valid note [\x{201c}\x{201d}] ( DIAG ) job 1 valid diag [\x{201c}\x{201d}\x{ff}\x{ff}] ( DIAG ) job 1 valid diag [\x{201c}\x{201d}] ( STDOUT ) job 1 valid stdout [\x{201c}\x{201d}\x{ff}\x{ff}] ( STDOUT ) job 1 valid stdout [\x{201c}\x{201d}] ( STDERR ) job 1 valid stderr [\x{201c}\x{201d}\x{ff}\x{ff}] ( STDERR ) job 1 valid stderr [\x{201c}\x{201d}] [ PASS ] job 1 + valid ok [\x{201c}\x{201d}\x{ff}\x{ff}] [ PASS ] job 1 + valid ok [\x{201c}\x{201d}] ( STDOUT ) job 1 STDOUT: M\x{101}kaha ( STDERR ) job 1 STDERR: M\x{101}kaha ( DIAG ) job 1 DIAG: M\x{101}kaha ( NOTE ) job 1 NOTE: M\x{101}kaha [ PASS ] job 1 + ASSERT: M\x{101}kaha [ PASS ] job 1 + \x{406} \x{449}\x{435} \x{442}\x{440}\x{43e}\x{445}\x{438} EOT yath( command => 'test', args => ['-v', "$dir/plugin.tx"], exit => 0, encoding => 'utf8', test => sub { my $out = shift; like($out->{output}, qr/\Q$want\E/, "Got proper codepoints"); }, ); yath( command => 'test', args => ['-v', "$dir/no-plugin.tx"], exit => 0, test => sub { my $out = shift; utf8::encode( my $raw_want = $want ); utf8::encode( my $u00ff = "\x{ff}" ); $raw_want =~ s<\Q$u00ff\E><\xff>g; like($out->{output}, qr/\Q$raw_want\E/, "Got proper codepoints"); }, ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������inc_hook.t������������������������������������������������������������������������������������������100644��001750��001750�� 3063�15267772575� 21546� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; use File::Temp qw/tempdir/; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $dir = __FILE__; $dir =~ s{\.t$}{}g; my $hook_dir = File::Spec->rel2abs($dir); my $target = File::Spec->catfile($hook_dir, 'simple.tx'); # Run where the rc search, which walks up from cwd, finds no .yath.rc, keeping # the project rc's -D and -I settings out of the @INC this file inspects. chdir(tempdir(CLEANUP => 1, TMPDIR => 1)) or die "Could not chdir to a temp dir: $!"; # One fixture per @INC hook form documented in perlvar "@INC". Unfiltered, the # blessed hook aborts the run when the settings are JSON encoded, and all three # reach child -I flags as nonexistent 'CODE(0x...)' style paths. my @cases = ( {name => 'blessed object hook', module => 'FakeHook', ref_re => qr{/FakeHook=HASH\(}}, {name => 'coderef hook', module => 'CoderefHook', ref_re => qr{/CODE\(0x}}, {name => 'arrayref hook', module => 'ArrayrefHook', ref_re => qr{/ARRAY\(0x}}, ); for my $case (@cases) { yath( command => 'test', args => ['-v', $target], env => {PERL5OPT => "-I$hook_dir -M$case->{module}"}, exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr/encountered object|JSON can only represent/, "$case->{name}: no JSON encode error"); unlike($out->{output}, $case->{ref_re}, "$case->{name}: no stringified hook in the reported \@INC"); }, ); } done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������includes.t������������������������������������������������������������������������������������������100644��001750��001750�� 1675�15267772575� 21572� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use IPC::Cmd qw/can_run/; use File::Spec; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; chdir($dir); $ENV{OLD_PERL5LIB} = $ENV{PERL5LIB}; yath( command => 'test', args => ['default.tx'], exit => 0, ); yath( command => 'test', args => ['-Ixyz', 'default-i.tx'], exit => 0, ); yath( command => 'test', args => ['-Ia', '-b', '-Ib', '-l', '-Ic', 'order-ibili.tx'], exit => 0, ); yath( command => 'test', args => ['-Ia', '-l', '-Ib', '-b', '-Ic', 'order-ilibi.tx'], exit => 0, ); yath( command => 'test', args => ['-Ixyz', '--unsafe-inc', 'dot-last.tx'], exit => 0, ); $ENV{YATH_PERL} = $^X; yath( command => 'test', args => ['-Ixyz', './not-perl.sh'], exit => 0, ) if can_run('bash'); done_testing; �������������������������������������������������������������������projects.t������������������������������������������������������������������������������������������100644��001750��001750�� 4532�15267772575� 21610� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $out; yath( command => 'projects', args => ['--ext=tx', '--', $dir], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); unlike($out->{output}, qr{fail\.txx}, "Did not run fail.txx"); }, ); yath( command => 'projects', args => ['--ext=tx', '--ext=txx', '--', $dir], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); like($out->{output}, qr{FAILED .*baz.*t.*fail\.txx}, "ran fail.txx"); }, ); chdir($dir); yath( command => 'projects', args => ['--ext=tx', '-v'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); unlike($out->{output}, qr{fail\.txx}, "Did not run fail.txx"); }, ); yath( command => 'projects', args => ['--ext=tx', '--ext=txx'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr{PASSED .*foo.*t.*pass\.tx}, "Found pass.tx in foo project"); like($out->{output}, qr{PASSED .*bar.*t.*pass\.tx}, "Found pass.tx in bar project"); like($out->{output}, qr{PASSED .*baz.*t.*pass\.tx}, "Found pass.tx in baz project"); like($out->{output}, qr{FAILED .*baz.*t.*fail\.txx}, "ran fail.txx"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������resource.t������������������������������������������������������������������������������������������100644��001750��001750�� 7023�15267772575� 21604� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-j4', "-D$dir", '-R+Resource'], log => 1, exit => 0, test => sub { my $out = shift; my $log = $out->{log}; my @events = $log->poll(); my %pids; my %msgs; for my $event (@events) { my $f = $event->{facet_data}; my $info = $f->{info} or next; for my $i (@$info) { next unless $i->{tag} eq 'INTERNAL'; if ($i->{details} =~ m/^(\S+) - (yath-\S+)$/) { $pids{$1} = $2; next; } next unless $i->{details} =~ m/^(\S+) - (?:(\S+): \S+ - (\d)|(.+))$/; my ($pid, $action, $res_id) = ($1, ($2 || $4), $3); $pid = $pids{$pid} // $pid; if ($res_id) { push @{$msgs{$pid}->{$res_id}} => $action; } else { push @{$msgs{$pid}->{$_}} => $action for keys %{$msgs{$pid}}; } } } # Which slot serves which test is up to timing: a machine where one # test finishes early lets its slot take the next two, and nothing is # wrong with that. What has to hold is that each slot is used and # freed in order, that all four tests went through, and that the # scheduler noticed when it ran out of slots. my $cycle = sub { my ($actions, @pattern) = @_; my $i = 0; for my $action (@$actions) { return "expected $pattern[$i], got $action" unless $action eq $pattern[$i]; $i = ($i + 1) % @pattern; } return "ended mid-cycle, expected $pattern[$i]" if $i; return undef; }; my $runner = $msgs{'yath-nested-runner'}; is([sort keys %$runner], [1, 2], "The runner saw both slots"); my %runner_counts; for my $slot (sort keys %$runner) { my @actions = @{$runner->{$slot}}; is(pop(@actions), 'RESOURCE CLEANUP', "Slot $slot was cleaned up at the end of the run"); $runner_counts{$_}++ for @actions; is($cycle->(\@actions, 'Record', 'Release'), undef, "Slot $slot was recorded and released in turn by the runner") or diag(join(', ' => @{$runner->{$slot}})); } is(\%runner_counts, {Record => 4, Release => 4}, "The runner ran all 4 tests"); my $scheduler = $msgs{'yath-nested-scheduler'}; is([sort keys %$scheduler], [1, 2], "The scheduler saw both slots"); my %scheduler_counts; my $no_slots = 0; for my $slot (sort keys %$scheduler) { my @actions = grep { $_ ne 'No Slots' } @{$scheduler->{$slot}}; $no_slots++ if @actions != @{$scheduler->{$slot}}; $scheduler_counts{$_}++ for @actions; is($cycle->(\@actions, 'Assigned', 'Record', 'Release'), undef, "Slot $slot was assigned, recorded and released in turn") or diag(join(', ' => @{$scheduler->{$slot}})); } is(\%scheduler_counts, {Assigned => 4, Record => 4, Release => 4}, "The scheduler assigned all 4 tests"); ok($no_slots, "The scheduler ran out of slots at some point"); }, ); done_testing; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������smoke�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20544� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 21442� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21444� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21445� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21446� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������e.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21447� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������f.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21450� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������g.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21451� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������h.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 57�15267772575� 21452� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������speedtag.t������������������������������������������������������������������������������������������100644��001750��001750�� 2506�15267772575� 21552� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use File::Copy qw/copy/; use Test2::Harness::Util::File::JSONL; use App::Yath::Tester qw/yath/; use App::Yath::Util qw/find_yath/; find_yath(); # cache result before we chdir my $tmp = tempdir(CLEANUP => 1); my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; my $pass = File::Spec->catfile($tmp, 'pass.tx'); my $pass2 = File::Spec->catfile($tmp, 'pass2.tx'); copy(File::Spec->catfile($dir, 'pass.tx'), $pass); copy(File::Spec->catfile($dir, 'pass2.tx'), $pass2); my $out = yath(command => 'test', args => [$tmp, '--ext=tx'], log => 1, exit => 0); my $log = $out->{log}->name; yath( command => 'speedtag', args => [$log], exit => 0, test => sub { like($_, qr/Tagged .*pass\.tx/, "Indicate we tagged pass"); like($_, qr/Tagged .*pass2\.tx/, "Indicate we tagged pass2"); for my $file ($pass, $pass2) { open(my $fh, '<', $file) or die $!; my $found = 0; while (my $line = <$fh>) { chomp($line); next unless $line =~ m/^#\s*HARNESS-DURATION-(SHORT|MEDIUM|LONG)$/; $found = 1; last; } $file =~ s/^.*(pass\d?\.tx)$/$1/; ok($found, "Tagged file $file"); } }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Option.t��������������������������������������������������������������������������������������������100644��001750��001750�� 41277�15267772575� 21337� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Option'; use Test2::Harness::Settings; subtest types => sub { ok($CLASS->valid_type($_), "'$_' is a valid type") for qw/b c s m d D h H/; ok(!$CLASS->valid_type('x'), "'x' is not a valid type"); is($CLASS->canon_type($_), 'b', "Converted '$_' to 'b'") for qw/bool boolean/; is($CLASS->canon_type($_), 'c', "Converted '$_' to 'c'") for qw/count counter counting/; is($CLASS->canon_type($_), 's', "Converted '$_' to 's'") for qw/scalar string number/; is($CLASS->canon_type($_), 'm', "Converted '$_' to 'm'") for qw/multi multiple list array/; is($CLASS->canon_type($_), 'd', "Converted '$_' to 'd'") for qw/default def/; is($CLASS->canon_type($_), 'D', "Converted '$_' to 'D'") for qw/multi-def multiple-default list-default array-default/; is($CLASS->canon_type($_), 'h', "Converted '$_' to 'h'") for qw/hash/; is($CLASS->canon_type($_), 'H', "Converted '$_' to 'H'") for qw/hash-list/; for my $t (qw/s m h H/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), T(), "type '$t' requires an arg"); is($one->allows_arg(), T(), "type '$t' does allow an arg"); } for my $t (qw/d D/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), F(), "type '$t' does not require an arg"); is($one->allows_arg(), T(), "type '$t' does allow an arg"); } for my $t (qw/b c/) { my $one = bless {type => $t}, $CLASS; is($one->requires_arg(), F(), "type '$t' does not require an arg"); is($one->allows_arg(), F(), "type '$t' does not allow an arg"); } }; subtest init => sub { like( dies { $CLASS->new() }, qr/You must specify 'title' or both 'field' and 'name'/, "Need 'title', or 'field' and 'name'" ); like( dies { $CLASS->new(title => 'foo') }, qr/The 'prefix' attribute is required/, "prefix is required" ); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', alt => 'xxx') }, qr/The 'alt' attribute must be an array-ref/, "Alt, when present must be an arrayref" ); my $one = $CLASS->new(title => 'foo-bar_baz', prefix => 'xxx'); isa_ok($one, [$CLASS], "Instance of $CLASS"); is($one->title, 'foo-bar_baz', "set title"); is($one->field, 'foo_bar_baz', "field has underscores"); is($one->name, 'foo-bar-baz', "name has dashes"); is($one->type, 'b', "Default type is boolean"); $one = $CLASS->new(title => 'foo-bar_baz', prefix => 'xxx', from_plugin => 1); is($one->title, 'foo-bar_baz', "set title"); is($one->field, 'foo_bar_baz', "field has underscores"); is($one->name, 'xxx-foo-bar-baz', "name has dashes, prefix is in place if it is a plugin option"); is($one->type, 'b', "Default type is boolean"); { package Foo; Test2::Harness::Util::HashBase->import(qw/bar/); } like( dies { $CLASS->new(title => 'baz', prefix => 'xxx', builds => 'Foo') }, qr/class 'Foo' does not have a 'baz' method/, "If the option is supposed to build a specific class, make sure the class knows" ); ok($CLASS->new(title => 'bar', prefix => 'xxx', builds => 'Foo'), "Construction is fine if build package has the right method"); ok($CLASS->new(title => 'bar', prefix => 'xxx', type => 's'), "'s' is a valid type"); is($CLASS->new(title => 'bar', prefix => 'xxx', type => 'scalar')->type, 's', "'scalar' is a valid type, turns into 's'"); like( dies { $CLASS->new(title => 'bar', prefix => 'xxx', type => 'uhg') }, qr/Invalid type 'uhg'/, "Type must be valid" ); is($CLASS->new(title => 'foo', prefix => 'xxx', default => 'foo')->default, 'foo', "Simple string default is fine"); is($CLASS->new(title => 'foo', prefix => 'xxx', default => 123)->default, 123, "Simple number default is fine"); is($CLASS->new(title => 'foo', prefix => 'xxx', default => \&T)->default, exact_ref(\&T), "Can use a coderef for default"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', default => []) }, qr/'default' must be a simple scalar, or a coderef, got a 'ARRAY/, "Cannot use a non-coderef ref as a default" ); for my $attr (qw/normalize action/) { is($CLASS->new(title => 'foo', prefix => 'xxx', $attr => \&T)->$attr, exact_ref(\&T), "Can set $attr to a coderef"); is($CLASS->new(title => 'foo', prefix => 'xxx', $attr => undef)->$attr, undef, "Can set $attr to undef"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', $attr => []) }, qr/'$attr' must be undef, or a coderef, got 'ARRAY/, "Cannot use a non-coderef ref with $attr" ); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', $attr => 1) }, qr/'$attr' must be undef, or a coderef, got 'not a ref'/, "Cannot use a scalar with $attr" ); } $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is($one->trace, array { item __PACKAGE__; item __FILE__; item __LINE__ - 1; etc; }, "Got correct trace"); is($one->category, 'NO CATEGORY - FIX ME', "Default category"); is($one->description, 'NO DESCRIPTION - FIX ME', "Default description"); like( dies { $CLASS->new(title => 'foo', prefix => 'xxx', foo => 'bar') }, qr/'foo' is not a valid option attribute/, "All construction args must be valid" ); }; subtest applicable => sub { my $options = 'foo'; my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is($one->applicable($options), T(), "Unless a callback was provided and option is always applicable."); my $args; $one = $CLASS->new(title => 'foo', prefix => 'xxx', applicable => sub {$args = [@_]; 0}); is($one->applicable($options), F(), "Used value from callback"); is($args, [exact_ref($one), $options], "Callback got the necessary args"); }; subtest long_args => sub { my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); is([$one->long_args], [qw/foo/], "Got long args"); $one = $CLASS->new(title => 'foo', prefix => 'xxx', alt => [qw/a b c/]); is([$one->long_args], [qw/foo a b c/], "Got long args"); }; subtest option_slot => sub { my $one = $CLASS->new(title => 'foo', prefix => 'xxx'); my $settings = Test2::Harness::Settings->new(); ok(my $slot = $one->option_slot($settings), "Got the slot"); is($$slot, undef, "slot is a reference pointing to a scalar with an undef value"); is($settings->xxx->foo, undef, "Vivified in settings"); $$slot = 123; is($settings->xxx->foo, 123, "Setting the slotref sets it in settings"); like( dies { $one->option_slot() }, qr/A settings instance is required/, "Need to pass in settings" ); }; subtest get_default => sub { my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_) }; is($new->(type => 's')->get_default, undef, "default for scalar is undef"); is($new->(type => 'd')->get_default, undef, "default for 'd' is undef"); is($new->(type => 'b')->get_default, 0, "default for boolean is 0"); is($new->(type => 'c')->get_default, 0, "default for count is 0"); is($new->(type => 'm')->get_default, [], "default for multi is an empty array"); is($new->(type => 'D')->get_default, [], "default for multi-d is an empty array"); is($new->(type => 'h')->get_default, {}, "default for hash is an empty hash"); is($new->(type => 'H')->get_default, {}, "default for multi-hash is an empty hash"); is($new->(type => 's', default => 123)->get_default, 123, "Used simple default"); is($new->(type => 's', default => sub { 'xxx' })->get_default, 'xxx', "Used default generator"); }; subtest get_normalized => sub { my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_) }; is($new->(type => 'b')->get_normalized('a'), 1, "Boolean normalized to true"); is($new->(type => 'b')->get_normalized(''), 0, "Boolean normalized to false"); is($new->(type => 's')->get_normalized('foo'), 'foo', "Normalize does not change most things"); is($new->(type => 'h')->get_normalized('foo=bar'), ['foo', 'bar'], "Simple hash parse/normalize"); is($new->(type => 'h')->get_normalized('foo=bar=baz,bat'), ['foo', 'bar=baz,bat'], "Do not do anything special for 'h' values"); is($new->(type => 'h')->get_normalized('foo'), ['foo', 1], "Value is 1 if nothing is specified"); is($new->(type => 'H')->get_normalized('foo=bar'), ['foo', ['bar']], "Simple multi-hash parse/normalize"); is($new->(type => 'H')->get_normalized('foo=bar=baz,bat'), ['foo', ['bar=baz', 'bat']], "Split 'H' by comma"); is($new->(type => 'H')->get_normalized('foo'), ['foo', []], "Value is [] if nothing is specified"); }; subtest handle => sub { require App::Yath::Options; my $options = App::Yath::Options->new(); my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_), Test2::Harness::Settings->new() }; my ($one, $settings) = $new->(type => 'c'); $one->handle(1, $settings, $options); is($settings->xxx->foo, 1, "increment by 1"); $one->handle('a', $settings, $options); is($settings->xxx->foo, 2, "increment by 1 again"); ($one, $settings) = $new->(type => 'm'); $one->handle('a', $settings, $options); is($settings->xxx->foo, ['a'], "Pushed value"); $one->handle('b', $settings, $options); is($settings->xxx->foo, ['a', 'b'], "Pushed value again"); ($one, $settings) = $new->(type => 'D'); $one->handle('a', $settings, $options); is($settings->xxx->foo, ['a'], "Pushed value"); $one->handle('b', $settings, $options); is($settings->xxx->foo, ['a', 'b'], "Pushed value again"); ($one, $settings) = $new->(type => 'h'); $one->handle('foo=bar', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => 'bar'}, "Set value and added it to the list key"); $one->handle('foo=baz', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => 'baz'}, "Reset value, not duplicated in the list key"); $one->handle('fog=baz', $settings, $options); is($settings->xxx->foo, {'@' => ['foo', 'fog'], foo => 'baz', fog => 'baz'}, "Set second key"); ($one, $settings) = $new->(type => 'H'); $one->handle('foo=bar', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => ['bar']}, "Set value and added it to the list key"); $one->handle('foo=baz,bat', $settings, $options); is($settings->xxx->foo, {'@' => ['foo'], foo => ['bar', 'baz', 'bat']}, "Added more values"); $one->handle('fog', $settings, $options); is($settings->xxx->foo, {'@' => ['foo', 'fog'], foo => ['bar', 'baz', 'bat'], fog => []}, "Set second key"); my $args; ($one, $settings) = $new->(type => 'H', action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; $args = [@_]; $handler->($slot, $norm); return 'xxx'; }); is($one->handle('foo=baz,bat', $settings, $options), 'xxx', "Returned value from action"); is($settings->xxx->foo, {'@' => ['foo'], foo => ['baz', 'bat']}, "Set value via handler"); is( $args, [ $one->prefix, $one->field, "foo=baz,bat", [foo => ['baz', 'bat']], exact_ref($one->option_slot($settings)), exact_ref($settings), meta { prop reftype => 'CODE' }, exact_ref($options), ], "Got args" ); }; subtest handle_negation => sub { require App::Yath::Options; my $options = App::Yath::Options->new(); my $new = sub { $CLASS->new(title => 'foo', prefix => 'xxx', @_), Test2::Harness::Settings->new() }; for my $type (qw/b c/) { my ($one, $settings) = $new->(type => $type); $one->handle(1, $settings, $options); is($settings->xxx->foo, 1, "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, 0, "'$type' Cleared"); } for my $type (qw/m D/) { my ($one, $settings) = $new->(type => $type); $one->handle('abc', $settings, $options); is($settings->xxx->foo, ['abc'], "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, [], "'$type' Cleared"); } for my $type (qw/h H/) { my ($one, $settings) = $new->(type => $type); $one->handle('abc', $settings, $options); is($settings->xxx->foo, {'@' => ['abc'], abc => T()}, "'$type' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, {}, "'$type' Cleared"); } my ($one, $settings) = $new->(type => 's'); $one->handle('abc', $settings, $options); is($settings->xxx->foo, 'abc', "'s' Is set"); $one->handle_negation($settings, $options); is($settings->xxx->foo, undef, "'s' Cleared"); }; subtest trace_string => sub { my $one = $CLASS->new(prefix => 'xxx', title => 'foo', trace => ['Foo', 'foo.pm', 42]); is($one->trace_string(), "foo.pm line 42", "Valid trace string"); }; subtest cli_docs => sub { my $one = $CLASS->new( type => 'b', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); require Test2::Util::Term; my $c = mock 'Test2::Util::Term' => ( override => [term_size => sub { 10 }], # Default to super small to make sure we do something sane ); is($one->cli_docs, "--foo, -F, --no-foo\n This is foo bar baz bat gsdgdsgfsdd", "Got docs"); $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); chomp(my $res = <<' EOT'); --foo KEY=VAL1,VAL2,..., --foo=KEY=VAL1,VAL2,..., -F KEY=VAL1,VAL2,... -F=KEY=VAL1,VAL2,..., --no-foo This is foo bar baz bat gsdgdsgfsdd Note: Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT is($one->cli_docs, $res, "Got more complex docs"); $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', alt => ['bar', 'baz'], short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', long_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], short_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], ); chomp($res = <<' EOT'); --foo KEY=VALX,VALY,..., --foo=KEY=VALX,VALY,..., --bar KEY=VALX,VALY,... --bar=KEY=VALX,VALY,..., --baz KEY=VALX,VALY,..., --baz=KEY=VALX,VALY,... -F KEY=VALX,VALY,..., -F=KEY=VALX,VALY,..., --no-foo This is foo bar baz bat gsdgdsgfsdd Note: Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT is($one->cli_docs, $res, "Got more complex docs with custom examples"); }; subtest pod_docs => sub { my $one = $CLASS->new( type => 'b', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); require Test2::Util::Term; my $c = mock 'Test2::Util::Term' => ( override => [term_size => sub { 10 }], # Default to super small to make sure we do something sane ); is($one->pod_docs, <<' EOT', "Got docs"); =item --foo =item -F =item --no-foo This is foo bar baz bat gsdgdsgfsdd EOT $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', ); is($one->pod_docs, <<' EOT', "Got more complex docs"); =item --foo KEY=VAL1,VAL2,... =item --foo=KEY=VAL1,VAL2,... =item -F KEY=VAL1,VAL2,... =item -F=KEY=VAL1,VAL2,... =item --no-foo This is foo bar baz bat gsdgdsgfsdd Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT $one = $CLASS->new( type => 'H', prefix => 'xxx', title => 'foo', alt => ['bar', 'baz'], short => 'F', description => 'This is foo bar baz bat gsdgdsgfsdd', long_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], short_examples => [' KEY=VALX,VALY,...', '=KEY=VALX,VALY,...'], ); is($one->pod_docs, <<' EOT', "Got more complex docs with custom examples"); =item --foo KEY=VALX,VALY,... =item --foo=KEY=VALX,VALY,... =item --bar KEY=VALX,VALY,... =item --bar=KEY=VALX,VALY,... =item --baz KEY=VALX,VALY,... =item --baz=KEY=VALX,VALY,... =item -F KEY=VALX,VALY,... =item -F=KEY=VALX,VALY,... =item --no-foo This is foo bar baz bat gsdgdsgfsdd Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. EOT }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin.t��������������������������������������������������������������������������������������������100644��001750��001750�� 1063�15267772575� 21272� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin'; isa_ok($CLASS, ['Test2::Harness::Plugin'], "Subclasses Test2::Harness::Plugin"); can_ok($CLASS, ['finish'], "finish() is defined"); is([$CLASS->finish], [], "finish returns an empty list in list context"); is($CLASS->finish, undef, "finish returns undef in scalar context"); ok(!$CLASS->can('sort_files'), "sort_files is not defined by default"); ok(!$CLASS->can('sort_files_2'), "sort_files_2 is not defined by default"); ok(!$CLASS->can('handle_event'), "handle_event is not defined by default"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Script����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20277� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������V1.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 20330�15267772575� 21301� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Script�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Script::V1; use strict; use warnings; our $VERSION = '1.000182'; my ($RUN_SUB, @DEVLIBS, $NO_PLUGINS); sub do_begin { my $class = shift; my %params = @_; my $script = $params{script}; my $argv = $params{argv}; my $config_file = $params{config}; my $user_config_file = $params{user_config}; local $.; my $ORIG_TMP; my $ORIG_TMP_PERMS; my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => "$SIG{$_}") : () } keys %SIG; my @ORIG_ARGV = @$argv; # Skip @INC hook refs (coderef / arrayref / blessed); they can't cross exec via -I nor round-trip JSON. my @ORIG_INC = grep { !ref($_) } @INC; my %CONFIG; @ARGV = @$argv; # ==START TESTABLE CODE PARSE_CONFIG_FILES== my (@CONFIG_ARGS, @TO_CLEAN); for my $file ($config_file, $user_config_file) { next unless $file && -f $file; my $cmd; open(my $fh, '<', $file) or die "Could not open config file '$file' for reading: $!"; while (my $line = <$fh>) { chomp($line); $cmd = $1 and next if $line =~ m/^\[(.*)\]$/; $line =~ s/;.*$//g; $line =~ s/^\s*//g; $line =~ s/\s*$//g; next unless length($line); my ($key, $eq, $val); if ($line =~ m/^(-\S)((?:rel|glob|relglob)\(.*\))$/) { # Handle things like -Irel(...) $key = $1; $eq = ''; $val = $2; } else { ($key, $eq, $val) = split /(=|\s+)/, $line, 2; # Covers most cases } my $is_pre; if ($key =~ m/^-D/ || $key eq '--dev-lib') { $eq = '=' if $val; $is_pre = 1; } if ($key eq '--no-scan-plugins') { $is_pre = 1; } my $need_to_clean; if ($val && $val =~ s/(^|=)\s*rel\(\s*//) { die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//; my $path = $file; $path =~ s{[^/]*$}{}g; $val = "${path}${val}"; $need_to_clean = 1; } my @all; if ($val && $val =~ s/(^|=)\s*(rel)?glob\(\s*//) { my $rel = $2; die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//; my $path = ''; if ($rel) { $path = $file; $path =~ s{[^/]*$}{}g; } # Avoid loading File::Glob in this process... my $out = `$^X -e 'print join "\\n" => glob("${path}${val}")'`; my @vals = split /\n/, $out; @all = map {[$key, $eq, $_, 1]} @vals; } else { @all = ([$key, $eq, $val, $need_to_clean]); } for my $set (@all) { my ($key, $eq, $val, $need_to_clean) = @$set; $eq //= ''; my @parts = $eq eq '=' ? ("${key}${eq}${val}") : (grep { defined $_ } $key, $val); if ($is_pre) { push @CONFIG_ARGS => @parts; } else { $cmd //= '~'; push @{$CONFIG{$cmd}} => @parts; push @TO_CLEAN => [$cmd, $#{$CONFIG{$cmd}}, $key, $eq, $val] if $need_to_clean; } } } close($fh); } unshift @ARGV => @CONFIG_ARGS; # ==END TESTABLE CODE PARSE_CONFIG_FILES== # ==START TESTABLE CODE PRE_PARSE_D_ARGS== my (@libs, %done, @args, $maybe_exec); while (@ARGV) { my $arg = shift @ARGV; if ($arg eq '--' || $arg eq '::') { push @args => $arg; last; } if ($arg eq '--no-dev-lib') { @libs = (); %done = (); next; } if ($arg =~ m{^(?:(?:-D=?|--dev-lib=)(.*)|--dev-lib)$}) { my @add = $1 ? ($1) : (); unless (@add) { @add = ('lib', 'blib/lib', 'blib/arch'); $maybe_exec = $arg; } push @libs => grep { !$done{$_}++ } @add; next; } if ($arg eq '--no-scan-plugins') { $NO_PLUGINS = 1; next; } push @args => $arg; } @ARGV = (@args, @ARGV); unshift @INC => @libs; @DEVLIBS = @libs; # ==END TESTABLE CODE PRE_PARSE_D_ARGS== # Now it is safe/ok to load things. require Cwd; require File::Spec; $ORIG_TMP = File::Spec->tmpdir(); $ORIG_TMP_PERMS = ((stat($ORIG_TMP))[2] & 07777); # ==START TESTABLE CODE CLEANUP_PATHS== if (@libs || @TO_CLEAN) { for (my $i = 0; $i < @libs; $i++) { $DEVLIBS[$i] = $INC[$i] = Cwd::realpath($INC[$i]) // File::Spec->rel2abs($INC[$i]); } for my $clean (@TO_CLEAN) { my ($cmd, $idx, $key, $eq, $val) = @$clean; $val = Cwd::realpath($val) // File::Spec->rel2abs($val); if ($eq eq '=') { $CONFIG{$cmd}->[$idx] = "${key}${eq}${val}"; } else { $CONFIG{$cmd}->[$idx] = $val; } } } # ==END TESTABLE CODE CLEANUP_PATHS== # ==START TESTABLE CODE CREATE_APP== require App::Yath; require Time::HiRes; require Test2::Harness::Settings; my %mixin = (config_file => '', user_config_file => ''); $mixin{config_file} = Cwd::realpath($config_file) // File::Spec->rel2abs($config_file) if $config_file; $mixin{user_config_file} = Cwd::realpath($user_config_file) // File::Spec->rel2abs($user_config_file) if $user_config_file; my $settings = Test2::Harness::Settings->new( harness => { orig_tmp => $ORIG_TMP, orig_tmp_perms => $ORIG_TMP_PERMS, orig_sig => \%ORIG_SIG, orig_argv => \@ORIG_ARGV, orig_inc => \@ORIG_INC, script => $script, no_scan_plugins => $NO_PLUGINS, dev_libs => \@DEVLIBS, start => Time::HiRes::time(), version => $App::Yath::VERSION, cwd => Cwd::getcwd(), %mixin, }, ); my $app = App::Yath->new( argv => \@ARGV, config => \%CONFIG, settings => $settings, ); $app->generate_run_sub('App::Yath::Script::V1::_run'); # ==END TESTABLE CODE CREATE_APP== # Reset these if we got this far. $? = 0; $@ = ''; } sub do_runtime { my $class = shift; return _run(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Script::V1 - V1 (Legacy) yath script handler for Test2::Harness =head1 DESCRIPTION This is the V1 script handler for L<Test2::Harness>. It is used by L<App::Yath::Script> when a C<.yath.rc> file with no version marker (or an explicit C<# V1> marker) is found, or when V1 is the highest installed version. This module contains the logic that was previously embedded directly in the C<scripts/yath> script of L<Test2::Harness>. =head1 METHODS =over 4 =item $class->do_begin(%params) Called during the C<BEGIN> phase. Parses configuration files, processes C<-D> and C<--no-scan-plugins> arguments, sets up C<@INC>, and initializes L<App::Yath>. Parameters: =over 4 =item script => $path Path to the executing script. =item argv => \@argv Original command line arguments. =item config => $path Path to the C<.yath.rc> file, or C<undef>. =item user_config => $path Path to the C<.yath.user.rc> file, or C<undef>. =back =item $exit = $class->do_runtime() Called after C<BEGIN>. Executes the yath command and returns the exit code. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Util.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 34256�15267772575� 21457� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util; use strict; use warnings; use Carp qw/confess/; use Cwd qw/realpath/; use Test2::Util qw/try_sig_mask do_rename/; use Fcntl qw/LOCK_EX LOCK_UN SEEK_SET :mode/; use File::Spec; our $VERSION = '1.000182'; use Importer Importer => 'import'; our @EXPORT_OK = qw{ find_libraries clean_path parse_exit mod2file file2mod fqmod maybe_open_file maybe_read_file open_file read_file write_file write_file_atomic lock_file unlock_file hub_truth apply_encoding process_includes chmod_tmp looks_like_uuid is_same_file }; sub is_same_file { my ($file1, $file2) = @_; return 0 unless defined $file1; return 0 unless defined $file2; return 1 if "$file1" eq "$file2"; return 1 if clean_path($file1) eq clean_path($file2); return 0 unless -e $file1; return 0 unless -e $file2; my ($dev1, $inode1) = stat($file1); my ($dev2, $inode2) = stat($file2); return 0 unless $dev1 == $dev2; return 0 unless $inode1 == $inode2; return 1; } sub looks_like_uuid { my ($in) = @_; return undef unless defined $in; return undef unless length($in) == 36; return undef unless $in =~ m/^[0-9A-F\-]+$/i; return $in; } sub chmod_tmp { my $file = shift; my $mode = S_ISVTX | S_IRWXU | S_IRWXG | S_IRWXO; chmod($mode, $file); } sub process_includes { my %params = @_; my @start = @{delete $params{list} // []}; my @list; my %seen = ('.' => 1); if (my $ch_dir = delete $params{ch_dir}) { for my $path (@start) { # '.' is special. $seen{'.'}++ and next if $path eq '.'; if (File::Spec->file_name_is_absolute($path)) { push @list => $path; } else { push @list => File::Spec->catdir($ch_dir, $path); } } } else { @list = @start; } # Skip @INC hook refs; clean_path would stringify them to bogus paths. push @list => grep { !ref($_) } @INC if delete $params{include_current}; @list = map { $_ eq '.' ? $_ : clean_path($_) || $_ } @list if delete $params{clean}; @list = grep { !$seen{$_}++ } @list; # If we ask for dot add it to the end. push @list => '.' if delete($params{include_dot}); confess "Invalid parameters: " . join(', ' => sort keys %params) if keys %params; return @list; } sub apply_encoding { my ($fh, $enc) = @_; return unless $enc; # https://rt.perl.org/Public/Bug/Display.html?id=31923 # If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in # order to avoid the thread segfault. return binmode($fh, ":utf8") if $enc =~ m/^utf-?8$/i; binmode($fh, ":encoding($enc)"); } sub parse_exit { my ($exit) = @_; my $sig = $exit & 127; my $dmp = $exit & 128; return { sig => $sig, err => ($exit >> 8), dmp => $dmp, all => $exit, }; } sub fqmod { my ($prefix, $input) = @_; return $1 if $input =~ m/^\+(.*)$/; return "$prefix\::$input"; } sub hub_truth { my ($f) = @_; return $f->{hubs}->[0] if $f->{hubs} && @{$f->{hubs}}; return $f->{trace} if $f->{trace}; return {}; } sub maybe_read_file { my ($file) = @_; return undef unless -f $file; return read_file($file); } sub read_file { my ($file, @args) = @_; my $fh = open_file($file, '<', @args); local $/; my $out = <$fh>; close_file($fh, $file); return $out; } sub write_file { my ($file, @content) = @_; my $fh = open_file($file, '>'); print $fh @content; close_file($fh, $file); return @content; }; my %COMPRESSION = ( bz2 => {module => 'IO::Uncompress::Bunzip2', errors => \$IO::Uncompress::Bunzip2::Bunzip2Error}, gz => {module => 'IO::Uncompress::Gunzip', errors => \$IO::Uncompress::Gunzip::GunzipError}, ); sub open_file { my ($file, $mode, %opts) = @_; $mode ||= '<'; unless ($opts{no_decompress}) { if (my $ext = $opts{ext}) { $opts{compression} //= $COMPRESSION{$ext} or die "Unknown compression: $ext"; } if ($file =~ m/\.(gz|bz2)$/i) { my $ext = lc($1); $opts{compression} //= $COMPRESSION{$ext} or die "Unknown compression: $ext"; } if ($mode eq '<' && $opts{compression}) { my $spec = $opts{compression}; my $mod = $spec->{module}; require(mod2file($mod)); my $fh = $mod->new($file) or die "Could not open file '$file' ($mode): ${$spec->{errors}}"; return $fh; } } open(my $fh, $mode, $file) or confess "Could not open file '$file' ($mode): $!"; return $fh; } sub maybe_open_file { my ($file, $mode) = @_; return undef unless -f $file; return open_file($file, $mode); } sub close_file { my ($fh, $name) = @_; return if close($fh); confess "Could not close file: $!" unless $name; confess "Could not close file '$name': $!"; } sub write_file_atomic { my ($file, @content) = @_; my $pend = "$file.pend"; my ($ok, $err) = try_sig_mask { write_file($pend, @content); my ($ren_ok, $ren_err) = do_rename($pend, $file); die "$pend -> $file: $ren_err" unless $ren_ok; }; die $err unless $ok; return @content; } sub lock_file { my ($file, $mode) = @_; my $fh; if (ref $file) { $fh = $file; } else { open($fh, $mode // '>>', $file) or die "Could not open file '$file': $!"; } for (1 .. 21) { flock($fh, LOCK_EX) and last; die "Could not lock file (try $_): $!" if $_ >= 20; next if $!{EINTR} || $!{ERESTART}; die "Could not lock file: $!"; } return $fh; } sub unlock_file { my ($fh) = @_; for (1 .. 21) { flock($fh, LOCK_UN) and last; die "Could not unlock file (try $_): $!" if $_ >= 20; next if $!{EINTR} || $!{ERESTART}; die "Could not unlock file: $!"; } return $fh; } sub clean_path { my ( $path, $absolute ) = @_; $absolute //= 1; $path = realpath($path) // $path if $absolute; return File::Spec->rel2abs($path); } sub mod2file { my ($mod) = @_; confess "No module name provided" unless $mod; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; return $file; } sub file2mod { my $file = shift; my $mod = $file; $mod =~ s{/}{::}g; $mod =~ s/\..*$//; return $mod; } sub find_libraries { my ($search, @paths) = @_; my @parts = grep $_, split /::(\*)?/, $search; # Skip @INC hook refs; canonpath would stringify them to bogus paths. @paths = grep { !ref($_) } @INC unless @paths; @paths = map { File::Spec->canonpath($_) } @paths; my %prefixes = map {$_ => 1} @paths; my @found; my @bases = ([map { [$_ => length($_)] } @paths]); while (my $set = shift @bases) { my $new_base = []; my $part = shift @parts; for my $base (@$set) { my ($dir, $prefix) = @$base; if ($part ne '*') { my $path = File::Spec->catdir($dir, $part); if (@parts) { push @$new_base => [$path, $prefix] if -d $path; } elsif (-f "$path.pm") { push @found => ["$path.pm", $prefix]; } next; } opendir(my $dh, $dir) or next; for my $item (readdir($dh)) { next if $item =~ m/^\./; my $path = File::Spec->catdir($dir, $item); if (@parts) { # Sometimes @INC dirs are nested in eachother. next if $prefixes{$path}; push @$new_base => [$path, $prefix] if -d $path; next; } next unless -f $path && $path =~ m/\.pm$/; push @found => [$path, $prefix]; } } push @bases => $new_base if @$new_base; } my %out; for my $found (@found) { my ($path, $prefix) = @$found; my @file_parts = File::Spec->splitdir(substr($path, $prefix)); shift @file_parts if $file_parts[0] eq ''; my $file = join '/' => @file_parts; $file_parts[-1] = substr($file_parts[-1], 0, -3); my $module = join '::' => @file_parts; $out{$module} //= $file; } return \%out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util - General utility functions. =head1 DESCRIPTION Utility functions used throughout the harness. Nothing here is specific to any one part of it; the sections below group the functions by the kind of work they do. =head1 METHODS =head2 MISC =over 4 =item apply_encoding($fh, $enc) Apply the specified encoding to the filehandle. B<Justification>: L<PERLBUG 31923|https://rt.perl.org/Public/Bug/Display.html?id=31923> If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in order to avoid the thread segfault. This is a reusable implementation of this: sub apply_encoding { my ($fh, $enc) = @_; return unless $enc; return binmode($fh, ":utf8") if $enc =~ m/^utf-?8$/i; binmode($fh, ":encoding($enc)"); } =item $clean = clean_path($path) Take a file path and clean it up to a minimal absolute path if possible. Always returns a path, but if it cannot be cleaned up it is unchanged. =item $hashref = find_libraries($search) =item $hashref = find_libraries($search, @paths) C<@INC> is used if no C<@paths> are provided. C<$search> should be a module name with C<*> wildcards replacing sections. find_libraries('Foo::*::Baz') find_libraries('*::Bar::Baz') find_libraries('Foo::Bar::*') These all look for modules matching the search, this is a good way to find plugins, or similar patterns. The result is a hashref of C<< { $module => $path } >>. If a module exists in more than 1 search path the first is used. =item $mod = fqmod($prefix, $mod) This will automatically add C<$prefix> to C<$mod> with C<'::'> to join them. If C<$mod> starts with the C<'+'> character the character will be removed and the result returned without prepending C<$prefix>. =item hub_truth This is an internal implementation detail, do not use it. =item $hashref = parse_exit($?) This parses the exit value as typically stored in C<$?>. Resulting hash: { sig => ($? & 127), # Signal value if the exit was caused by a signal err => ($? >> 8), # Actual exit code, if any. dmp => ($? & 128), # Was there a core dump? all => $?, # Original exit value, unchanged } =item @list = process_includes(%PARAMS) This method will build up a list of include dirs fit for C<@INC>. The returned list should contain only unique values, in proper order. Params: =over 4 =item list => \@START Paths to start the new list. Optional. =item ch_dir => $path Prefix to prepend to all paths in the C<list> param. No effect without an initial list. =item include_current => $bool This will add all paths from C<@INC> to the output, after the initial list. Hook entries in C<@INC> - coderefs, arrayrefs, and blessed objects - are not paths and are skipped. C<'.'> is skipped as well; use C<include_dot> to add it. =item clean => $bool If included all paths except C<'.'> will be cleaned using C<clean_path()>. =item include_dot => $bool If true C<'.'> will be appended to the end of the output. B<Note> this is the only way to get C<'.'> into the output. It is dropped from the initial list and from C<@INC> alike. =back =back =head2 FOR DEALING WITH MODULE <-> FILE CONVERSION These convert between module names like C<Foo::Bar> and filenames like C<Foo/Bar.pm>. =over 4 =item $file = mod2file($mod) =item $mod = file2mod($file) =back =head2 FOR READING/WRITING FILES =over 4 =item $fh = open_file($path, $mode) =item $fh = open_file($path) If no mode is provided C<< '<' >> is assumed. This will open the file at C<$path> and return a filehandle. An exception will be thrown if the file cannot be opened. B<NOTE:> This will automatically use L<IO::Uncompress::Bunzip2> or L<IO::Uncompress::Gunzip> to uncompress the file if it has a .bz2 or .gz extension. =item $text = read_file($file) This will open the file at C<$path> and return all its contents. An exception will be thrown if the file cannot be opened. B<NOTE:> This will automatically use L<IO::Uncompress::Bunzip2> or L<IO::Uncompress::Gunzip> to uncompress the file if it has a .bz2 or .gz extension. =item $fh = maybe_open_file($path) =item $fh = maybe_open_file($path, $mode) If no mode is provided C<< '<' >> is assumed. This will open the file at C<$path> and return a filehandle. C<undef> is returned if the file cannot be opened. B<NOTE:> This will automatically use L<IO::Uncompress::Bunzip2> or L<IO::Uncompress::Gunzip> to uncompress the file if it has a .bz2 or .gz extension. =item $text = maybe_read_file($path) This will open the file at C<$path> and return all its contents. This will return C<undef> if the file cannot be opened. B<NOTE:> This will automatically use L<IO::Uncompress::Bunzip2> or L<IO::Uncompress::Gunzip> to uncompress the file if it has a .bz2 or .gz extension. =item @content = write_file($path, @content) Write content to the specified file. This will open the file with mode C<< '>' >>, write the content, then close the file. An exception will be thrown if any part fails. =item @content = write_file_atomic($path, @content) This will open a temporary file, write the content, close the file, then rename the file to the desired C<$path>. This is essentially an atomic write in that C<$file> will not exist until all content is written, preventing other processes from doing a partial read while C<@content> is being written. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������coverage2.t�����������������������������������������������������������������������������������������100644��001750��001750�� 26455�15267772575� 21664� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000029'; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $cfile) = tempfile(SUFFIX => '.jsonl'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', "--cover-write=$cfile", '-v'], exit => 0, ); my @coverage; open($fh, '<', $cfile); for my $line (<$fh>) { next unless $line; push @coverage => decode_json($line); } is( \@coverage, bag { item { 'test' => 't/integration/coverage/a.tx', 'manager' => 'Manager', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Ax.pm' => { '*' => ['*'], 'a' => bag { item {'subtest' => 'b'}; item {'subtest' => 'c'}; item {'subtest' => 'a'} }, 'aa' => [{'subtest' => 'a'}], }, 'Bx.pm' => { 'b' => bag { item {'subtest' => 'b'}; item {'subtest' => 'c'} }, '*' => ['*'], }, 'Cx.pm' => { 'c' => bag { item '*'; item {'subtest' => 'c'} }, '*' => ['*'], }, }, }; item { 'test' => 't/integration/coverage/b.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Bx.pm' => { 'b' => ['*'], '*' => ['*'], }, }, }; item { 'test' => 't/integration/coverage/c.tx', 'manager' => 'Manager', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => { 'Ax.pm' => { 'a' => bag { item {'subtest' => 'c'}; item {'subtest' => 'a'} }, '*' => [{'subtest' => 'a'}], }, 'Cx.pm' => { 'c' => [{'subtest' => 'c'}], '*' => [{'subtest' => 'c'}], } } }; item { 'test' => 't/integration/coverage/once.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => {}, }; item { 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'test' => 't/integration/coverage/open.tx', 'files' => {'Bx.pm' => {'<>' => ['*']}}, }; item { 'test' => 't/integration/coverage/x.tx', 'aggregator' => 'Test2::Harness::Log::CoverageAggregator::ByTest', 'files' => {'Bx.pm' => {'*' => ['*']}}, }; }, "Got predicted coverage data", ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$cfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������coverage3.t�����������������������������������������������������������������������������������������100644��001750��001750�� 21636�15267772575� 21661� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000029'; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl.bz2'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '-v', '-B', '-F' => $logfile, '--cover-files', '--cover-agg' => 'ByRun'], exit => 0, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; ��������������������������������������������������������������������������������������������������coverage4.t�����������������������������������������������������������������������������������������100644��001750��001750�� 21637�15267772575� 21663� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000029'; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; $dir =~ s/\d+$//; my ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl.bz2'); close($fh); yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '-v', '-B', '-F' => $logfile, '--cover-files', '--cover-agg' => 'ByTest'], exit => 0, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { 't/integration/coverage/a.tx' => {env => {COVER_TEST_SUBTESTS => 'a, b, c'}, stdin => "a\nb\nc\n", argv => ['a', 'b', 'c']}, 't/integration/coverage/c.tx' => {env => {COVER_TEST_SUBTESTS => 'a, c'}, stdin => "a\nc\n", argv => ['a', 'c']}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { # No manager, so run entire tests 't/integration/coverage/b.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/x.tx' => {argv => [], env => {}, stdin => ''}, 't/integration/coverage/open.tx' => {argv => [], env => {}, stdin => ''}, # Managed, so we have custom input 't/integration/coverage/a.tx' => {'argv' => ['b', 'c'], 'env' => {'COVER_TEST_SUBTESTS' => 'b, c'}, 'stdin' => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Bxb'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/b.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/open.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/x.tx" => {"argv" => [], "env" => {}, "stdin" => ""}, "t/integration/coverage/a.tx" => {"argv" => ["b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "b, c"}, "stdin" => "b\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Cxc'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, "t/integration/coverage/c.tx" => {"argv" => ["c"], "env" => {"COVER_TEST_SUBTESTS" => "c"}, "stdin" => "c\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Ax*'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a"], "env" => {"COVER_TEST_SUBTESTS" => "a"}, "stdin" => "a\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'Axaaa'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); yath( command => 'test', args => ["-D$dir/lib", "-I$dir/lib", '--ext=tx', "--cover-from=$logfile", '--plugin' => '+Plugin', '--changed-only', '-v'], exit => 0, env => {TEST_CASE => 'AxCx'}, test => sub { my $out = shift; my $input = +{$out->{output} =~ m/INPUT (\S+): (\{.+\})$/gm}; $_ = decode_json($_) for values %$input; is( $input, { "t/integration/coverage/a.tx" => {"argv" => ["a", "b", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, b, c"}, "stdin" => "a\nb\nc\n"}, "t/integration/coverage/c.tx" => {"argv" => ["a", "c"], "env" => {"COVER_TEST_SUBTESTS" => "a, c"}, "stdin" => "a\nc\n"}, }, "Test got the correct input about what subtests to run", ); }, ); done_testing; �������������������������������������������������������������������������������������������������plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20724� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 120�15267772575� 21632� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'short'); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 121�15267772575� 21634� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 121�15267772575� 21635� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 123�15267772575� 21640� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1); is($ENV{T2_HARNESS_JOB_DURATION}, 'medium'); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-w����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20651� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 110�15267772575� 21556� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-w����������������������������������������������������������������������������������������������������������������������������#!perl -w use Test2::V0; ok($^W,'-w should be honoured'); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 103�15267772575� 21561� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-w����������������������������������������������������������������������������������������������������������������������������#!perl use Test2::V0; ok(!$^W,'-w should not leak'); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Options.t�������������������������������������������������������������������������������������������100644��001750��001750�� 61414�15267772575� 21515� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Options'; require App::Yath::Command; subtest sugar => sub { package Test::Options::One; use App::Yath::Options; use Test2::V0 -target => 'App::Yath::Options'; imported_ok(qw/post option options option_group include_options/); like( dies { $CLASS->import() }, qr/Test::Options::One already has an 'options' method/, "Cannot double-import" ); isa_ok(options(), [$CLASS], "options() returns an instance"); my $line; option_group {prefix => 'foo'}, sub { option_group {category => 'uhg'}, sub { $line = __LINE__; option 'xxx' => (description => 'xxx'); option 'a_foo' => (description => 'a foo'); }; option 'outer' => (description => 'outer'); }; is( options()->all, [ { type => 'b', description => 'xxx', field => 'xxx', name => 'xxx', prefix => 'foo', title => 'xxx', category => 'uhg', trace => [__PACKAGE__, __FILE__, $line + 1], }, { type => 'b', description => 'a foo', field => 'a_foo', name => 'a-foo', prefix => 'foo', title => 'a_foo', category => 'uhg', trace => [__PACKAGE__, __FILE__, $line + 2], }, { type => 'b', description => 'outer', field => 'outer', name => 'outer', prefix => 'foo', title => 'outer', category => 'NO CATEGORY - FIX ME', trace => [__PACKAGE__, __FILE__, $line + 4], }, ], "Added options, correct traces, prefix from group, nestable", ); like( dies { option_group { builds => 'A::Fake::Module::Name' }, sub { 1 } }, qr/Can't locate A.+Fake.+Module.+Name\.pm/, "'builds' must be a valid module" ); post foo => sub { 1 }; post bar => sub { 'app-a' }, sub { 2 }; option_group {applicable => sub { 'app-b' } }, sub { post baz => sub { 3 } }; my $posts = options->post_list; like( $posts, [ ['foo'], ['bar'], ['baz'], ], "All 3 posts were listed" ); is($posts->[0]->[1], undef, "No applicability check for foo"); is($posts->[0]->[2]->(), 1, "Correct callback for foo"); is($posts->[1]->[1]->(), 'app-a', "correct applicability check for bar"); is($posts->[1]->[2]->(), 2, "Correct callback fo bar"); is($posts->[2]->[1]->(), 'app-b', "correct applicability check for baz (from group)"); is($posts->[2]->[2]->(), 3, "Correct callback fo baz"); like( dies { post foo => 1 }, qr/You must provide a callback coderef/, "Code is required" ); package Test::Options::Two; use App::Yath::Options; use Test2::V0 -target => 'App::Yath::Options'; include_options 'Test::Options::One'; is(options()->all(), Test::Options::One->options()->all(), "Included options"); }; subtest init => sub { my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); can_ok( $one, [qw{ all lookup pre_list cmd_list post_list post_list_sorted settings args command_class pending_pre pending_cmd pending_post included set_by_cli }], "Attributes" ); like( $one, { all => [], lookup => {}, pre_list => [], cmd_list => [], post_list => [], included => {}, set_by_cli => {}, }, "Set defaults", ); isa_ok($one->settings, ['Test2::Harness::Settings'], "Generated a settings object by default"); }; subtest option => sub { my $one = $CLASS->new(); my $trace = [__PACKAGE__, __FILE__, __LINE__ + 1]; my $opt = $one->option('foo', prefix => 'pre'); isa_ok($opt, ['App::Yath::Option'], "Got an option instance"); is($opt->trace, $trace, "Injected the correct trace"); is($opt->title, 'foo', "Correct title"); is($opt->prefix, 'pre', "Correct prefix"); is($one->all, [exact_ref($opt)], "Added the option"); is($one->cmd_list, [exact_ref($opt)], "Added the option for commands"); is($one->lookup, {foo => exact_ref($opt)}, "Added option to the lookup"); }; subtest _option => sub { my $one = $CLASS->new(); my $trace = [__PACKAGE__, __FILE__, __LINE__ + 1]; my $opt = $one->_option($trace, 'foo', prefix => 'pre'); isa_ok($opt, ['App::Yath::Option'], "Got an option instance"); is($opt->trace, $trace, "Used the correct trace"); is($opt->title, 'foo', "Correct title"); is($opt->prefix, 'pre', "Correct prefix"); is($one->all, [exact_ref($opt)], "Added the option"); is($one->cmd_list, [exact_ref($opt)], "Added the option for commands"); is($one->lookup, {foo => exact_ref($opt)}, "Added option to the lookup"); }; subtest _parse_option_args => sub { my $one = $CLASS->new(); is( {$one->_parse_option_args('foo')}, {title => 'foo', type => undef}, "Parse just title" ); is( {$one->_parse_option_args('foo=b')}, {title => 'foo', type => 'b'}, "Parse title=type" ); is( {$one->_parse_option_args('foo', 'b')}, {title => 'foo', type => 'b'}, "Parse title, type" ); is( {$one->_parse_option_args('foo', type => 'b', other => 'yes')}, {title => 'foo', type => 'b', other => 'yes'}, "Parse title, %opts" ); }; subtest _parse_option_caller => sub { no warnings 'once'; local *My::Caller::A::option_prefix = sub { 'MyPrefix' }; my $one = $CLASS->new(); is( {$one->_parse_option_caller('My::Caller::A', {})}, {prefix => 'myprefix'}, "Found prefix from package, and lowercased it" ); is( {$one->_parse_option_caller('FAKE', {prefix => 'MyPrefix'})}, {prefix => 'myprefix'}, "Found prefix from proto, and lowercased it" ); like( dies { $one->_parse_option_caller('FAKE', {title => 'foo'}) }, qr/Could not find an option prefix and option is not top-level \(foo\)/, "Need a prefix" ); local @App::Yath::Command::fake::ISA = ('App::Yath::Command'); local *App::Yath::Command::fake::name = sub { 'fake' }; is( {$one->_parse_option_caller('App::Yath::Command::fake')}, {from_command => 'fake'}, "Found command, prefix not required" ); is( {$one->_parse_option_caller('App::Yath::Command::fake::Options::Foo')}, {from_command => 'fake'}, "Found command (options class for command), prefix not required" ); is( {$one->_parse_option_caller('App::Yath')}, {}, "Special case, prefix not required for App::Yath namespace" ); is( {$one->_parse_option_caller('App::Yath::Plugin::Foo')}, {from_plugin => 'App::Yath::Plugin::Foo', prefix => 'foo'}, "Automatic prefix for plugin" ); is( {$one->_parse_option_caller('App::Yath::Plugin::Foo', {prefix => 'bar'})}, {from_plugin => 'App::Yath::Plugin::Foo', prefix => 'bar'}, "Can override automatic plugin prefix" ); }; subtest include_option => sub { my $one = $CLASS->new(); like( dies { $one->include_option(bless({title => 'foo', prefix => 'pre'}, 'App::Yath::Option')) }, qr/Options must have a trace/, "Need a trace" ); my $opt = App::Yath::Option->new(title => 'foo', prefix => 'foo'); is($one->include_option($opt), exact_ref($opt), "Added, and returned the reference"); like( $one, { lookup => {foo => exact_ref($opt)}, all => [exact_ref($opt)], cmd_list => [exact_ref($opt)], }, "Added the option and indexed it" ); }; subtest _index_option => sub { my $one = $CLASS->new(); my $opt1 = App::Yath::Option->new(title => 'foo', short => 'f', alt => ['fooo', 'fo'], prefix => 'foo'); my $opt2 = App::Yath::Option->new(title => 'boo', short => 'b', alt => ['booo', 'bo'], prefix => 'foo'); is($one->_index_option($opt1), 4, "indexed into 4 slots"); is($one->_index_option($opt1), 0, "Double indexing the same opt does not explode, 0 slots"); is( $one->lookup, { f => exact_ref($opt1), fo => exact_ref($opt1), foo => exact_ref($opt1), fooo => exact_ref($opt1), }, "Index has all 4 items", ); is($one->_index_option($opt2), 4, "indexed into 4 slots"); is($one->_index_option($opt2), 0, "Double indexing the same opt does not explode, 0 slots"); is( $one->lookup, { f => exact_ref($opt1), fo => exact_ref($opt1), foo => exact_ref($opt1), fooo => exact_ref($opt1), b => exact_ref($opt2), bo => exact_ref($opt2), boo => exact_ref($opt2), booo => exact_ref($opt2), }, "Index has all items", ); my $string = $opt1->trace_string; like( dies { $one->_index_option(App::Yath::Option->new(title => 'foo', prefix => 'foo')) }, qr/Option 'foo' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same long flag" ); like( dies { $one->_index_option(App::Yath::Option->new(title => 'xoo', alt => ['fo'], prefix => 'foo')) }, qr/Option 'fo' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same long flag (alt)" ); like( dies { $one->_index_option(App::Yath::Option->new(title => 'zoo', short => 'f', prefix => 'foo')) }, qr/Option 'f' was already defined \(\Q$string\E\)/, "Cannot add 2 opts with the same short flag" ); }; subtest _list_option => sub { my $one = $CLASS->new(); my $opt1 = App::Yath::Option->new(title => 'foo', prefix => 'xxx'); my $opt2 = App::Yath::Option->new(title => 'bar', prefix => 'xxx', pre_command => 1); ok($one->_list_option($opt1), "listed option 1"); ok($one->_list_option($opt2), "listed option 2"); like( $one, { cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], }, "Added both options to the correct lists" ); }; subtest include => sub { my $one = $CLASS->new(post_list_sorted => 1); like( dies { $one->include() }, qr/Include must be an instance of $CLASS, got undef/, "Must specify what to include" ); like( dies { $one->include('foo') }, qr/Include must be an instance of $CLASS, got 'foo'/, "String is not a valid include" ); like( dies { $one->include($CLASS) }, qr/Include must be an instance of $CLASS, got '$CLASS'/, "Package is not a valid include" ); my $ref = []; like( dies { $one->include($ref) }, qr/Include must be an instance of $CLASS, got '\Q$ref\E'/, "A reference is not a valid include" ); bless $ref, 'XXX'; like( dies { $one->include($ref) }, qr/Include must be an instance of $CLASS, got '\Q$ref\E'/, "Must be an instance of $CLASS" ); my $two = $CLASS->new(); my $opt1 = $two->option('foo', prefix => 'bar'); my $opt2 = $two->option('baz', prefix => 'bar', pre_command => 1); my $post = sub { 1 }; $two->_post(1, undef, $post); $one->include($two); like( $one, { post_list_sorted => F(), post_list => [[1, undef, exact_ref($post)]], cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], all => [exact_ref($opt1), exact_ref($opt2)], lookup => {baz => exact_ref($opt2), foo => exact_ref($opt1)}, }, "Included options and post-callbacks from the second instance" ); }; subtest include_from => sub { my $one = $CLASS->new(post_list_sorted => 1); my $two = $CLASS->new(); my $opt1 = $two->option('foo', prefix => 'bar'); my $opt2 = $two->option('baz', prefix => 'bar', pre_command => 1); my $post = sub { 1 }; $two->_post(1, undef, $post); $two->included->{'fake'} = 2; no warnings 'once'; *Some::Fake::Package::options = sub { $two }; $one->include_from('Some::Fake::Package'); like( $one, { post_list_sorted => F(), post_list => [[1, undef, exact_ref($post)]], cmd_list => [exact_ref($opt1)], pre_list => [exact_ref($opt2)], all => [exact_ref($opt1), exact_ref($opt2)], lookup => {baz => exact_ref($opt2), foo => exact_ref($opt1)}, included => {'fake' => T(), 'Some::Fake::Package' => T()}, }, "Included options and post-callbacks from the specified package" ); like( dies { $one->include_from('Some::Other::Package') }, qr/Can't locate Some.+Other.+Package\.pm in \@INC/, "Must be a valid package" ); }; subtest populate_pre_defaults => sub { my $one = $CLASS->new(); $one->option('noo', prefix => 'x', type => 's'); $one->option('foo', prefix => 'x', pre_command => 1, type => 's'); $one->option('bar', prefix => 'x', pre_command => 1, type => 'h'); $one->option('baz', prefix => 'x', pre_command => 1, type => 's', default => 42); $one->option('bat', prefix => 'x', pre_command => 1, type => 'm', default => sub { [42] }); $one->option('ban', prefix => 'x', pre_command => 1, type => 'h', default => sub { {answer => 42} }); $one->option('bag', prefix => 'x', pre_command => 1, type => 's', default => sub { }); $one->populate_pre_defaults(); is( ${$one->settings->x}, { baz => 42, bar => {}, bat => [42], ban => {answer => 42}, # The field itself is vivified, but no value set, thus it is undef # This prevents $settings->x->foo from exploding foo => undef, # Default returned an empty list, just vivify, maybe they know what # they are doing? bag => undef, # Be explicit, this should NOT be populated, not even as undef noo => DNE(), }, "Populated fields as expected", ); }; subtest populate_cmd_defaults => sub { my $one = $CLASS->new(); $one->option('noo', prefix => 'x', pre_command => 1, type => 's'); $one->option('foo', prefix => 'x', type => 's'); $one->option('bar', prefix => 'x', type => 'h'); $one->option('baz', prefix => 'x', type => 's', default => 42); $one->option('bat', prefix => 'x', type => 'm', default => sub { [42] }); $one->option('ban', prefix => 'x', type => 'h', default => sub { {answer => 42} }); $one->option('bag', prefix => 'x', type => 's', default => sub { }); like( dies { $one->populate_cmd_defaults() }, qr/The 'command_class' attribute has not yet been set/, "Need to set command class first" ); push @App::Yath::Command::fake::ISA => 'App::Yath::Command'; $one->set_command_class('App::Yath::Command::fake'); $one->populate_cmd_defaults(); is( ${$one->settings->x}, { baz => 42, bar => {}, bat => [42], ban => {answer => 42}, # The field itself is vivified, but no value set, thus it is undef # This prevents $settings->x->foo from exploding foo => undef, # Default returned an empty list, just vivify, maybe they know what # they are doing? bag => undef, # We also process any remaining pre-command ops noo => undef, }, "Populated fields as expected", ); }; subtest set_args => sub { my $one = $CLASS->new(); ok(!$one->args, "No args yet"); $one->set_args(['foo', 'bar']); is($one->args, ['foo', 'bar'], "Set the args"); like( dies { $one->set_args(['a']) }, qr/'args' has already been set/, "Cannot set args a second time", ); is($one->args, ['foo', 'bar'], "Args did not change"); }; subtest _grab_opts => sub { my $one = $CLASS->new(); like( dies { $one->_grab_opts() }, qr/The opt_fetch callback is required/, "Need opts" ); like( dies { $one->_grab_opts(sub {[]}) }, qr/The arg type is required/, "Need arg type" ); like( dies { $one->_grab_opts(sub {[]}, 'blah') }, qr/The 'args' attribute has not yet been set/, "Need args" ); $one = $CLASS->new; my $opt1 = $one->option('foo', prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', prefix => 'x', type => 's'); my $opt4 = $one->option('bat', prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', prefix => 'x', type => 'd'); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '--', '--bat', 'NO']; my @out = $one->_grab_opts('all', 'foo'); is($one->args, ['xxx', 'blah', '--', '--bat', 'NO'], "Pulled out known args, stopped at --"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take" ); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '::', '--bat', 'NO']; @out = $one->_grab_opts('all', 'foo'); is($one->args, ['xxx', 'blah', '::', '--bat', 'NO'], "Pulled out known args, stopped at ::"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take" ); $one->{args} = ['-f', '--ba', 'xxx', '--baz=uhg']; like( dies { $one->_grab_opts('all', 'foo', die_at_non_opt => 1) }, qr/Invalid foo option: xxx/, "Died at non-opt", ); $one->{args} = ['-f', '--ba', 'xxx', '--xyz', '--baz=uhg']; like( dies { $one->_grab_opts('all', 'foo') }, qr/Invalid foo option: --xyz/, "Died at invalid opt", ); $one->{args} = ['-f', '--ba', 'xxx', '--xyz', '--baz=uhg']; @out = $one->_grab_opts('all', 'foo', passthrough => 1); is($one->args, ['xxx', '--xyz'], "Pulled out known args"); is( \@out, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], ], "Got actions to take" ); }; subtest '*_command_opts' => sub { my $set_def = 0; my $control = mock $CLASS => ( override => [ populate_cmd_defaults => sub { $set_def++ }, ], ); my $one = $CLASS->new(); $one->set_command_class('App::Yath::Command'); my $opt1 = $one->option('foo', prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', prefix => 'x', type => 's'); my $opt4 = $one->option('bat', prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', prefix => 'x', type => 'D'); my $opt6 = $one->option('bag', prefix => 'x', type => 's', pre_command => 1); $one->{args} = ['-f', '--ba', 'xxx', '--bag=yes', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', 'blah', '--', '--bat', 'NO']; $one->grab_command_opts($one->all, 'foo'); is($one->args, ['xxx', 'blah', '--', '--bat', 'NO'], "Pulled out known args, stopped at --"); is( $one->pending_cmd, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt6), 'handle', 'yes'], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take, including pre-command options that were not processed yet" ); $one->process_command_opts; is($one->pending_cmd, undef, "Nothing left to do"); is( ${$one->settings->x}, { foo => FDNE(), bar => T(), baz => 'uhg', bat => ['a', 'b'], ban => ['y', 1], bag => 'yes', }, "Set the proper settings" ); }; subtest '*_pre_command_opts' => sub { my $set_def = 0; my $control = mock $CLASS => ( override => [ populate_pre_defaults => sub { $set_def++ }, ], ); my $one = $CLASS->new(); my $opt1 = $one->option('foo', pre_command => 1, prefix => 'x', type => 'b', short => 'f'); my $opt2 = $one->option('bar', pre_command => 1, prefix => 'x', type => 'b', alt => ['ba']); my $opt3 = $one->option('baz', pre_command => 1, prefix => 'x', type => 's'); my $opt4 = $one->option('bat', pre_command => 1, prefix => 'x', type => 'm'); my $opt5 = $one->option('ban', pre_command => 1, prefix => 'x', type => 'D'); my $opt6 = $one->option('bag', pre_command => 0, prefix => 'x', type => 'd'); $one->{args} = ['-f', '--ba', '--baz=uhg', '--bat', 'a', '--no-foo', '--bat', 'b', '--ban=y', '--ban', '--bag=yes', 'xxx', 'blah', '--bat', 'NO']; $one->grab_pre_command_opts($one->all, 'foo'); is($one->args, ['--bag=yes', 'xxx', 'blah', '--bat', 'NO'], "Pulled out known args, stopped at non-opt"); is( $one->pending_pre, [ [exact_ref($opt1), 'handle', 1], [exact_ref($opt2), 'handle', 1], [exact_ref($opt3), 'handle', 'uhg'], [exact_ref($opt4), 'handle', 'a'], [exact_ref($opt1), 'handle_negation'], [exact_ref($opt4), 'handle', 'b'], [exact_ref($opt5), 'handle', 'y'], [exact_ref($opt5), 'handle', 1], ], "Got actions to take, did not grab command options" ); $one->process_pre_command_opts; is($one->pending_pre, undef, "Nothing left to do"); is( ${$one->settings->x}, { foo => FDNE(), bar => T(), baz => 'uhg', bat => ['a', 'b'], ban => ['y', 1], bag => DNE(), }, "Set the proper settings" ); }; subtest set_command_class => sub { my $one = $CLASS->new(); ok(!$one->command_class, "No command class yet"); require App::Yath::Command::test; my $cmd = bless {}, 'App::Yath::Command::test'; $one->set_command_class($cmd); is($one->command_class, 'App::Yath::Command::test', "Can set via a blessed command instance"); like( dies { $one->set_command_class() }, qr/Command class has already been set/, "Cannot change command class once set." ); ok($one->included->{'App::Yath::Command::test'}, "Included options from the command"); $one = $CLASS->new(); $one->set_command_class('App::Yath::Command::test'); is($one->command_class, 'App::Yath::Command::test', "Can set via a class name"); $one = $CLASS->new(); like( dies { $one->set_command_class('Test2::Harness::Util') }, qr/Invalid command class: Test2::Harness::Util/, "Must be a valid command class" ); }; subtest post => sub { my $one = $CLASS->new(post_list_sorted => 1); my $sub = sub { 'foo' }; $one->_post(undef, undef, $sub); ok(!$one->post_list_sorted, "List is no longer considered sorted when we add an item"); is($one->post_list, [[0, undef, exact_ref($sub)]], "Added item to post list"); like( dies { $one->process_option_post_actions }, qr/The 'args' attribute has not yet been set/, "Need args first" ); $one = $CLASS->new(); $one->set_args(['foo']); }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Converting.pm���������������������������������������������������������������������������������������100644��001750��001750�� 4675�15267772575� 21663� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������package App::Yath::Converting; use strict; use warnings; our $VERSION = '1.000182'; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Converting - Things you may need to change in your tests before you can use yath. =head1 NON-TAP FORMATTER By default yath tells any L<Test2> or L<Test::Builder> tests to use L<Test2::Formatter::Stream> instead of L<Test2::Formatter::TAP>. This is done in order to make sure as much data as possible makes it to yath, TAP is a lossy formatter by comparison. This is not normally a problem, but tests that do strange things with STDERR/STDOUT, or try to intercept output from the regular TAP formatter can have issues with this. =head2 SOLUTIONS =head3 HARNESS-NO-STREAM You can add a harness directive to the top of offending tests that tell the harness those specific tests should still use the TAP formatter. #!/usr/bin/perl # HARNESS-NO-STREAM ... This directive can come after the C<#!> line, and after use statements, but must come BEFORE any empty lines or runtime statements. =head3 --no-stream You can run yath with the C<--no-stream> option, which will have tests default to TAP. This is not recommended as TAP is lossy. =head1 TESTS ARE RUN VIA FORK BY DEFAULT The default mode for yath is to preload a few things, then fork to spawn each test. This is a complicated procedure, and it uses L<goto::file> under the hood. Sometimes you have tests that simply will not work this way, or tests that verify specific libraries are not already loaded. =head2 SOLUTIONS =head3 HARNESS-NO-PRELOAD You can use this harness directive inside your tests to tell yath not to fork, but to instead launch a new perl process to run the test. #!/usr/bin/perl # HARNESS-NO-PRELOAD ... =head3 --no-fork =head3 --no-preload Both these options tell yath not to preload+fork, but to run ALL tests in new processes. This is slow, it is better to mark specific tests that have issues in preload mode. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������Command���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20411� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������do.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 22772�15267772575� 21543� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::do; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::File::JSON; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { '' } sub summary { "Run tests using 'run' or 'test', same as the default command, but explicit." } sub cli_args { "[run or test args]" } sub description { return <<" EOT"; This is the same as running yath without a command, except that it will not fail on CLI parsing issues that often get mistaken for commands. If there is a persistent runner then the 'run' command is used, otherwise the 'test' command is used. EOT } sub run { # This file is actually just a stub for the magic of 'do'. Code is not executed. die "This should not be reachable"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::do - Run tests using 'run' or 'test', same as the default command, but explicit. =head1 DESCRIPTION This is the same as running yath without a command, except that it will not fail on CLI parsing issues that often get mistaken for commands. If there is a persistent runner then the 'run' command is used, otherwise the 'test' command is used. =head1 USAGE $ yath [YATH OPTIONS] do [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������ps.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 70314�15267772575� 21556� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::ps; use strict; use warnings; our $VERSION = '1.000182'; use Term::Table(); use File::Spec(); use App::Yath::Util qw/find_pfile/; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command::status'; use Test2::Harness::Util::HashBase qw/queue/; sub group { 'persist' } sub summary { "Process list for the runner" } sub cli_args { "" } sub description { return <<" EOT"; List all running processes and runner stages. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; my @jobs; my $stage_status = $state->stage_readiness // {}; for my $stage (keys %$stage_status) { my $pid = $stage_status->{$stage} // next; $pid = 'N/A' if $pid == 1; push @jobs => [$pid, "Runner Stage", $stage]; } my $running = $state->running_tasks; for my $task (values %$running) { my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // 'N/A'; my $file = $task->{rel_file}; push @jobs => [$pid, "Running Test", $file]; } my $process_table = Term::Table->new( collapse => 1, header => [qw/pid type name/], rows => [sort { $a->[0] <=> $b->[0] } @jobs], ); print "\n**** Running Processes ****\n"; print "$_\n" for $process_table->render; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::ps - Process list for the runner =head1 DESCRIPTION List all running processes and runner stages. =head1 USAGE $ yath [YATH OPTIONS] ps [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20271� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������Git.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 11740�15267772575� 21535� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Plugin�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Git; use strict; use warnings; our $VERSION = '1.000182'; use IPC::Cmd qw/can_run/; use Test2::Harness::Util::IPC qw/run_cmd/; use parent 'App::Yath::Plugin'; use App::Yath::Options; option_group {prefix => 'git', category => "Git Options"} => sub { option change_base => ( type => 's', description => "Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base.", long_examples => [" master", " HEAD^", " df22abe4"], ); }; my $GIT_CMD = can_run('git'); sub git_cmd { $ENV{GIT_COMMAND} || $GIT_CMD } sub git_output { my $class = shift; my (@args) = @_; my $cmd = $class->git_cmd or return sub {()}; my ($rh, $wh, $irh, $iwh); pipe($rh, $wh) or die "No pipe: $!"; pipe($irh, $iwh) or die "No pipe: $!"; my $pid = run_cmd(stderr => $iwh, stdout => $wh, command => [$cmd, @args]); close($wh); close($iwh); $rh->blocking(1); $irh->blocking(0); my $waited = 0; return sub { my $line = <$rh>; return $line if defined $line; unless ($waited++) { local $?; waitpid($pid, 0); print STDERR <$irh> if $?; close($irh); # Try again $line = <$rh>; return $line if defined $line; } close($rh); return; }; } sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my $long_sha = $ENV{GIT_LONG_SHA}; my $short_sha = $ENV{GIT_SHORT_SHA}; my $status = $ENV{GIT_STATUS}; my $branch = $ENV{GIT_BRANCH}; my @sets = ( [\$long_sha, 'rev-parse', 'HEAD'], [\$short_sha, 'rev-parse', '--short', 'HEAD'], [\$status, 'status', '-s'], [\$branch, 'rev-parse', '--abbrev-ref', 'HEAD'], ); for my $set (@sets) { my ($var, @args) = @$set; next if $$var; # Already set my $output = $class->git_output(@args); my @lines; while (my $line = $output->()) { push @lines => $line; } chomp($$var = join "\n" => @lines); } return unless $long_sha; $meta->{git}->{sha} = $long_sha; $meta->{git}->{status} = $status if $status; if ($branch) { $meta->{git}->{branch} = $branch; my $short = length($branch) > 20 ? substr($branch, 0, 20) : $branch; push @$fields => {name => 'git', details => $short, raw => $branch, data => $meta->{git}}; } else { $short_sha ||= substr($long_sha, 0, 16); push @$fields => {name => 'git', details => $short_sha, raw => $long_sha, data => $meta->{git}}; } return; } sub changed_diff { my $class = shift; my ($settings) = @_; $class->_changed_diff($settings->git->change_base); } sub _changed_diff { my $class = shift; my ($base) = @_; my $cmd = $class->git_cmd or return; my $from = 'HEAD'; if ($base) { $from .= "^" while system($cmd => 'merge-base', '--is-ancestor', $from, $base); return $class->_diff_from($from); } my @files = $class->_diff_from($from); return @files if @files; return $class->_diff_from("${from}^"); } sub _diff_from { my $class = shift; my ($from) = @_; my $cmd = $class->git_cmd or return; return (line_sub => $class->git_output('diff', '-U1000000', '-W', '--minimal', $from)); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Git - Plugin to attach git data to a test run. =head1 DESCRIPTION This plugin will attach git data to your test logs if any is available. =head1 SYNOPSIS $ yath test -pGit ... =head1 READING THE DATA The data is attached to the 'run' entry in the log file. This can be seen directly in the json data. The data is also easily accessible with L<Test2::Harness::UI>. The data will include the long sha, short sha, branch name, and a brief status. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������Formatter�������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20352� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2���������������������������������������������������������������������������������������������������������������������������������������QVF.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 5277�15267772575� 21517� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Formatter�����������������������������������������������������������������������������������������������������������������������������package Test2::Formatter::QVF; use strict; use warnings; our $VERSION = '1.000182'; BEGIN { require Test2::Formatter::Test2; our @ISA = qw(Test2::Formatter::Test2) } use Test2::Util::HashBase qw{ -job_buffers -real_verbose }; sub init { my $self = shift; $self->SUPER::init(); $self->{+REAL_VERBOSE} = $self->{+VERBOSE}; $self->{+VERBOSE} ||= 100; } sub update_active_disp { my $self = shift; my ($f) = @_; return if $f && $f->{__RENDER__}->{update_active_disp}++; $self->SUPER::update_active_disp($f); } sub write { my ($self, $e, $num, $f) = @_; return $self->SUPER::write($e, $num, $f) if $self->{+REAL_VERBOSE}; $f ||= $e->facet_data; my $job_id = $f->{harness}->{job_id}; push @{$self->{+JOB_BUFFERS}->{$job_id}} => [$e, $num, $f] if $job_id; my $show = $self->update_active_disp($f); if ($f->{harness_job_end} || !$job_id) { $show = 1; my $buffer = delete $self->{+JOB_BUFFERS}->{$job_id}; if($f->{harness_job_end}->{fail}) { $self->SUPER::write(@{$_}) for @$buffer; } else { $f->{info} = [grep { $_->{tag} ne 'TIME' } @{$f->{info}}] if $f->{info}; $self->SUPER::write($e, $num, $f) } } $self->{+ECOUNT}++; return unless $self->{+TTY}; return unless $self->{+PROGRESS}; $show ||= 1 unless $self->{+ECOUNT} % 10; if ($show) { # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $io = $self->{+IO}; if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } print $io $self->render_status($f); $self->{+_BUFFERED} = 1; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::QVF - Test2 formatter that is [Q]uiet but [V]erbose on [F]ailure. =head1 DESCRIPTION This formatter is a subclass of L<Test2::Formatter::Test2>. This one will buffer all output from a test file and only show it to you if there is a failure. Most of the time it will only show you the completion notifications for each test. =head1 SYNOPSIS $ yath test --qvf ... =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Event.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 12301�15267772575� 21606� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Event; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/confess/; use Time::HiRes qw/time/; use Test2::Harness::Util::JSON qw/encode_json/; use Importer 'Test2::Util::Facets2Legacy' => ':ALL'; BEGIN { require Test2::Event; our @ISA = ('Test2::Event'); # Currently the base class for events does not have init(), that may change if (Test2::Event->can('init')) { *INIT_EVENT = sub() { 1 } } else { *INIT_EVENT = sub() { 0 } } } use Test2::Harness::Util::HashBase qw{ <facet_data <stream_id <event_id <run_id <job_id <job_try <stamp +json processed }; sub trace { $_[0]->{+FACET_DATA}->{trace} } sub set_trace { confess "'trace' is a read only attribute" } sub init { my $self = shift; $self->Test2::Event::init() if INIT_EVENT; my $data = $self->{+FACET_DATA} || confess "'facet_data' is a required attribute"; for my $field (RUN_ID(), JOB_ID(), JOB_TRY(), EVENT_ID()) { my $v1 = $self->{$field}; my $v2 = $data->{harness}->{$field}; my $d1 = defined($v1); my $d2 = defined($v2); confess "'$field' is a required attribute" unless $d1 || $d2 || ($field eq +JOB_TRY && !$self->{+JOB_ID}); confess "'$field' has different values between attribute and facet data" if $d1 && $d2 && $v1 ne $v2; $self->{$field} = $data->{harness}->{$field} = $v1 // $v2; } delete $data->{facet_data}; # Original trace wins. if (my $trace = delete $self->{+TRACE}) { $self->{+FACET_DATA}->{trace} //= $trace; } } sub as_json { $_[0]->{+JSON} //= encode_json($_[0]) } sub TO_JSON { my $out = {%{$_[0]}}; $out->{+FACET_DATA} = { %{$out->{+FACET_DATA}} }; delete $out->{+FACET_DATA}->{harness_job_watcher}; delete $out->{+FACET_DATA}->{harness}->{closed_by}; delete $out->{+JSON}; delete $out->{+PROCESSED}; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Event - Subclass of Test2::Event used by Test2::Harness under the hood. =head1 DESCRIPTION Test2 tests produce a sequence of events objects L<Test2::Event>. This is a subclass of those events for use in L<Test2::Harness>. Event non-test tests which produce TAP output will have the output parsed into these types of events. =head1 SYNOPSIS In normal usage you will never need to create one of these events yourself. This documentation assumes you are operating on an existing event C<$event> that the harness exposed to you via a plugin or similar. my $facet_data = $event->facet_data; my $run_id = $event->run_id; my $job_id = $event->job_id; my $job_try = $event->job_try; my $event_id = $event->event_id; =head1 METHODS See L<Test2::Event> for methods provided by the base class. =over 4 =item $hashref = $event->TO_JSON Used for json serialization. =item $json_string = $event->as_json This will return a json representation of the event. Note that this is a lossy conversion with some harness specific state removed by design. This may even be a cached copy of the json string that was decoded to produce the original object. If the string was not cached before it will be cached for all future calls ignoring any state change to the event. The lossy/cached conversion is intended so that events get passed through the harness pipeline without modifications from one step translating to another. If you need something extra to go through you need to either replace the event or create an additional one. =item $string = $event->event_id Usually a UUID, but not always! =item i$hashref = $event->facet_data Get the event facet data, this is the meat of the event that hold all the state. =item $string = $event->job_id Usually a UUID, but not always! =item $int = $event->job_try Integer, 0 or greater. Some jobs are run additional times if they fail, this says which attempt the event is for. The counter starts at 0. =item $bool = $event->processed This will be true if the event has been process by the harness. Note that this attribute is not serialized by C<TO_JSON> or C<as_json>. =item $string = $event->run_id The run id. This is usually a UUID, but not always! =item $ts = $event->stamp A unix timestamp for when the event was created. =item $id = $event->stream_id This is an implementation detail of L<Test2::Formatter::Stream>, do not rely on it. This is used to prevent parsing errors when stream output is nested in other stream output, which can happen if you are writing tests for the stream formatter itself. =item $trace = $event->trace This is a shortcut for C<< $event->facet_data->{trace} >>. The trace data is essential and used everywhere. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tapsubtest.t����������������������������������������������������������������������������������������100644��001750��001750�� 1152�15267772575� 22150� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; yath( command => 'test', args => [$dir, '--ext=tx', '-v'], exit => 0, test => sub { my $todo = todo "FIXME #216"; my $out = shift; chomp(my $want = <<' EOT'); [ PASS ] job 1 +~buffered [ PASS ] job 1 + buffered ok [ PLAN ] job 1 | Expected assertions: 1 job 1 ^ [ PLAN ] job 1 Expected assertions: 1 EOT like($out->{output}, qr{\Q$want\E}, "Got the desired output"); }, ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20405� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22031� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������run.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 101503�15267772575� 21753� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::run; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use Test2::Harness::Util qw/mod2file open_file/; use Test2::Util::Table qw/table/; use File::Spec; use Carp qw/croak/; use parent 'App::Yath::Command::test'; use Test2::Harness::Util::HashBase qw/+pfile_data +pfile/; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Display', 'App::Yath::Options::Finder', 'App::Yath::Options::Logging', 'App::Yath::Options::PreCommand', 'App::Yath::Options::Run', ); option_group {prefix => 'run'} => sub { option check_reload_state => ( type => 'b', description => 'Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings.', default => 1, ); }; sub group { 'persist' } sub summary { "Run tests using the persistent test runner" } sub cli_args { '[--] [test files/dirs] [::] [arguments to test scripts] [test_file.t] [test_file2.t="--arg1 --arg2 --param=\'foo bar\'"] [:: --argv-for-all-tests]' } sub description { return <<" EOT"; This command will run tests through an already started persistent instance. See the start command for details on how to launch a persistent instance. EOT } sub terminate_queue {} # The runner here is a persistent one this process did not start. It is not a # descendant, so /proc gives nothing useful, its dispatch queue is shared with # every other run that runner has served, and signalling it would reach a # process other sessions are using. sub stall_reporting { 0 } sub write_settings_to {} sub setup_plugins {} sub setup_resources {} sub teardown_plugins {} sub finalize_plugins {} sub pfile_params { () } sub monitor_preloads { 1 } sub job_count { 1 } sub collector_options { (persistent_runner => 1) } sub run { my $self = shift; my $settings = $self->settings; if ($settings->run->check_reload_state) { return 255 unless $self->check_reload_state; } return $self->SUPER::run(@_); } sub write_test_info { $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} //= 1; } sub check_reload_state { my $self = shift; my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; my $reload_status = $state->reload_state // {}; my (@out, $errors, $warnings, %seen); for my $stage (sort keys %$reload_status) { for my $file (keys %{$reload_status->{$stage}}) { next if $seen{$file}++; my $data = $reload_status->{$stage}->{$file} or next; push @out => "\n==== SOURCE FILE: $file ====\n"; if ($data->{error}) { $errors++; push @out => $data->{error}; } for (@{$data->{warnings} // []}) { push @out => $_; $warnings++; } } } $errors //= 0; $warnings //= 0; return 1 unless @out || $errors || $warnings; print <<" EOT", @out; ******************************************************************************* * Some source files were reloaded with errors or warnings * Errors: $errors * Warnings: $warnings ******************************************************************************* EOT if ($errors) { print <<" EOT"; ******************************************************************************* Aborting due to reload errors. Please fix the errors so that the modules reload cleanly, then try the run again. In most cases you will not need to reload the runner, simply fix the problem with the source file(s) and the runner will reload them automatically. EOT return 0; } elsif ($warnings) { print <<" EOT"; ******************************************************************************* Warnings were encountered when reloading source files, please see the output above. If these warnings are a problem you should abort this run (control+c) and correct them before trying again. In most cases you will not need to reload the runner, simply fix the problem with the source file(s) and the runner will reload them automatically. If these warnings are not indicitive of a problem you may continue by pressing enter/return. EOT if (-t STDIN) { my $ignore = <STDIN>; return 1; } else { print STDERR "No TTY detected, aborting run due to warnings...\n"; return 0; } } return 0; } sub init { my $self = shift; my $settings = $self->settings; my $pdata = $self->pfile_data; my $runner_settings = Test2::Harness::Util::File::JSON->new(name => $pdata->{dir} . '/settings.json')->read(); for my $prefix (sort keys %{$runner_settings}) { next if $settings->check_prefix($prefix); my $new = $settings->define_prefix($prefix); ${$new->vivify_field('from_runner')} = 1; for my $key (sort keys %{$runner_settings->{$prefix}}) { ${$new->vivify_field($key)} = $runner_settings->{$prefix}->{$key}; } } return $self->SUPER::init(@_); } sub pfile { my $self = shift; $self->{+PFILE} //= find_pfile($self->settings, $self->pfile_params) or die "No persistent harness was found for the current path.\n"; } sub pfile_data { my $self = shift; return $self->{+PFILE_DATA} if $self->{+PFILE_DATA}; my $pfile = $self->pfile; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); $data->{pfile_path} //= $pfile; print "\nFound: $data->{pfile_path}\n"; print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; return $self->{+PFILE_DATA} = $data; } sub workdir { my $self = shift; return $self->pfile_data->{dir}; } sub start_runner { my $self = shift; my $data = $self->pfile_data; $self->{+RUNNER_PID} = $data->{pid}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::run - Run tests using the persistent test runner =head1 DESCRIPTION This command will run tests through an already started persistent instance. See the start command for details on how to launch a persistent instance. =head1 USAGE $ yath [YATH OPTIONS] run [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Options���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20466� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath������������������������������������������������������������������������������������������������������������������������������������Run.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 23325�15267772575� 21755� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Run; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::UUID qw/gen_uuid/; use App::Yath::Options; option_group {prefix => 'run', category => "Run Options", builds => 'Test2::Harness::Run'} => sub { post \&post_process; option link => ( field => 'links', type => 'm', long_examples => [ " 'https://travis.work/builds/42'", " 'https://jenkins.work/job/42'", " 'https://buildbot.work/builders/foo/builds/42'", ], description => "Provide one or more links people can follow to see more about this run." ); option test_args => ( type => 'm', description => 'Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the \'::\' argument separator.' ); option input => ( type => 's', description => 'Input string to be used as standard input for ALL tests. See also: --input-file', ); option input_file => ( type => 's', description => 'Use the specified file as standard input to ALL tests', action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; die "Input file not found: $norm\n" unless -f $norm; if ($settings->run->input) { warn "Input file is overriding another source of input.\n"; $settings->run->field(input => undef); } $handler->($slot, $norm); }, ); option dbi_profiling => ( type => 'b', description => "Use Test2::Plugin::DBIProfile to collect database profiling data", ); option author_testing => ( short => 'A', description => 'This will set the AUTHOR_TESTING environment to true', ); option use_stream => ( name => 'stream', description => "Use the stream formatter (default is on)", default => 1, ); option tap => ( field => 'use_stream', alt => ['TAP', '--no-stream'], normalize => sub { $_[0] ? 0 : 1 }, description => "The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help." ); option fields => ( type => 'm', short => 'f', long_examples => [' name:details', ' JSON_STRING'], short_examples => [' name:details', ' JSON_STRING'], description => "Add custom data to the harness run", action => \&fields_action, ); option env_var => ( field => 'env_vars', short => 'E', type => 'h', long_examples => [' VAR=VAL'], short_examples => ['VAR=VAL', ' VAR=VAL'], description => 'Set environment variables to set when each test is run.', ); option run_id => ( alt => ['id'], description => 'Set a specific run-id. (Default: a UUID)', default => \&gen_uuid, ); option load => ( type => 'm', short => 'm', alt => ['load-module'], description => 'Load a module in each test (after fork). The "import" method is not called.', ); option load_import => ( type => 'H', short => 'M', alt => ['loadim'], long_examples => [' Module', ' Module=import_arg1,arg2,...'], short_examples => [' Module', ' Module=import_arg1,arg2,...'], description => 'Load a module in each test (after fork). Import is called.', ); option event_uuids => ( default => 1, alt => ['uuids'], description => 'Use Test2::Plugin::UUID inside tests (default: on)', ); option mem_usage => ( default => 1, description => 'Use Test2::Plugin::MemUsage inside tests (default: on)', ); option io_events => ( default => 0, description => 'Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off)', ); option retry => ( default => 0, short => 'r', type => 's', description => 'Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice!', ); option retry_isolated => ( default => 0, alt => ['retry-iso'], type => 'b', description => 'If true then any job retries will be done in isolation (as though -j1 was set)', ); }; sub post_process { my %params = @_; my $settings = $params{settings}; $settings->run->env_vars->{AUTHOR_TESTING} = 1 if $settings->run->author_testing; if ($settings->run->dbi_profiling) { eval { require Test2::Plugin::DBIProfile; 1 } or die "Could not enable DBI profiling, could not load 'Test2::Plugin::DBIProfile': $@"; push @{$settings->run->load_import->{'@'}} => 'Test2::Plugin::DBIProfile'; $settings->run->load_import->{'Test2::Plugin::DBIProfile'} = []; } } sub fields_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; my $fields = ${$slot} //= []; if ($norm =~ m/^{/) { my $field = {}; my $ok = eval { $field = Test2::Harness::Util::JSON::decode_json($norm); 1 }; chomp(my $error = $@ // ''); die "Error parsing field specification '$field': $error\n" unless $ok; die "Fields must have a 'name' key (error in '$raw')\n" unless $field->{name}; die "Fields must have a 'details' key (error in '$raw')\n" unless $field->{details}; return push @$fields => $field; } elsif ($norm =~ m/([^:]+):([^:]+)/) { return push @$fields => {name => $1, details => $2}; } die "'$raw' is not a valid field specification.\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Run - Run options for Yath. =head1 DESCRIPTION This is where command lines options for a single test run are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Finder.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 65324�15267772575� 21751� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Finder; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::JSON qw/decode_json encode_json/; use List::Util qw/first/; use Cwd qw/getcwd/; use Carp qw/croak/; use Time::HiRes qw/time/; use Text::ParseWords qw/quotewords/; use Test2::Harness::TestFile; use File::Spec; use Test2::Harness::Util::HashBase qw{ <default_search <default_at_search <durations <maybe_durations +duration_data <durations_threshold <exclude_files <exclude_patterns <exclude_lists <no_long <only_long <rerun <rerun_modes <rerun_plugin search <extensions <multi_project <changed <changed_only <changes_plugin <show_changed_files <changes_diff <changes_filter_file <changes_filter_pattern <changes_exclude_file <changes_exclude_pattern <changes_include_whitespace <changes_exclude_nonsub <changes_exclude_loads <changes_exclude_opens }; sub munge_settings {} sub init { my $self = shift; $self->{+EXCLUDE_FILES} = { map {( $_ => 1 )} @{$self->{+EXCLUDE_FILES}} } if ref($self->{+EXCLUDE_FILES}) eq 'ARRAY'; if (my $plugins = $self->{+RERUN_PLUGIN}) { for (@$plugins) { $_ = "App::Yath::Plugin::$_" unless s/^\+// or m/^(App::Yath|Test2::Harness)::Plugin::/; my $file = mod2file($_); require $file; } } } sub duration_data { my $self = shift; my ($plugins, $settings, $test_files) = @_; $self->{+DURATION_DATA} //= $self->pull_durations(); return $self->{+DURATION_DATA} if $self->{+DURATION_DATA}; for my $plugin (@$plugins) { next unless $plugin->can('duration_data'); $self->{+DURATION_DATA} = $plugin->duration_data($settings, $test_files) or next; last; } return $self->{+DURATION_DATA} //= {}; } sub pull_durations { my $self = shift; my $primary = delete $self->{+MAYBE_DURATIONS}; my $fallback = delete $self->{+DURATIONS}; my @args = ( name => 'durations', is_json => 1, http_args => [{headers => {'Content-Type' => 'application/json'}}], ); if ($primary) { local $@; my $durations = eval { $self->_pull_from_file_or_url(source => $primary, @args) } or print "Could not fetch optional durations '$primary', ignoring...\n"; if ($durations) { print "Found durations: $primary\n"; return $durations; } } return $self->_pull_from_file_or_url(source => $fallback, @args) if $fallback; return; } sub add_exclusions_from_lists { my $self = shift; my @lists = ref($self->{+EXCLUDE_LISTS}) eq 'ARRAY' ? @{$self->{+EXCLUDE_LISTS}} : ($self->{+EXCLUDE_LISTS}); for my $path (@lists) { my $content = $self->_pull_from_file_or_url( source => $path, name => 'exclusion lists', ); next unless $content; for (split(/\r?\n\r?/, $content)) { $self->{+EXCLUDE_FILES}->{$_} = 1 unless /^\s*#/; }; } } sub _pull_from_file_or_url { my $self = shift; my %params = @_; my $in = $params{source} // croak "No file or url provided"; my $name = $params{name} // croak "No name provided"; my $is_json = $params{is_json}; if (my $type = ref($in)) { return $in if $is_json && ($type eq 'HASH' || $type eq 'ARRAY'); } elsif (-f $in) { if ($is_json) { require Test2::Harness::Util::File::JSON; my $file = Test2::Harness::Util::File::JSON->new(name => $in); return $file->read(); } else { require Test2::Harness::Util::File; my $f = Test2::Harness::Util::File->new(name => $in); return $f->read(); } } elsif ($in =~ m{^https?://}) { my $meth = $params{http_method} // 'get'; my $args = $params{http_args}; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); my $res = $ht->$meth($in, $args ? (@$args) : ()); die "Could not query $name from '$in'\n$res->{status}: $res->{reason}\n$res->{content}\n" unless $res->{success}; return $is_json ? decode_json($res->{content}) : $res->{content}; } die "Invalid $name specification: $in"; } sub find_files { my $self = shift; my ($plugins, $settings) = @_; $self->add_exclusions_from_lists() if $self->{+EXCLUDE_LISTS}; my $add_changes = 0; $add_changes ||= $self->{+CHANGED} && @{$self->{+CHANGED}}; $add_changes ||= $self->{+CHANGED_ONLY}; $add_changes ||= $self->{+CHANGES_PLUGIN}; $add_changes ||= $self->{+CHANGES_DIFF}; $self->add_changed_to_search($plugins, $settings) if $add_changes; my $add_rerun = $self->{+RERUN}; $self->add_rerun_to_search($plugins, $settings, $add_rerun) if $add_rerun; return $self->find_multi_project_files($plugins, $settings) if $self->multi_project; return $self->find_project_files($plugins, $settings, $self->search); } sub check_plugins { my $self = shift; my ($plugins, $settings) = @_; my $check_plugins = $plugins; my $plugin; if (my $p = $self->{+CHANGES_PLUGIN}) { $plugin = $p =~ s/^\+// ? $p : "App::Yath::Plugin::$p"; $check_plugins = [$plugin]; } return $check_plugins // []; } sub get_diff { my $self = shift; my ($plugins, $settings) = @_; return (file => $self->{+CHANGES_DIFF}) if $self->{+CHANGES_DIFF}; my $check_plugins = $self->check_plugins($plugins, $settings); for my $plugin (@$check_plugins) { if ($plugin->can('changed_diff')) { my ($type, $data) = $plugin->changed_diff($settings); next unless $type && $data; return ($type => $data); } } return (); } sub find_changes { my $self = shift; my ($plugins, $settings) = @_; my @listed_changes; @listed_changes = @{$self->{+CHANGED}} if $self->{+CHANGED}; my ($type, $diff) = $self->get_diff($plugins, $settings); my (@found_changes); if ($type && $diff) { @found_changes = $self->changes_from_diff($type => $diff, $settings); } unless (@found_changes) { my $check_plugins = $self->check_plugins($plugins, $settings); for my $plugin (@$check_plugins) { next unless $plugin->can('changed_files'); push @found_changes => $plugin->changed_files($settings); last if @found_changes; } } my $filter_patterns = @{$self->{+CHANGES_FILTER_PATTERN}} ? $self->{+CHANGES_FILTER_PATTERN} : undef; my $filter_files = @{$self->{+CHANGES_FILTER_FILE}} ? {map { $_ => 1 } @{$self->{+CHANGES_FILTER_FILE}}} : undef; my $exclude_patterns = @{$self->{+CHANGES_EXCLUDE_PATTERN}} ? $self->{+CHANGES_EXCLUDE_PATTERN} : undef; my $exclude_files = @{$self->{+CHANGES_EXCLUDE_FILE}} ? {map { $_ => 1 } @{$self->{+CHANGES_EXCLUDE_FILE}}} : undef; my %changed_map; for my $change (@listed_changes, @found_changes) { next unless $change; my ($file, @parts) = ref($change) ? @$change : ($change); next if $filter_files && !$filter_files->{$file}; next if $exclude_files && $exclude_files->{$file}; next if $filter_patterns && !first { $file =~ m/$_/ } @$filter_patterns; next if $exclude_patterns && first { $file =~ m/$_/ } @$exclude_patterns; @parts = ('*') unless @parts; $changed_map{$file}{$_} = 1 for @parts; } return \%changed_map; } sub get_capable_plugins { my $self = shift; my ($method, $plugins) = @_; my %seen; return grep { $_ && !$seen{$_}++ && $_->can($method) } @$plugins; } sub add_rerun_to_search { my $self = shift; my ($plugins, $settings, $rerun) = @_; my $search = $self->search; unless ($search) { $search = []; $self->set_search($search); } my $modes = $self->{+RERUN_MODES}; my $mode_hash = { map {$_ => 1} @$modes }; my ($grabbed, $data); for my $p ($self->get_capable_plugins(grab_rerun => [@{$self->{+RERUN_PLUGIN} // []}, @$plugins])) { ($grabbed, $data) = $p->grab_rerun($rerun, modes => $modes, mode_hash => $mode_hash, settings => $settings); next unless $grabbed; unless ($data && keys %$data) { print "No files found to rerun.\n"; exit 0; } last if $grabbed; } unless ($grabbed) { if ($rerun eq '1') { $rerun = first { -e $_ } qw{ ./lastlog.jsonl ./lastlog.jsonl.bz2 ./lastlog.jsonl.gz }; die "Could not find a lastlog.jsonl(.bz2|.gz) file for re-running, you may need to provide a full path to --rerun=... or --rerun-failed=..." unless $rerun; } die "'$rerun' is not a valid log file, and no plugin intercepted it.\n" unless -f $rerun; my $stream = Test2::Harness::Util::File::JSONL->new(name => $rerun, skip_bad_decode => 1); my %files; while (1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $f = $event->{facet_data} or next; for my $type (qw/seen queued start end/) { my $field = $type eq 'seen' ? "harness_job" : "harness_job_$type"; my $data = $f->{$field} or next; my $file = $data->{rel_file} // $data->{run_file} // $data->{file} // $data->{abs_file}; next unless $file; my $ref = $files{$file} //= {}; $ref->{$type}++; $ref->{$data->{fail} ? 'fail' : 'pass'}++ if $type eq 'end'; $ref->{retry}++ if $data->{is_try}; } } } $data = \%files; } my @add = map { $data->{$_}->{add} // $_ } grep { my $entry = $data->{$_}; my $keep = $mode_hash->{all} ? 1 : 0; $keep ||= 1 if $mode_hash->{failed} && $entry->{fail} && !$entry->{pass}; $keep ||= 1 if $mode_hash->{retried} && $entry->{retry}; $keep ||= 1 if $mode_hash->{passed} && $entry->{pass}; $keep ||= 1 if $mode_hash->{missed} && !$entry->{end}; $keep } sort keys %$data; unless (@add) { print "No files found to rerun.\n"; exit 0; } push @$search => @add; } sub add_changed_to_search { my $self = shift; my ($plugins, $settings) = @_; my $search = $self->search; unless ($search) { $search = []; $self->set_search($search); } my $changed_map = $self->find_changes($plugins, $settings); my $found_changed = keys %$changed_map; die "Could not find any changed files.\n" if $self->{+CHANGED_ONLY} && !$found_changed; if ($self->{+CHANGED_ONLY}) { die "Can not add test or directory names when using --changed-only (saw: " . join(", " => @$search) . ")\n" if @$search; } if ($self->{+SHOW_CHANGED_FILES} && $found_changed) { print "Found the following changed files:\n"; for my $file (keys %$changed_map) { print " $file: ", join(", ", sort keys %{$changed_map->{$file}}), "\n"; } } my @add; for my $p ($self->get_capable_plugins(get_coverage_tests => $plugins)) { for my $set ($p->get_coverage_tests($settings, $changed_map)) { my $test = ref($set) ? $set->[0] : $set; unless (-e $test) { print STDERR "Coverage wants to run test '$test', but it does not exist, skipping...\n"; next; } push @add => $set; } } for my $p ($self->get_capable_plugins(post_process_coverage_tests => $plugins)) { $p->post_process_coverage_tests($settings, \@add); } if ($self->{+SHOW_CHANGED_FILES} && @add) { print "Found " . scalar(@add) . " test files to run based on changed files.\n"; print ref($_) ? " $_->[0]" : " $_\n" for @add; print "\n"; } push @$search => @add; return; } sub changes_from_diff { my $self = shift; my ($type, $data, $settings) = @_; my $next; if ($type eq 'lines') { $next = sub { shift @$data }; } elsif ($type eq 'diff') { my $lines = [split /\n/, $data]; $next = sub { shift @$lines }; } elsif ($type eq 'file') { die "'$data' is not a valid diff file.\n" unless -f $data; open(my $fh, '<', $data) or die "Could not open diff file '$data': $!"; $next = sub { my $line = <$fh>; close($fh) unless defined $line; return $line; }; } elsif ($type eq 'line_sub') { $next = $data; } elsif ($type eq 'handle') { $next = sub { scalar <$data> }; } else { die "Invalid diff type '$type'"; } my %changed; # Only perl can parse perl, and nothing can parse perl diff. What this does # is take a diff of every file with 100% context so we see the entire file # with the +, minus, or space prefix. As we scan it we look for subs. We # track what files and subs we are in. When we see a change we # {$file}{$sub}++. # # This of course is broken if you make a change between # subs as it will attribute it to the previous sub, however tracking # indentation is equally flawed as things like heredocs and other special # perl things can also trigger that to prematurely think we are out of a # sub. # # PPI and similar do a better job parsing perl, but using them and also # tracking changes from the diff, or even asking them to parse a diff where # some lines are added and others removed is also a huge hassle. # # The current algorith is "good enough", not perfect. my ($file, $sub, $indent, $is_perl); while (my $line = $next->()) { chomp($line); if ($line =~ m{^(?:---|\+\+\+) ([ab]/)?(.*)$}) { my $maybe_prefix = $1; my $maybe_file = $2; next if $maybe_file =~ m{/dev/null}; if ($maybe_prefix) { $file = -f "$maybe_prefix$maybe_file" ? "$maybe_prefix$maybe_file" : $maybe_file; } else { $file = $maybe_file; } $is_perl = 1 if $file =~ m/\.(pl|pm|t2?)$/; $sub = '*'; # Wildcard, changes to the code outside of a sub potentially effects all subs next; } next unless $file; $line =~ m/^( |-|\+)(.*)$/ or next; my ($prefix, $statement) = ($1, $2); my $changed = $prefix eq ' ' ? 0 : 1; $is_perl = 1 if $statement =~ m/^#!.*perl/; if ($statement =~ m/^(\s*)sub\s+(\w+)/) { $indent = $1 // ''; $sub = $2; # 1-line sub: sub foo { ... } if ($statement =~ m/}/) { $changed{$file}{$sub}++ if $changed; $sub = '*'; $indent = undef; next; } } elsif(defined($indent) && $statement =~ m/^$indent\}/) { $indent = undef; $sub = "*"; # If this is nothing but whitespace and a closing paren we can skip it. next if $statement =~ m/^\s*\}?\s*$/ && !$self->{+CHANGES_INCLUDE_WHITESPACE}; } next unless $sub; # If sub is empty then we are not even in a file yet next unless $changed; # If we are not on a changed line no need to add it unless ($self->{+CHANGES_INCLUDE_WHITESPACE}) { next if !length($statement); # If there is no statement length then this is whitespace only next if $statement =~ m/^\s+$/; # Do not care about whitespace only changes } next if $is_perl && $self->{+CHANGES_EXCLUDE_NONSUB} && $sub eq '*'; $changed{$file}{$sub}++; } return map {([$_ => sort keys %{$changed{$_}}])} sort keys %changed; } sub find_multi_project_files { my $self = shift; my ($plugins, $settings) = @_; my $search = $self->search // []; die "multi-project search must be a single directory, or the current directory" if @$search > 1; my ($pdir) = @$search; my $dir = clean_path(getcwd()); my $out = []; my $ok = eval { chdir($pdir) if defined $pdir; my $ret = clean_path(getcwd()); opendir(my $dh, '.') or die "Could not open project dir: $!"; for my $subdir (readdir($dh)) { chdir($ret); next if $subdir =~ m/^\./; my $path = clean_path(File::Spec->catdir($ret, $subdir)); next unless -d $path; chdir($path) or die "Could not chdir to $path: $!\n"; for my $item (@{$self->find_project_files($plugins, $settings, [])}) { push @{$item->queue_args} => ('ch_dir' => $path); push @$out => $item; } } chdir($ret); 1; }; my $err = $@; chdir($dir); die $err unless $ok; return $out; } sub find_project_files { my $self = shift; my ($plugins, $settings, $input) = @_; $input //= []; $plugins //= []; my $default_search = [@{$self->default_search}]; push @$default_search => @{$self->default_at_search} if $settings->check_prefix('run') && $settings->run->author_testing; $_->munge_search($input, $default_search, $settings) for @$plugins; my $search = @$input ? $input : $self->{+CHANGED_ONLY} ? [] : $default_search; die "No tests to run, search is empty\n" unless @$search; my (%seen, @tests, @dirs); for my $item (@$search) { my ($path, $test_params); if (ref $item) { ($path, $test_params) = @$item; } else { my ($type, $data); ($path, $type, $data) = split /(:<|:@|:=)/, $item, 2; if ($type && $data) { $test_params = {}; if ($type eq ':<') { $test_params->{stdin} = $data; } elsif ($type eq ':@') { $test_params->{argv} = decode_json($data); } elsif ($type eq ':=') { $test_params->{env} = decode_json($data); } } } push @dirs => $path and next if -d $path; unless(-f $path) { my ($actual, $args) = split /=/, $path, 2; if (-f $actual) { $path = $actual; $test_params = {%{$test_params // {}}, argv => [quotewords('\s+', 0, $args)]}; } else { die "'$path' is not a valid file or directory.\n" if @$input; next; } } $path = clean_path($path, 0); $seen{$path}++; my $test; unless (first { $test = $_->claim_file($path, $settings, from => 'listed') } @$plugins) { $test = Test2::Harness::TestFile->new(file => $path); } if (my @exclude = $self->exclude_file($test)) { if (@$input) { print STDERR "File '$path' was listed on the command line, but has been exluded for the following reasons:\n"; print STDERR " $_\n" for @exclude; } next; } if ($test_params) { $test->set_input($test_params->{stdin}) if $test_params->{stdin}; $test->set_test_args($test_params->{argv}) if $test_params->{argv}; $test->set_env_vars($test_params->{env}) if $test_params->{env}; } push @tests => $test; } if (@dirs) { require File::Find; File::Find::find( { no_chdir => 1, wanted => sub { no warnings 'once'; my $file = clean_path($File::Find::name, 0); return if $seen{$file}++; return unless -f $file; my $test; unless(first { $test = $_->claim_file($file, $settings, from => 'search') } @$plugins) { for my $ext (@{$self->extensions}) { next unless m/\.\Q$ext\E$/; $test = Test2::Harness::TestFile->new(file => $file); last; } } return unless $test; return unless $self->include_file($test); push @tests => $test; }, }, @dirs ); } my $test_count = @tests; my $threshold = $settings->finder->durations_threshold // 0; if ($threshold && $test_count >= $threshold) { my $start = time; my $durations = $self->duration_data($plugins, $settings, [map { $_->relative } @tests]); my $end = time; if ($durations && keys %$durations) { printf("Fetched duration data (Took %0.2f seconds)\n", $end - $start); for my $test (@tests) { my $rel = $test->relative; $test->set_duration($durations->{$rel}) if $durations->{$rel}; } } } $_->munge_files(\@tests, $settings) for @$plugins; return [ sort { $a->rank <=> $b->rank || $a->file cmp $b->file } @tests ]; } sub include_file { my $self = shift; my ($test) = @_; my @exclude = $self->exclude_file($test); return !@exclude; } sub exclude_file { my $self = shift; my ($test) = @_; my @out; push @out => "File has a do-not-run directive inside it." unless $test->check_feature(run => 1); my $full = $test->file; my $rel = $test->relative; push @out => 'File is in the exclude list.' if $self->exclude_files->{$full} || $self->exclude_files->{$rel}; push @out => 'File matches an exclusion pattern.' if first { $rel =~ m/$_/ } @{$self->exclude_patterns}; push @out => 'File is marked as "long", but the "no long tests" opition was specified.' if $self->no_long && $test->check_duration eq 'long'; push @out => 'File is not marked "long", but the "only long tests" option was specified.' if $self->only_long && $test->check_duration ne 'long'; return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Finder - Library that searches for test files =head1 DESCRIPTION The finder is responsible for locating test files that should be run. You can subclass the finder and instruct yath to use your subclass. =head1 SYNOPSIS =head2 USING A CUSTOM FINDER To use Test2::Harness::Finder::MyFinder: $ yath test --finder MyFinder To use Another::Finder $ yath test --finder +Another::Finder By default C<Test2::Harness::Finder::> is prefixed onto your custom finder, use '+' before the class name or prevent this. =head2 SUBCLASSING use parent 'Test2::Harness::Finder'; use Test2::Harness::TestFile; # Custom finders may provide their own options if desired. # This is optional. use App::Yath::Options; option foo => ( ... ); # This is the main method to override. sub find_project_files { my $self = shift; my ($plugins, $settings, $search) = @_; return [ Test2::Harness::TestFile->new(...), Test2::Harness::TestFile->new(...), ..., ]; } =head1 METHODS These are important state methods, as well as utility methods for use in your subclasses. =over 4 =item $bool = $finder->multi_project True if the C<yath projects> command was used. =item $arrayref = $finder->find_files($plugins, $settings) This is the main method. This method returns an arrayref of L<Test2::Harness::TestFile> instances, each one representing a single test to run. $plugins is a list of plugins, some may be class names, others may be instances. $settings is an L<Test2::Harness::Settings> instance. B<Note:> In many cases it is better to override C<find_project_files()> in your subclasses. =item $durations = $finder->duration_data This will fetch the durations data if any was provided. This is a hashref of relative test paths as keys where the value is the duration of the file (SHORT, MEDIUM or LONG). B<Note:> The result is cached, see L<pull_durations()> to refresh the data. =item @reasons = $finder->exclude_file($test) The input argument should be an L<Test2::Harness::Test> instance. This will return a list of human readable reasons a test file should be excluded. If the file should not be excluded the list will be empty. This is a utility method that verifies the file is not in an exclude list/pattern. The reasons are provided back in case you need to inform the user. =item $bool = $finder->include_file($test) The input argument should be an L<Test2::Harness::Test> instance. This is a convenience method around C<exclude_file()>, it will return true when C<exclude_file()> returns an empty list. =item $arrayref = $finder->find_multi_project_files($plugins, $settings) =item $arrayref = $finder->find_project_files($plugins, $settings, $search) These do the heavy lifting for C<find_files> The default C<find_files()> implementation is this: sub find_files { my $self = shift; my ($plugins, $settings) = @_; return $self->find_multi_project_files($plugins, $settings) if $self->multi_project; return $self->find_project_files($plugins, $settings, $self->search); } Each one returns an arrayref of L<Test2::Harness::TestFile> instances. Note that C<find_multi_project_files()> uses C<find_project_files()> internally, once per project directory. $plugins is a list of plugins, some may be class names, others may be instances. $settings is an L<Test2::Harness::Settings> instance. $search is an arrayref of search paths. =item $finder->munge_settings($settings, $options) A callback that lets you munge settings and options. =item $finder->pull_durations This will fetch the durations data if ant was provided. This is a hashref of relative test paths as keys where the value is the duration of the file (SHORT, MEDIUM or LONG). L<duration_data()> is a cached version of this. This method will refresh the cache for the other. =back =head2 FROM SETTINGS See L<App::Yath::Options::Finder> for up to date documentation on these. =over 4 =item $finder->default_search =item $finder->default_at_search =item $finder->durations =item $finder->maybe_durations =item $finder->exclude_files =item $finder->exclude_patterns =item $finder->no_long =item $finder->only_long =item $finder->search =item $finder->extensions =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Runner.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 45463�15267772575� 22015� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use Carp qw/confess croak/; use Fcntl qw/LOCK_EX LOCK_UN/; use POSIX qw/:sys_wait_h/; use Long::Jump qw/setjump longjump/; use Time::HiRes qw/sleep time/; use Scope::Guard; use Test2::Harness::Util qw/clean_path file2mod lock_file mod2file open_file parse_exit unlock_file write_file_atomic process_includes chmod_tmp write_file/; use Test2::Harness::Util::Queue(); use Test2::Harness::Util::JSON(qw/encode_json/); use Test2::Harness::Runner::Constants; use Test2::Harness::Runner::Run(); use Test2::Harness::Runner::Job(); use Test2::Harness::Runner::Spawn(); use Test2::Harness::Runner::State(); use Test2::Harness::Runner::Preload(); use Test2::Harness::Runner::Preloader(); use Test2::Harness::Runner::Preloader::Stage(); use Test2::Harness::Runner::DepTracer(); use parent 'Test2::Harness::IPC'; use Test2::Harness::Util::HashBase( # Fields from settings qw{ <job_count <slots_per_job <includes <tlib <lib <blib <unsafe_inc <use_fork <preloads <preload_threshold <switches <restrict_reload <cover <event_timeout <post_exit_timeout <resource_timeout <resources <nytprof <reload }, # From Construction qw{ <dir <settings <fork_job_callback <fork_spawn_callback <respawn_runner_callback <monitor_preloads <jobs_todo <dump_depmap }, # Other qw { +preloader +state <stage <signal +last_timeout_check +dispatch_lock_file +can_stage <tmp_dir <rootpid <scheduler_pid }, ); sub job_class { 'Test2::Harness::Runner::Job' } our $RUNNER_PID; sub init { my $self = shift; $self->{+ROOTPID} = $$; $RUNNER_PID = $$; croak "'dir' is a required attribute" unless $self->{+DIR}; croak "'settings' is a required attribute" unless $self->{+SETTINGS}; my $dir = clean_path($self->{+DIR}); croak "'$dir' is not a valid directory" unless -d $dir; $self->{+DIR} = $dir; $self->{+HANDLERS}->{HUP} = sub { my $sig = shift; print "$$ $0 ($self->{+STAGE}) Runner caught SIG$sig, reloading...\n"; $self->{+SIGNAL} = $sig; }; my $tmp_dir = File::Spec->catdir($self->{+DIR}, 'tmp'); unless (-d $tmp_dir) { mkdir($tmp_dir) or die "Could not create temp dir: $!"; chmod_tmp($tmp_dir); } $self->{+TMP_DIR} = $tmp_dir; my $have_job_limiter = 0; for my $res (@{$self->{+RESOURCES}}) { require(mod2file($res)) unless ref($res); $have_job_limiter++ if $res->job_limiter; } unless ($have_job_limiter) { require Test2::Harness::Runner::Resource::JobCount; unshift @{$self->{+RESOURCES}} => 'Test2::Harness::Runner::Resource::JobCount'; } $self->SUPER::init(); } sub preloader { my $self = shift; $self->{+PRELOADER} //= Test2::Harness::Runner::Preloader->new( dir => $self->{+DIR}, preloads => $self->preloads, monitor => $self->{+MONITOR_PRELOADS}, restrict_reload => $self->{+RESTRICT_RELOAD}, dump_depmap => $self->{+DUMP_DEPMAP}, reload => $self->{+RELOAD}, below_threshold => ($self->{+PRELOAD_THRESHOLD} && $self->{+JOBS_TODO} && $self->{+PRELOAD_THRESHOLD} > $self->{+JOBS_TODO}) ? 1 : 0, ); } sub state { my $self = shift; my $preloader = $self->preloader; my $settings = $self->settings; $self->{+STATE} //= Test2::Harness::Runner::State->new( workdir => $self->{+DIR}, eager_stages => $preloader->eager_stages // {}, preloader => $preloader, resources => [map { $_->new(settings => $settings) } @{$self->{+RESOURCES}}], settings => $settings, ); } sub check_timeouts { my $self = shift; return unless $self->settings->runner->use_timeout; my $now = time; # Check only once per second, that is as granular as we get. Also the check is not cheep. return if $self->{+LAST_TIMEOUT_CHECK} && $now < (1 + $self->{+LAST_TIMEOUT_CHECK}); for my $pid (keys %{$self->{+PROCS}}) { my $job = $self->{+PROCS}->{$pid}; next unless $job->isa('Test2::Harness::Runner::Job'); next unless $job->use_timeout; my $et = $job->event_timeout // $self->{+EVENT_TIMEOUT}; my $pet = $job->post_exit_timeout // $self->{+POST_EXIT_TIMEOUT}; next unless $et || $pet; my $changed = $job->output_changed(); my $delta = $now - $changed; # Event timout if we are checking for one, and if the delta is larger than the timeout. my $e_to = $et && $delta > $et; # Post-Exit timeout if we are checking for one, the process has exited (we are waiting) and the delta is larger than the timeout. my $pe_to = $pet && $self->{+WAITING}->{$pid} && $delta > $pet; next unless $e_to || $pe_to; my $kill = -f $job->et_file || -f $job->pet_file; write_file_atomic($job->et_file, "$now $delta") if $e_to && !-f $job->et_file; write_file_atomic($job->pet_file, "$now $delta") if $pe_to && !-f $job->pet_file; my $sigmap = $self->SIG_MAP; my $sig = $kill ? $sigmap->{'KILL'} : $sigmap->{'TERM'}; $sig = "-$sig" if $self->USE_P_GROUPS; print STDERR "$$ $0 " . $job->file . " did not respond to SIGTERM, sending SIGKILL to $pid...\n" if $kill; # storing the jobid we had to stop $self->{run_reached_timeout} //= {}; $self->{run_reached_timeout}->{$job->task->{job_id}} = $pid; kill($sig, $pid); } $self->{+LAST_TIMEOUT_CHECK} = time; } sub stop { my $self = shift; $self->check_for_fork; if (keys %{$self->{+PROCS}}) { print "$$ $0 Sending all child processes the TERM signal...\n"; # Send out the TERM signal $self->killall($self->{+SIGNAL} // 'TERM'); $self->wait(all => 1, timeout => 5); } # Time to get serious if (keys %{$self->{+PROCS}}) { local $?; print STDERR "$$ $0 Some child processes are refusing to exit, sending KILL signal...\n"; print("$$ $0 == $_ " . waitpid($_, WNOHANG) . "\n") for keys %{$self->{+PROCS}}; $self->killall('KILL'); } $self->SUPER::stop(); } sub dispatch_lock_file { my $self = shift; return $self->{+DISPATCH_LOCK_FILE} //= File::Spec->catfile($self->{+DIR}, 'dispatch.lock'); } sub handle_sig { my $self = shift; my ($sig) = @_; return if $self->{+SIGNAL}; return $self->{+HANDLERS}->{$sig}->($sig) if $self->{+HANDLERS}->{$sig}; $self->{+SIGNAL} = $sig; die "Runner caught SIG$sig. Attempting to shut down cleanly...\n"; } sub all_libs { my $self = shift; my @out; push @out => @{$self->{+INCLUDES}} if $self->{+INCLUDES}; push @out => 't/lib' if $self->{+TLIB}; push @out => 'lib' if $self->{+LIB}; if ($self->{+BLIB}) { push @out => 'blib/lib'; push @out => 'blib/arch'; } return @out; } sub process { my $self = shift; @INC = process_includes( list => [@{$self->settings->harness->dev_libs}, $self->all_libs], include_dot => $self->unsafe_inc, include_current => 1, clean => 1, ); my $pidfile = File::Spec->catfile($self->{+DIR}, 'PID'); write_file_atomic($pidfile, "$$"); $self->start(); my $ok = eval { $self->run_tests(); 1 }; my $err = $@; $self->{+CAN_STAGE} = 0; warn $err unless $ok; $self->stop(); return $self->{+SIGNAL} ? 128 + $self->SIG_MAP->{$self->{+SIGNAL}} : $ok ? 0 : 1; } sub spawn_scheduler { my $self = shift; return unless $self->{+ROOTPID} == $$; my $pid = fork // die "Could not fork: $!"; if ($pid) { $self->{+SCHEDULER_PID} = $pid; return $self->watch_pid($pid); } setpgrp(0, 0) if Test2::Harness::Util::IPC::USE_P_GROUPS(); my $guard = Scope::Guard->new(sub { my $err = $@; print STDERR "\n\n$$ $0 Scheduler escaped scope!\n"; print STDERR "$$ $0 Error: $err\n" if $err; exit 255; }); $0 =~ s/-runner/-scheduler/i; my $state = $self->state; my $lock = open_file($self->dispatch_lock_file, '>>'); my $consecutive_errors = 0; my $max_errors = 5; while (1) { my $ok = eval { $state->poll; # Retrying form: a stall report sends SIGUSR1, and flock is not # restarted after a handler runs, so a plain 'or die' here would # report a scheduler error that never happened. lock_file($lock); while (1) { next if $state->advance; last; } unlock_file($lock); if (my $idle = $state->resource_timeout($self->{+RESOURCE_TIMEOUT})) { print STDERR "\n\nyath: Resource timeout after ${idle}s with no tests able to start. Aborting.\n"; print STDERR "There are pending tests but resources have not become available.\n"; print STDERR "Use --resource-timeout to adjust or disable (0) this timeout.\n\n"; $state->truncate(); $self->{+SIGNAL} = 'TERM'; } 1; }; unless ($ok) { my $err = $@; $consecutive_errors++; eval { flock($lock, LOCK_UN) }; print STDERR "\n$$ $0 Scheduler error ($consecutive_errors/$max_errors): $err\n"; if ($consecutive_errors >= $max_errors) { print STDERR "$$ $0 Scheduler aborting after $consecutive_errors consecutive errors.\n"; $guard->dismiss; exit 255; } } else { $consecutive_errors = 0; } if ($self->end_test_loop()) { $guard->dismiss; exit(0); } my $slept = 0; if ($self->{+WAIT_TIME}) { # This sleep is often interrupted by signals. while ($slept < $self->{+WAIT_TIME}) { $slept += sleep($self->{+WAIT_TIME} - $slept); } } } warn "$$ $0 Escaped scheduler loop"; exit 255; } sub run_tests { my $self = shift; my $preloader = $self->preloader; $preloader->preload(); $self->spawn_scheduler(); my ($stage, @procs) = $preloader->preload_stages(); if ($self->dump_depmap) { if (my $dtrace = $preloader->dtrace) { if (my $depmap = $dtrace->dep_map) { my $file = "depmap-$stage.json"; write_file($file, encode_json($depmap)); } } } $self->watch($_) for @procs; while(1) { $self->{+CAN_STAGE} = 1; my $jump = setjump "Stage-Runner" => sub { $self->run_stage($stage); }; last unless $jump; ($stage) = @$jump; $self->reset_stage(); } return; } sub reset_stage { my $self = shift; # Normalize IPC $self->check_for_fork(); # If no stage was set we do not want to clear this, root stages need to # preserve the preloads return unless $self->{+STAGE}; # From Runner delete $self->{+STAGE}; delete $self->{+STATE}; delete $self->{+LAST_TIMEOUT_CHECK}; return; } sub run_stage { my $self = shift; my ($stage) = @_; $self->{+STAGE} = $stage; $self->state->stage_ready($stage); while (1) { next if $self->run_job(); next if $self->wait(); last if $self->end_test_loop(); sleep($self->{+WAIT_TIME}) if $self->{+WAIT_TIME}; } $self->state->stage_down($stage); $self->killall($self->{+SIGNAL}) if $self->{+SIGNAL}; $self->wait(all => 1); exit 0 unless $stage eq 'base' || $stage eq 'default'; } sub run_job { my $self = shift; my $task = $self->state->next_task($self->{+STAGE}) or return 0; if ($task->{spawn} && !$task->{resource_skip}) { my $job = Test2::Harness::Runner::Spawn->new( runner => $self, task => $task, settings => $self->settings, fork_callback => $self->{+FORK_SPAWN_CALLBACK}, ); $self->{+FORK_SPAWN_CALLBACK}->($self, $job); return 1; } my $run = $self->state->run(); return 1 unless $run; my $job_class; if ($task->{job_class}) { $job_class = $task->{job_class}; require(mod2file($job_class)); die "Custom job class $job_class overrode the category, this is a fatal mistake" unless $job_class->category eq $self->job_class->category; } else { $job_class = $self->job_class; } my $job = $job_class->new( runner => $self, task => $task, run => $run, settings => $self->settings, fork_callback => $self->{+FORK_JOB_CALLBACK}, ); $job->prepare_dir(); my $spawn_time; my $pid; my $via = $job->via(); if ($via) { require(mod2file($1)) if !defined(&{$via}) && $via =~ m/^(.+)::[^:]+$/; $spawn_time = time(); $pid = $self->$via($job); $job->set_pid($pid); $self->watch($job); } else { $spawn_time = time(); $self->spawn($job); $pid = $job->pid; } my $json_data = $job->TO_JSON(); $json_data->{stamp} = $spawn_time; $run->jobs->write($json_data); return $pid; } sub end_test_loop { my $self = shift; my $state = $self->state; no warnings 'uninitialized'; if (!$self->{+STAGE} || $self->{+STAGE} eq 'default' || $self->{+STAGE} eq 'base') { $self->{+RESPAWN_RUNNER_CALLBACK}->() if $self->preloader->check($state) || ($self->{+SIGNAL} && $self->{+SIGNAL} eq 'HUP'); } if ($self->preloader->check($state)) { $self->{+SIGNAL} //= 'HUP'; return 1; } return 1 if $self->{+SIGNAL}; return 1 if $state->done; return 0; } sub set_proc_exit { my $self = shift; my ($proc, $exit, $time, @args) = @_; if ($proc->isa('Test2::Harness::Runner::Job')) { my $task = $proc->task; my $timed_out = 0; if ( !$exit && ref $self->{run_reached_timeout} && $self->{run_reached_timeout}->{ $task->{job_id} } ) { delete $self->{run_reached_timeout}->{ $task->{job_id} }; $timed_out = 1; } if (($exit || $timed_out) && $proc->is_try < ($proc->retry // 0) ) { $self->state->retry_task($task->{job_id}); push @args => 'will-retry'; } else { $self->state->stop_task($task->{job_id}); } if(my $bail = $exit ? $proc->bailed_out : 0) { print "$$ $0 BAIL-OUT detected: $bail\n"; if ($self->settings->runner->abort_on_bail) { print "$$ $0 Aborting the test run...\n"; $self->state->halt_run($task->{run_id}); } } } elsif ($proc->isa('Test2::Harness::Runner::Preloader::Stage')) { my $stage = $proc->name; if ($exit != 0) { my $e = parse_exit($exit); my $err = "$$ $0 Child stage '$stage' did not exit cleanly (sig: $e->{sig}, err: $e->{err})!\n"; $self->{+MONITOR_PRELOADS} ? warn $err : die $err; } if ($self->{+MONITOR_PRELOADS} && $self->{+CAN_STAGE} && !$self->end_test_loop) { my $pid = $$; my ($name, @procs) = $self->preloader->_preload_stages($stage); $self->watch($_) for @procs; longjump "Stage-Runner" => $name unless $pid == $$; } } if ($self->{+SCHEDULER_PID} && $proc->pid == $self->{+SCHEDULER_PID}) { delete $self->{+SCHEDULER_PID}; if ($exit) { my $e = parse_exit($exit); print STDERR "\n$$ $0 Scheduler process (pid: @{[$proc->pid]}) exited unexpectedly (sig: $e->{sig}, err: $e->{err})!\n"; print STDERR "$$ $0 Aborting test run due to scheduler death.\n\n"; $self->{+SIGNAL} //= 'TERM'; } elsif (!$self->{+SIGNAL} && !$self->state->done) { print STDERR "\n$$ $0 Scheduler process (pid: @{[$proc->pid]}) exited prematurely (exit: 0) with pending work.\n\n"; $self->{+SIGNAL} //= 'TERM'; } } $self->SUPER::set_proc_exit($proc, $exit, $time, @args); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner - Base class for test runners =head1 DESCRIPTION This module does the heavy lifting of running all the tests. You should never need to create an instance of the runner yourself. In most cases the runner module is exposed via a callback or a plugin affordance. =head1 PUBLIC METHODS =head2 FROM SETTINGS These are attributes with values set from the L<Test2::Harness::Settings> instance created from command line arguments. See L<App::Yath::Options::Runner> for the most up to date documentation on these. =over 4 =item $runner->includes =item $runner->tlib =item $runner->lib =item $runner->blib =item $runner->unsafe_inc =item $runner->use_fork =item $runner->preloads =item $runner->preload_threshold =item $runner->switches =item $runner->cover =item $runner->event_timeout =item $runner->post_exit_timeout =back =head2 FROM CONSTRUCTION These attributes are set when the runner is created. =over 4 =item $path = $runner->dir Path to the working directory. =item $settings = $runner->settings The L<App::Yath::Settings> instance. =item $coderef = $runner->fork_job_callback Callback used to spawn new tests via fork. =item $coderef = $runner->respawn_runner_callback Callback to restart the runner process. =item $bool = $runner->monitor_preloads True if preloads should be watched for changes. =item $int = $runner->jobs_todo A count of total jobs to run. This will always be 0 in a persistent runner. =back =head2 OTHER PUBLIC METHODS If a method is not documented here then it is an implementation detail and you should not use it. =over 4 =item $class = $runner->job_class Class for new test jobs. =item $preload = $runner->preloader Get the L<Test2::Harness::Runner::Preloader> instance. =item $state = $runner->state Get the L<Test2::Harness::Runner::State> instance. =item @list = $runner->all_libs Get all the libs that should be added to @INC by default. Note that specific runs and even specific tests can have custom paths on top of these. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 26460�15267772575� 21776� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Plugin; use strict; use warnings; our $VERSION = '1.000182'; # Document, but do not implement #sub changed_files {} #sub changed_diff {} sub munge_search {} sub claim_file {} sub munge_files {} sub inject_run_data {} sub setup {} sub teardown {} sub TO_JSON { ref($_[0]) || "$_[0]" } sub redirect_io { my $this = shift; my ($settings, $name) = @_; my @caller = caller(); my $at = "at $caller[1] line $caller[2].\n"; die "Invalid settings ($settings) $at" unless $settings && ref($settings) eq 'Test2::Harness::Settings'; die "No name provided $at" unless $name; die "This cannot be used without a workspace $at" unless $settings->check_prefix('workspace'); require File::Spec; require Test2::Harness::Util::IPC; my $dir = $settings->workspace->workdir; my $aux = File::Spec->catdir($dir, 'aux_logs'); mkdir($aux) unless -d $aux; Test2::Harness::Util::IPC::swap_io(\*STDOUT, File::Spec->catfile($aux, "${name}-STDOUT.log")); Test2::Harness::Util::IPC::swap_io(\*STDERR, File::Spec->catfile($aux, "${name}-STDERR.log")); return; } sub shellcall { my $this = shift; my ($settings, $name, @cmd) = @_; require POSIX; my @caller = caller(); my $at = "at $caller[1] line $caller[2].\n"; die "Invalid settings ($settings) $at" unless $settings && ref($settings) eq 'Test2::Harness::Settings'; die "No name provided $at" unless $name; die "No command provided $at" unless @cmd && length($cmd[0]); my $pid = fork // die "Could not fork: $!"; if ($pid) { local $?; waitpid($pid, 0); return $?; } else { local $@; eval { if ($settings->check_prefix('workspace')) { $this->redirect_io($settings, $name); } exec(@cmd) if @cmd > 1; exec($cmd[0]); }; chomp(my $err = $@ // "unknown error"); warn "Could not run command ($@) $at"; POSIX::_exit(1); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Plugin - Base class for Test2::Harness plugins. =head1 DESCRIPTION This class holds the methods specific to L<Test2::Harness> which is the backend. Most of the time you actually want to subclass L<App::Yath::Plugin> which subclasses this class, and holds additional methods that apply to yath (the UI layer). =head1 SYNOPSIS You probably want to subclass L<App::Yath::Plugin> instead. This class here mainly exists to separate concerns, but is not something you should use directly. package Test2::Harness::Plugin::MyPlugin; use parent 'Test2::Harness::Plugin'; # ... Define methods 1; =head1 METHODS =over 4 =item $plugin->munge_search($input, $default_search, $settings) C<$input> is an arrayref of files and/or directories provided at the command line. C<$default_search> is an arrayref with the default files/directories pulled in when nothing is specified at the command line. C<$settings> is an instance of L<Test2::Harness::Settings> =item $undef_or_inst = $plugin->claim_file($path, $settings) This is a chance for a plugin to claim a test file early, before Test2::Harness takes care of it. If your plugin does not want to claim the file just return undef. To claim the file return an instance of L<Test2::Harness::TestFile> created with C<$path>. =item $plugin->munge_files(\@tests, $settings) This is an opportunity for your plugin to modify the data for any test file that will be run. The first argument is an arrayref of L<Test2::Harness::TestFile> objects. =item $hashref = $plugin->duration_data($settings, $test_names) If defined, this can return a hashref of duration data. This should return undef if no duration data is provided. The first plugin listed that provides duration data wins, no other plugins will be checked once duration data is obtained. Example duration data: { 't/foo.t' => 'medium', 't/bar.t' => 'short', 't/baz.t' => 'long', } =item $hashref_or_arrayref = $plugin->coverage_data(\@changed) =item $hashref_or_arrayref = $plugin->coverage_data() If defined, this can return a hashref of all coverage data, or an arrayref of tests that cover the tests listed in @changed. This should return undef if no coverage data is available. The first plugin to provide coverage data wins, no other plugins will be checked once coverage data has been obtained. Examples: [ 'foo.t', 'bar.t', 'baz.t', ] { 'lib/Foo.pm' => [ 't/foo.t', 't/integration.t', ], 'lib/Bar.pm' => [ 't/bar.t', 't/integration.t', ], } =item $plugin->post_process_coverage_tests($settings, \@tests) This is an opportunity for a plugin to do post-processing on the list of coverage tests to run. This is mainly useful to remove duplicates if multiple plugins add coverage data, or merging entries where applicable. This will be called after all plugins have generated their coverage test list. Plugins may implement this without implementing coverage_data(), making this useful if you want to use a pre-existing coverage module and want to do post-processing on what it provides. =item $plugin->inject_run_data(meta => $meta, fields => $fields, run => $run) This is a callback that lets your plugin add meta-data or custom fields to the run event. The meta-data and fields are available in the event log, and are particularly useful to L<App::Yath::UI>. sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; # Meta-data is a hash, each plugin should define its own key, and put # data under that key $meta->{MyPlugin}->{stuff} = "Stuff!"; # Fields is an array of fields that a UI might want to display when showing the run. push @$fields => {name => 'MyPlugin', details => "Human Friendly Stuff", raw => "Less human friendly stuff", data => $all_the_stuff}; return; } =item %facets = $plugin->annotate_event($event, $settings) Called for every event after the auditor has processed it, before it is logged or rendered. Return facets to add to the event, keyed by facet name; an existing facet may only be appended to when it is a list. A plugin may instead modify facets already on the event. That is tolerated, not encouraged, and the plugin must then include C<< -rewrite => 1 >> in what it returns so the logged line reflects the change. Without it the log keeps the event as it arrived. =item $plugin->setup($settings) This is a callback that lets you run setup logic when the runner starts. Note that in a persistent runner this is run once on startup, it is not run for each C<run> command against the persistent runner. =item $plugin->teardown($settings) This is a callback that lets you run teardown logic when the runner stops. Note that in a persistent runner this is run once on termination, it is not run for each C<run> command against the persistent runner. =item @files = $plugin->changed_files($settings) Get a list of files that have changed. Plugins are free to define what "changed" means. This may be used by the finder to determine what tests to run based on coverage data collected in previous runs. Note that data from all changed_files() calls from all plugins will be merged. =item ($type, $value) = $plugin->changed_diff($settings) Generate a diff that can be used to calculate changed files/subs for which to run tests. Unlike changed_files(), only 1 diff will be used, first plugin listed that returns one wins. This is not run at all if a diff is provided via --changed-diff. Diffs must be in the same format as this git command: git diff -U1000000 -W --minimal BASE_BRANCH_OR_COMMIT Some other diff formats may work by chance, but they are not directly supported. In the future other diff formats may be directly supported, but not yet. The following return sets are allowed: =over 4 =item file => string Path to a diff file =item diff => string In memory diff as a single string =item lines => \@lines Diff where each line is a separate string in an arrayref. =item line_sub => sub { ... } Sub that returns one line per call and undef when there are no more lines =item handle => $FH A filehandle to the diff =back =item $exit = $plugin->shellcall($settings, $name, $cmd) =item $exit = $plugin->shellcall($settings, $name, @cmd) This is essentially the same as C<system()> except that STDERR and STDOUT are redirected to files that the yath collector will pick up so that any output from the command will be seen as events and will be part of the yath log. If no workspace is available this will not redirect IO and it will be identical to calling C<system()>. This is particularly useful in C<setup()> and C<teardown()> when running external commands, specially any that daemonize and continue to produce output after the setup/teardown method has completed. $name is required because it will be used for filenames, and will be used as the output tag (best to limit it to 8 characters). =item $plugin->redirect_io($settings, $name) B<WARNING:> This must NEVER be called in a primary yath process. Only use this in forked processes that you control. If this is used in a main process it could hide ALL output. This will redirect STDERR and STDOUT to files that will be picked up by the yath collector so that any output appears as proper yath events and will be included in the yath log. $name is required because it will be used for filenames, and will be used as the output tag (best to limit it to 8 characters). =item $plugin->TO_JSON This is here as a bare minimum serialization method. It returns the plugin class name. =back =head1 ATTACHING FILES A helper process, such as one started with C<shellcall()>, can attach a file to the run by placing it in the C<aux_logs/attachments/> directory under the workdir (C<< $settings->workspace->workdir >>). The writer creates C<aux_logs/> and C<aux_logs/attachments/> if they do not exist. The collector attaches each file name once, as a binary on the harness output (job 0) along with an C<ARTIFACT> line naming it. Files whose names start with a dot are ignored, so write the file as C<.name.tmp> and rename it to its final name once it is complete; anything visible is read as soon as the collector sees it. Files ending in an image extension are flagged as images. The file is read whole into memory and sent inline, base64 encoded, as part of the event stream and the log. There is no size limit; keeping attachments a sensible size is up to the writer. Like the rest of the runner output, attachments are not collected when C<--hide-runner-output> is in effect. With a persistent runner every command sees every file already in the directory, unless C<--truncate-runner-output> is used, in which case files present when the command starts are skipped. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������concurrency.t���������������������������������������������������������������������������������������100644��001750��001750�� 5660�15267772575� 22314� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # The order jobs start and stop in is not fixed: a machine slow enough to take # longer starting a job than a job takes to run will interleave them # differently every time. What is fixed is how many the scheduler allows at # once, and the fixtures hold each other until that many are live so the log # is guaranteed to show it rather than merely likely to. sub concurrency { my ($log) = @_; my @order; my @events = $log->poll(); while (@events) { if (my $event = shift @events) { my $f = $event->{facet_data}; if (my $e = $f->{harness_job_exit}) { push @order => [$e->{stamp}, -1]; } if (my $l = $f->{harness_job_start}) { push @order => [$l->{stamp}, 1]; } } # Check for additional events, probably should not have any, but we may hit # a buffering limit in the log reader and need additional polls. push @events => $log->poll; } # We care about the order in which events happened based on time stamp, not # the order in which they were collected, which may be different. A start # and an exit that share a stamp are counted as the exit first, so a slow # clock cannot inflate the count. @order = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @order; my ($running, $max, $starts, $exits) = (0, 0, 0, 0); for my $item (@order) { my $delta = $item->[1]; $running += $delta; $max = $running if $running > $max; $delta > 0 ? $starts++ : $exits++; } return {max => $max, starts => $starts, exits => $exits}; } # Each run gets its own barrier directory: markers left by an earlier run # would let a later one satisfy its barrier without ever overlapping. run_at(4); run_at(2); sub run_at { my ($jobs) = @_; my $barrier = tempdir(CLEANUP => 1); yath( command => 'test', args => [ $dir, '--ext=tx', "-j$jobs", '-It/lib', '--env-var' => "TEST_BARRIER_DIR=$barrier", '--env-var' => "TEST_BARRIER_COUNT=$jobs", ], log => 1, exit => 0, test => sub { my $out = shift; my $stats = concurrency($out->{log}); is($stats->{starts}, 5, "All 5 tests started"); is($stats->{exits}, 5, "All 5 tests exited"); # The barrier holds every job in the wave until the full $jobs of them # are live, so this is exact now, not a range: fewer means the limiter # or the barrier failed, more means the limiter did. is($stats->{max}, $jobs, "Ran exactly $jobs jobs at once, never more"); }, ); } done_testing; ��������������������������������������������������������������������������������coverage��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21221� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 2057�15267772575� 22162� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; use Ax; use Bx; use Cx; Test2::Plugin::Cover->set_from_manager('Manager'); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); is(Cx->c, 'c', "Got c"); subtest a => sub { Test2::Plugin::Cover->set_from({subtest => 'a'}); is(Ax->a, 'a', "Got a"); is(Ax->aa, 'aa', "Got aa"); Test2::Plugin::Cover->clear_from(); }; subtest b => sub { Test2::Plugin::Cover->set_from({subtest => 'b'}); is(Ax->a, 'a', "Got a"); is(Bx->b, 'b', "Got b"); Test2::Plugin::Cover->clear_from(); }; subtest c => sub { Test2::Plugin::Cover->set_from({subtest => 'c'}); is(Ax->a, 'a', "Got a"); is(Bx->b, 'b', "Got b"); is(Cx->c, 'c', "Got c"); Test2::Plugin::Cover->clear_from(); }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 677�15267772575� 22151� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; use Bx; is(Bx->b, 'b', "Got b"); done_testing; �����������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 1500�15267772575� 22154� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; Test2::Plugin::Cover->set_from_manager('Manager'); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; subtest a => sub { Test2::Plugin::Cover->set_from({subtest => 'a'}); require Ax; is(Ax->a, 'a', "Got a"); Test2::Plugin::Cover->clear_from(); }; subtest c => sub { Test2::Plugin::Cover->set_from({subtest => 'c'}); require Ax; require Cx; is(Ax->a, 'a', "Got a"); is(Cx->c, 'c', "Got c"); Test2::Plugin::Cover->clear_from(); }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������x.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 661�15267772575� 22170� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; require Bx; ok(1); done_testing; �������������������������������������������������������������������������������resource��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21255� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 247�15267772575� 22175� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 247�15267772575� 22176� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 247�15267772575� 22177� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 247�15267772575� 22200� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($ENV{RESOURCE_TEST}, "Set the env var"); is($ARGV[0], $ENV{RESOURCE_TEST}, "Set the test cli argument to the same value"); sleep 1; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fail.txx��������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22166� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test������������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������times�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20547� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22173� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/times�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������verbose_env.t���������������������������������������������������������������������������������������100644��001750��001750�� 1424�15267772575� 22271� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Config qw/%Config/; use File::Temp qw/tempfile/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Make it very wrong to start local $ENV{T2_HARNESS_IS_VERBOSE} = 99; local $ENV{HARNESS_IS_VERBOSE} = 99; yath( command => 'test', args => [File::Spec->catfile($dir, "not_verbose.tx")], exit => F(), ); yath( command => 'test', args => ['-v', File::Spec->catfile($dir, "verbose1.tx")], exit => F(), ); yath( command => 'test', args => ['-vv', File::Spec->catfile($dir, "verbose2.tx")], exit => F(), ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Harness���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20466� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2������������������������������������������������������������������������������������������������������������������������������������Util.t����������������������������������������������������������������������������������������������100644��001750��001750�� 6621�15267772575� 21735� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util'; #BEGIN { skip_all 'TODO' } use ok $CLASS => ':ALL'; use File::Temp qw/tempfile tempdir/; imported_ok qw{ fqmod maybe_open_file maybe_read_file open_file process_includes read_file write_file write_file_atomic is_same_file }; my ($line) = split /\n/, read_file(__FILE__), 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util';}, "Read file (only checking first line)" ); like( dies { read_file('/fake/file/that/must/not/exist cause I say so') }, qr{^\QCould not open file '/fake/file/that/must/not/exist cause I say so' (<)\E}, "Exception thrown when read_file used on non-existing file" ); is( maybe_read_file(__FILE__), read_file(__FILE__), "maybe_read_file reads file when it exists" ); is( maybe_read_file('/fake/file/that/must/not/exist cause I say so'), undef, "maybe_read_file is undef when file does not exist" ); ok(my $fh = open_file(__FILE__), "opened file"); ok($line = <$fh>, "Can read from file, default mode is 'read'"); if (-e '/dev/null') { ok(my $null = open_file('/dev/null', '>'), "opened /dev/null for writing"); ok((print $null "xxx\n"), "printed to /dev/null"); is( [write_file('/dev/null', "AAA", "BBB")], ["AAA", "BBB"], "wrote and returned content (/dev/null)" ); } is( maybe_open_file('/fake/file/that/must/not/exist cause I say so'), undef, "maybe_open_file is undef when file does not exist" ); is(fqmod('Foo::Bar', 'Baz'), 'Foo::Bar::Baz', "fqmod on postfix"); is(fqmod('Foo::Bar', 'Baz::Bat'), 'Foo::Bar::Baz::Bat', "fqmod on longer postfix"); is(fqmod('Foo::Bar', '+Baz'), 'Baz', "fqmod on fq"); is(fqmod('Foo::Bar', '+Baz::Bat'), 'Baz::Bat', "fqmod on longer fq"); my $tmp = tempdir(CLEANUP => 1, TMPDIR => 1); write_file_atomic(File::Spec->canonpath("$tmp/xxx"), "data"); $fh = open_file(File::Spec->canonpath("$tmp/xxx"), '<'); is(<$fh>, "data", "read data from file"); open($fh, '>', "$tmp/foo"); print $fh "\n"; close($fh); open($fh, '>', "$tmp/bar"); print $fh "\n"; close($fh); symlink("$tmp/foo", "$tmp/foo3") or die "Could not create link: $!"; ok(is_same_file("$tmp/foo", "$tmp/foo"), "Matching filenames"); # Android refuses hard links in app storage, so Termux perl gets EACCES here. SKIP: { skip "Android does not permit hard links", 1 if $^O eq 'android'; link("$tmp/foo", "$tmp/foo2") or die "Could not create link: $!"; ok(is_same_file("$tmp/foo", "$tmp/foo2"), "hard link"); } ok(is_same_file("$tmp/foo", "$tmp/foo3"), "soft link"); ok(!is_same_file("$tmp/foo", "$tmp/bar"), "Different files"); # @INC may hold hooks (coderef, arrayref, blessed object) as documented in # perlvar "@INC". They are not paths, and clean_path() would turn them into # nonexistent 'CODE(0x...)' paths that then reach child processes as -I args. my ($plain, $cleaned); { my $hook = sub { return }; local @INC = ('/some/lib', $hook, [$hook], bless({}, 'Some::INC::Hook'), '/other/lib'); $plain = [process_includes(include_current => 1)]; $cleaned = [process_includes(include_current => 1, clean => 1)]; } is($plain, ['/some/lib', '/other/lib'], "process_includes drops \@INC hooks and keeps paths in order"); ok(!(grep { m{(?:CODE|ARRAY|HASH)\(0x} } @$cleaned), "No stringified hook reached the cleaned list"); done_testing; ���������������������������������������������������������������������������������������������������������������relative_paths_no_fork.t����������������������������������������������������������������������������100644��001750��001750�� 640�15267772575� 22221� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t2����������������������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; # HARNESS-NO-FORK # HARNESS-DURATION-SHORT my $path = File::Spec->canonpath('t2/relative_paths_no_fork.t'); skip_all "This test must be run from the project root." unless -f $path; is(__FILE__, $path, "__FILE__ is relative"); is(__FILE__, $0, "\$0 is relative"); sub { my ($pkg, $file) = caller(0); is($file, $path, "file in caller is relative"); }->(); done_testing; ������������������������������������������������������������������������������������������������help.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 25344�15267772575� 22067� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::help; use strict; use warnings; use Test2::Util qw/pkg_to_file/; our $VERSION = '1.000182'; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/<_command_info_hash/; use Test2::Harness::Util qw/open_file find_libraries/; use List::Util (); sub options {}; sub group { '' } sub summary { 'Show the list of commands' } sub description { return <<" EOT" This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. EOT } sub command_info_hash { my $self = shift; return $self->{+_COMMAND_INFO_HASH} if $self->{+_COMMAND_INFO_HASH}; my %commands; my $command_libs = find_libraries('App::Yath::Command::*'); for my $lib (sort keys %$command_libs) { my $ok = eval { require $command_libs->{$lib}; 1 }; unless ($ok) { warn "Failed to load command '$command_libs->{$lib}': $@"; next; } next if $lib->internal_only; my $name = $lib->name; my $group = $lib->group; $commands{$group}->{$name} = $lib->summary; } return $self->{+_COMMAND_INFO_HASH} = \%commands; } sub command_list { my $self = shift; my $command_hash = $self->command_info_hash(); my @commands = map keys %$_, values %$command_hash; return @commands; } sub run { my $self = shift; my $args = $self->{+ARGS}; return $self->command_help($args->[0]) if @$args; my $script = $self->settings->harness->script // $0; my $maxlen = List::Util::max(map length, $self->command_list); print "\nUsage: $script COMMAND [options]\n\nAvailable Commands:\n"; my $command_info_hash = $self->command_info_hash; for my $group (sort keys %$command_info_hash) { my $set = $command_info_hash->{$group}; printf(" %${maxlen}s: %s\n", $_, $set->{$_}) for sort keys %$set; print "\n"; } return 0; } sub command_help { my $self = shift; my ($command) = @_; require App::Yath; my $cmd_class = App::Yath->load_command($command); print $cmd_class->cli_help(settings => $self->{+SETTINGS}); return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::help - Show the list of commands =head1 DESCRIPTION This command provides a list of commands when called with no arguments. When given a command name as an argument it will print the help for that command. =head1 USAGE $ yath [YATH OPTIONS] help [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������init.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 24100�15267772575� 22067� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::init; use strict; use warnings; use parent 'App::Yath::Command'; our $VERSION = '1.000182'; use Test2::Harness::Util qw/open_file/; use App::Yath::Util qw/is_generated_test_pl/; sub group { 'zinit' } sub summary { "Create/update test.pl to run tests via Test2::Harness" } sub description { return <<" EOT"; This command will create or update the 'test.pl' file in the current directory. This 'test.pl' file this creates will run all your tests via yath. This command will fail if there is already a test.pl file that does not look like it was generated by this command. EOT } sub run { die "'test.pl' already exists, and does not appear to be a yath runner.\n" if -f 'test.pl' && !is_generated_test_pl('test.pl'); print "\nWriting test.pl...\n\n"; my $fh = open_file('test.pl', '>'); print $fh <<' EOT'; #!/usr/bin/env perl # HARNESS-NO-PRELOAD # HARNESS-CAT-LONG # THIS IS A GENERATED YATH RUNNER TEST use strict; use warnings; use lib 'lib'; use App::Yath::Util qw/find_yath/; system($^X, find_yath(), '-D', 'test', '--default-search' => './t', '--default-search' => './t2', @ARGV); my $exit = $?; # This makes sure it works with prove. print "1..1\n"; print "not " if $exit; print "ok 1 - Passed tests when run by yath\n"; print STDERR "yath exited with $exit" if $exit; exit($exit ? 255 : 0); EOT return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::init - Create/update test.pl to run tests via Test2::Harness =head1 DESCRIPTION This command will create or update the 'test.pl' file in the current directory. This 'test.pl' file this creates will run all your tests via yath. This command will fail if there is already a test.pl file that does not look like it was generated by this command. =head1 USAGE $ yath [YATH OPTIONS] init [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������kill.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 67466�15267772575� 22105� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::kill; use strict; use warnings; our $VERSION = '1.000182'; use Time::HiRes qw/sleep/; use App::Yath::Util qw/find_pfile/; use File::Path qw/remove_tree/; use Test2::Harness::Util::File::JSON(); use parent 'App::Yath::Command::abort'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Kill the runner and any running or pending tests" } sub cli_args { "" } sub description { return <<" EOT"; This command will kill the active yath runner and any running or pending tests. EOT } sub pfile_params { (no_checks => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $pfile = $data->{pfile_path}; $self->App::Yath::Command::test::terminate_queue(); $_->teardown($self->settings) for @{$self->settings->harness->plugins}; $self->SUPER::run(); sleep(0.02) while kill(0, $self->pfile_data->{pid}); unlink($pfile) if -f $pfile; remove_tree($self->workdir, {safe => 1, keep_root => 0}) if -d $self->workdir; print "\n\nRunner stopped\n\n" unless $self->settings->display->quiet; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::kill - Kill the runner and any running or pending tests =head1 DESCRIPTION This command will kill the active yath runner and any running or pending tests. =head1 USAGE $ yath [YATH OPTIONS] kill [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������stop.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 67442�15267772575� 22131� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::stop; use strict; use warnings; our $VERSION = '1.000182'; use Time::HiRes qw/sleep/; use File::Spec(); use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use Test2::Harness::Util qw/open_file/; use App::Yath::Util qw/find_pfile/; use File::Path qw/remove_tree/; use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Stop the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will stop a persistent instance, and output any log contents. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; $self->App::Yath::Command::test::terminate_queue(); $_->teardown($self->settings) for @{$self->settings->harness->plugins}; sleep(0.02) while kill(0, $self->pfile_data->{pid}); my $pfile = $self->pfile; unlink($pfile) if -f $pfile; remove_tree($self->workdir, {safe => 1, keep_root => 0}) if -d $self->workdir; print "\n\nRunner stopped\n\n" unless $self->settings->display->quiet; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::stop - Stop the persistent test runner =head1 DESCRIPTION This command will stop a persistent instance, and output any log contents. =head1 USAGE $ yath [YATH OPTIONS] stop [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 202612�15267772575� 22131� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::test; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Event; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use Test2::Harness::Util::IPC qw/USE_P_GROUPS/; use Test2::Harness::Runner::State; use Test2::Harness::Stall::Capture(); use Test2::Harness::Stall::Detector(); use Test2::Harness::Stall::Report(); use Test2::Harness::Util::JSON qw/encode_json decode_json JSON/; use Test2::Harness::Util qw/mod2file open_file chmod_tmp/; use Test2::Util::Table qw/table/; use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; use File::Spec; use Fcntl(); use Errno(); use Time::HiRes qw/sleep time/; use List::Util qw/sum max min/; use Carp qw/croak/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/ <runner_pid +ipc +signal +run <run_id +auditor_reader +collector_writer +renderer_reader +auditor_writer +renderers +logger +last_log +tests_seen +asserts_seen +run_queue +tasks_queue +state +stall_detector <cleanup_subs <final_data /; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Display', 'App::Yath::Options::Finder', 'App::Yath::Options::Logging', 'App::Yath::Options::PreCommand', 'App::Yath::Options::Run', 'App::Yath::Options::Runner', 'App::Yath::Options::Workspace', 'App::Yath::Options::Collector', ); sub MAX_ATTACH() { 1_048_576 } sub group { ' test' } sub summary { "Run tests" } sub cli_args { '[--] [test files/dirs] [::] [arguments to test scripts] [test_file.t] [test_file2.t="--arg1 --arg2 --param=\'foo bar\'"] [:: --argv-for-all-tests]' } sub description { return <<" EOT"; This yath command (which is also the default command) will run all the test files for the current project. If no test files are specified this command will look for the 't', and 't2' directories, as well as the 'test.pl' file. This command is always recursive when given directories. This command will add 'lib', 'blib/arch' and 'blib/lib' to the perl path for you by default (after any -I's). You can specify -l if you just want lib, -b if you just want the blib paths. If you specify both -l and -b both will be added in the order you specify (order relative to any -I options will also be preserved. If you do not specify they will be added in this order: -I's, lib, blib/lib, blib/arch. You can also add --no-lib and --no-blib to avoid both. Any command line argument that is not an option will be treated as a test file or directory of test files to be run. If you wish to specify the ARGV for tests you may append them after '::'. This is mainly useful for Test::Class::Moose and similar tools. EVERY test run will get the same ARGV. EOT } sub spawn_args { my $self = shift; my ($settings) = @_; my @out; if ($ENV{T2_DEVEL_COVER} && $ENV{T2_COVER_SELF}) { push @out => '-MDevel::Cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; } my $plugins = $settings->harness->plugins; if (@$plugins) { push @out => $_->spawn_args($settings) for grep { $_->can('spawn_args') } @$plugins; } return @out; } sub init { my $self = shift; $self->SUPER::init() if $self->can('SUPER::init'); $self->{+TESTS_SEEN} //= 0; $self->{+ASSERTS_SEEN} //= 0; $self->{+CLEANUP_SUBS} = []; } sub _resize_pipe { return unless defined &Fcntl::F_SETPIPE_SZ; my ($fh) = @_; # 1mb if we can my $size = 1024 * 1024 * 1; # On linux systems lets go for the smaller of the two between 1mb and # system max. if (-e '/proc/sys/fs/pipe-max-size') { open(my $max, '<', '/proc/sys/fs/pipe-max-size'); chomp(my $val = <$max>); close($max); $size = min($size, $val); } fcntl($fh, Fcntl::F_SETPIPE_SZ(), $size); } sub auditor_reader { my $self = shift; return $self->{+AUDITOR_READER} if $self->{+AUDITOR_READER}; pipe($self->{+AUDITOR_READER}, $self->{+COLLECTOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+COLLECTOR_WRITER}); return $self->{+AUDITOR_READER}; } sub collector_writer { my $self = shift; return $self->{+COLLECTOR_WRITER} if $self->{+COLLECTOR_WRITER}; pipe($self->{+AUDITOR_READER}, $self->{+COLLECTOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+COLLECTOR_WRITER}); return $self->{+COLLECTOR_WRITER}; } sub renderer_reader { my $self = shift; return $self->{+RENDERER_READER} if $self->{+RENDERER_READER}; pipe($self->{+RENDERER_READER}, $self->{+AUDITOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+AUDITOR_WRITER}); return $self->{+RENDERER_READER}; } sub auditor_writer { my $self = shift; return $self->{+AUDITOR_WRITER} if $self->{+AUDITOR_WRITER}; pipe($self->{+RENDERER_READER}, $self->{+AUDITOR_WRITER}) or die "Could not create pipe: $!"; _resize_pipe($self->{+AUDITOR_WRITER}); return $self->{+AUDITOR_WRITER}; } sub workdir { my $self = shift; $self->settings->workspace->workdir; } sub ipc { my $self = shift; return $self->{+IPC} //= Test2::Harness::IPC->new( handlers => { INT => sub { $self->handle_sig(@_) }, TERM => sub { $self->handle_sig(@_) }, } ); } sub handle_sig { my $self = shift; my ($sig) = @_; eval { $_->signal($sig) } for grep { $_->can('signal') } @{$self->renderers}; print STDERR "\nCaught SIG$sig, forwarding signal to child processes...\n"; $self->ipc->killall($sig); if ($self->{+SIGNAL}) { print STDERR "\nSecond signal ($self->{+SIGNAL} followed by $sig), exiting now without waiting\n"; exit 1; } $self->{+SIGNAL} = $sig; } sub monitor_preloads { 0 } sub run { my $self = shift; my $settings = $self->settings; my $plugins = $self->settings->harness->plugins; if ($self->start()) { $self->render(); $self->stop(); my $final_data = $self->{+FINAL_DATA} or die "Final data never received from auditor!\n"; my $pass = $self->{+TESTS_SEEN} && $final_data->{pass}; $self->render_final_data($final_data); $self->produce_summary($pass); if (@$plugins) { my %args = ( settings => $settings, final_data => $final_data, pass => $pass ? 1 : 0, tests_seen => $self->{+TESTS_SEEN} // 0, asserts_seen => $self->{+ASSERTS_SEEN} // 0, ); $_->finish(%args) for @$plugins; } return $pass ? 0 : 1; } $self->stop(); return 1; } sub DESTROY { my $self = shift; local ($?, $!, $@, $_); my $cleanup = delete $self->{+CLEANUP_SUBS} or return; for my $sub (@$cleanup) { eval { $sub->(); 1 } or warn $@; } } sub write_test_info { my $self = shift; return if $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO}; my $info_file = "./.test_info.$$.json"; my $workdir = $self->workdir; Test2::Harness::Util::File::JSON->new(name => $info_file)->write({ workdir => $self->workdir, job_count => $self->job_count, }); push @{$self->{+CLEANUP_SUBS}} => sub { return unless -e $info_file; return unless Test2::Harness::Util::File::JSON->new(name => $info_file)->read->{workdir} eq $workdir; unlink($info_file) or die "Could not unlink info file: $!"; }; $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} = 1; } sub start { my $self = shift; $self->ipc->start(); $self->parse_args; # Before anything is spawned: an unparseable value croaks, and dying out of # start_auditor would leave the runner and collector already running. $self->stall_detector; $self->write_settings_to($self->workdir, 'settings.json'); $self->write_test_info(); my $pop = $self->populate_queue(); $self->terminate_queue(); return unless $pop; $self->setup_plugins(); $self->setup_resources(); $self->start_runner(jobs_todo => $pop); $self->start_collector(); $self->start_auditor(); return 1; } sub render { my $self = shift; my $ipc = $self->ipc; my $settings = $self->settings; my $renderers = $self->renderers; my $logger = $self->logger; my $plugins = $self->settings->harness->plugins; my $handle_plugins = [grep { $_->can('handle_event') } @$plugins]; my $annotate_plugins = [grep { $_->can('annotate_event') } @$plugins]; # render results from log my $reader = $self->renderer_reader(); $reader->blocking(0); my $buffer; while (1) { return if $self->{+SIGNAL}; $_->step for @{$renderers}; $self->check_stall(); # A non-blocking handle returns undef both when no data has arrived # yet and when the writers are all gone; only errno tells them apart. # Clear it first: a read answered from PerlIO's cached EOF flag issues # no syscall and leaves whatever errno step() or wait() above set. # Do not use eof(), it reports true for an empty pipe whose writer is # still alive. $! = 0; my $line = <$reader>; unless(defined $line) { last unless $!{EAGAIN} || $!{EWOULDBLOCK} || $!{EINTR}; $ipc->wait() if $ipc; sleep 0.02; next; } if ($buffer) { $line = $buffer . $line; $buffer = undef; } unless (substr($line, -1, 1) eq "\n") { $buffer //= ""; $buffer .= $line; next; } my $e = decode_json($line); if (defined $e) { bless($e, 'Test2::Harness::Event'); my $fd = $e->{facet_data} //= {}; my $changed = 0; for my $p (@$annotate_plugins) { my %inject = $p->annotate_event($e, $settings); # A plugin that altered facets already on the event says so, # otherwise the log would keep the line as it arrived. $changed++ if delete $inject{-rewrite}; next unless keys %inject; $changed++; # Can add new facets, but not modify existing ones. # Someone could force the issue by modifying the event directly # inside 'annotate_event', this is not supported, but also not # forbidden, user beware. for my $f (keys %inject) { if (exists $fd->{$f}) { if ('ARRAY' eq ref($fd->{$f})) { push @{$fd->{$f}} => @{$inject{$f}}; } else { warn "Plugin '$p' tried to add facet '$f' via 'annotate_event()', but it is already present and not a list, ignoring plugin annotation.\n"; } } else { $fd->{$f} = $inject{$f}; } } } if ($logger) { if ($changed) { my $newline = $e->as_json; print $logger $newline, "\n"; } else { print $logger $line; } } } else { last; } if (my $final = $e->{facet_data}->{harness_final}) { $self->{+FINAL_DATA} = $final; } $_->render_event($e) for @$renderers; $self->{+TESTS_SEEN}++ if $e->{facet_data}->{harness_job_launch}; $self->{+ASSERTS_SEEN}++ if $e->{facet_data}->{assert}; $_->handle_event($e, $settings) for @$handle_plugins; $ipc->wait() if $ipc; } # Anything still buffered at EOF is a fragment of an event that was never # completed, so it cannot be parsed. Report it, do not feed it to the JSON # parser, which dies on invalid input. if (defined($buffer) && length($buffer)) { # An event can carry a whole test's output, so an incomplete one can # be large. Show enough to identify it. my $partial = length($buffer) > 200 ? substr($buffer, 0, 200) . "... (truncated)" : $buffer; print STDERR "\nyath: Incomplete event discarded when the event stream ended: $partial\n"; } return; } sub get_job_pid { my $self = shift; my ($run_id, $job_id) = @_; return undef unless $run_id && $job_id; my $run_dir = File::Spec->catdir($self->workdir, $run_id); my $jobs_file = File::Spec->catfile($run_dir, 'jobs.jsonl'); return undef unless -f $jobs_file; my $queue = Test2::Harness::Util::Queue->new(file => $jobs_file); my $found; for my $item ($queue->poll) { my $task = $item->[-1]; next unless $task->{job_id} && $task->{job_id} eq $job_id; $found = $task; } return undef unless $found; return $found->{pid} // undef; } sub stop { my $self = shift; my $settings = $self->settings; my $renderers = $self->renderers; my $logger = $self->logger; $self->teardown_plugins($renderers, $logger); if ($logger) { print $logger "null\n"; close($logger); } $_->finish() for @$renderers; my $ipc = $self->ipc; print STDERR "Waiting for child processes to exit...\n" if $self->{+SIGNAL}; if ($self->{+SIGNAL}) { my $state = $self->state; delete $state->{no_poll}; $state->poll; my $running = $state->running_tasks; $state->halt_run($self->{+RUN_ID}); for my $task (values %$running) { next unless $task->{run_id} && $task->{run_id} eq $self->{+RUN_ID}; my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // next; my $file = $task->{rel_file}; print "Killing test $pid - $file...\n"; kill('INT', USE_P_GROUPS ? -$pid : $pid); } } $ipc->wait(all => 1); $ipc->stop; unless ($settings->display->quiet > 2) { printf STDERR "\nNo tests were seen!\n" unless $self->{+TESTS_SEEN}; printf("\nKeeping work dir: %s\n", $self->workdir) if $settings->debug->keep_dirs; if ($settings->logging->log) { print "\n"; print "Wrote log file: " . $settings->logging->log_file . "\n"; print " (Symlinked to: " . $self->{+LAST_LOG} . ")\n"; } $self->finalize_plugins(); } } sub terminate_queue { my $self = shift; $self->tasks_queue->end(); $self->state->end_queue(); } sub build_run { my $self = shift; return $self->{+RUN} if $self->{+RUN}; my $settings = $self->settings; my $dir = $self->workdir; my $run = $settings->build(run => 'Test2::Harness::Run'); mkdir($run->run_dir($dir)) or die "Could not make run dir: $!"; chmod_tmp($dir); return $self->{+RUN} = $run; } sub state { my $self = shift; $self->{+STATE} //= Test2::Harness::Runner::State->new( workdir => $self->workdir, job_count => $self->job_count, no_poll => 1, ); } sub job_count { my $self = shift; return $self->settings->runner->job_count; } sub run_queue { my $self = shift; my $dir = $self->workdir; return $self->{+RUN_QUEUE} //= Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'run_queue.jsonl')); } sub tasks_queue { my $self = shift; $self->{+TASKS_QUEUE} //= Test2::Harness::Util::Queue->new( file => File::Spec->catfile($self->build_run->run_dir($self->workdir), 'queue.jsonl'), ); } sub finder_args {()} sub populate_queue { my $self = shift; my $run = $self->build_run(); $self->{+RUN_ID} = $run->run_id; my $settings = $self->settings; my $finder = $settings->build(finder => $settings->finder->finder, $self->finder_args); my $state = $self->state; my $tasks_queue = $self->tasks_queue; my $plugins = $settings->harness->plugins; $state->queue_run($run->queue_item($plugins)); my @files = @{$finder->find_files($plugins, $self->settings)}; for my $plugin (@$plugins) { if ($plugin->can('sort_files_2')) { @files = $plugin->sort_files_2(settings => $settings, files => \@files); } elsif ($plugin->can('sort_files')) { @files = $plugin->sort_files(@files); } } my $job_count = 0; for my $file (@files) { my $task = $file->queue_item(++$job_count, $run->run_id, $settings->check_prefix('display') ? (verbose => $settings->display->verbose) : (), ); $task->{category} = 'isolation' if $settings->debug->interactive; $state->queue_task($task); $tasks_queue->enqueue($task); } $state->stop_run($run->run_id); return $job_count; } sub produce_summary { my $self = shift; my ($pass) = @_; my $settings = $self->settings; my $time_data = { start => $settings->harness->start, stop => time(), }; $time_data->{wall} = $time_data->{stop} - $time_data->{start}; my @times = times(); @{$time_data}{qw/user system cuser csystem/} = @times; $time_data->{cpu} = sum @times; my $cpu_usage = int($time_data->{cpu} / $time_data->{wall} * 100); $self->write_summary($pass, $time_data, $cpu_usage); $self->render_summary($pass, $time_data, $cpu_usage); } sub write_summary { my $self = shift; my ($pass, $time_data, $cpu_usage) = @_; my $file = $self->settings->debug->summary or return; my $final_data = $self->{+FINAL_DATA}; my $failures = @{$final_data->{failed} // []}; my %data = ( %$final_data, pass => $pass ? JSON->true : JSON->false, total_failures => $failures // 0, total_tests => $self->{+TESTS_SEEN} // 0, total_asserts => $self->{+ASSERTS_SEEN} // 0, cpu_usage => $cpu_usage, times => $time_data, ); require Test2::Harness::Util::File::JSON; my $jfile = Test2::Harness::Util::File::JSON->new(name => $file); $jfile->write(\%data); print "\nWrote summary file: $file\n\n"; return; } sub render_summary { my $self = shift; my ($pass, $time_data, $cpu_usage) = @_; return if $self->settings->display->quiet > 1; my $final_data = $self->{+FINAL_DATA}; my $failures = @{$final_data->{failed} // []}; my @summary = ( $failures ? (" Fail Count: $failures") : (), " File Count: $self->{+TESTS_SEEN}", "Assertion Count: $self->{+ASSERTS_SEEN}", $time_data ? ( sprintf(" Wall Time: %.2f seconds", $time_data->{wall}), sprintf(" CPU Time: %.2f seconds (usr: %.2fs | sys: %.2fs | cusr: %.2fs | csys: %.2fs)", @{$time_data}{qw/cpu user system cuser csystem/}), sprintf(" CPU Usage: %i%%", $cpu_usage), ) : (), ); my $res = " --> Result: " . ($pass ? 'PASSED' : 'FAILED') . " <--"; if ($self->settings->display->color && USE_ANSI_COLOR) { my $color = $pass ? Term::ANSIColor::color('bold bright_green') : Term::ANSIColor::color('bold bright_red'); my $reset = Term::ANSIColor::color('reset'); $res = "$color$res$reset"; } push @summary => $res; my $msg = "Yath Result Summary"; my $length = max map { length($_) } @summary; my $prefix = ($length - length($msg)) / 2; print "\n"; print " " x $prefix; print "$msg\n"; print "-" x $length; print "\n"; print join "\n" => @summary; print "\n"; } sub render_final_data { my $self = shift; my ($final_data) = @_; return if $self->settings->display->quiet > 1; return $self->_render_final_data_plainly($final_data) if $self->settings->display->no_final_table; if (my $rows = $final_data->{retried}) { print "\nThe following jobs failed at least once:\n"; print join "\n" => table( header => ['Job ID', 'Times Run', 'Test File', "Succeeded Eventually?"], rows => $rows, ); print "\n"; } if (my $rows = $final_data->{failed}) { print "\nThe following jobs failed:\n"; print join "\n" => table( collapse => 1, header => ['Job ID', 'Test File', 'Subtests'], rows => [map { my $r = [@{$_}]; $r->[2] = stringify_subtest_map($r->[2]) if $r->[2]; $r} @$rows], ); print "\n"; } if (my $rows = $final_data->{halted}) { print "\nThe following jobs requested all testing be halted:\n"; print join "\n" => table( header => ['Job ID', 'Test File', "Reason"], rows => $rows, ); print "\n"; } if (my $rows = $final_data->{unseen}) { print "\nThe following jobs never ran:\n"; print join "\n" => table( header => ['Job ID', 'Test File'], rows => $rows, ); print "\n"; } } sub _render_final_data_plainly { my $self = shift; my ($final_data) = @_; return if $self->settings->display->quiet > 1; if (my $rows = $final_data->{retried}) { print "\nThe following jobs failed at least once:\n"; for my $row (@$rows) { print "- filename: $row->[2]\n"; print " job_id: $row->[0]\n"; print " times_run: $row->[1]\n"; print " succeeded_eventually: $row->[3]\n"; } } if (my $rows = $final_data->{failed}) { print "\nThe following jobs failed:\n"; for my $row (@$rows) { print "- filename: $row->[1]\n"; print " job_id: $row->[0]\n"; if ($row->[2]) { print " subtests:\n"; my @paths = _subtest_paths($row->[2]); print " - $_\n" for @paths; } } } if (my $rows = $final_data->{halted}) { print "\nThe following jobs requested all testing be halted:\n"; for my $row (@$rows) { print "- filename: $row->[1]\n"; print " job_id: $row->[0]\n"; print " reason: $row->[2]\n" if $row->[2]; } } if (my $rows = $final_data->{unseen}) { print "\nThe following jobs never ran:\n"; for my $row (@$rows) { print "- filename: $row->[1]\n"; print " job_id: $row->[0]\n"; } } } sub _subtest_paths { my ($map) = @_; my @paths; my @todo = @$map; my @state; while (my $st = shift @todo) { if (!ref($st)) { pop @state if $st eq 'pop'; next; } push @state, $st->[0]; push @paths, join(' -> ', @state); unshift @todo, (@{$st->[1]}, 'pop'); } return @paths; } sub stringify_subtest_map { my ($map) = @_; my $out = ""; my @todo = @$map; my @state; while (my $st = shift @todo) { if (!ref($st)) { pop @state if $st eq 'pop'; next; } push @state => $st->[0]; $out .= join(' -> ' => @state) . "\n"; unshift @todo => (@{$st->[1]}, 'pop'); } return $out; } sub logger { my $self = shift; return $self->{+LOGGER} if $self->{+LOGGER}; my $settings = $self->{+SETTINGS}; return unless $settings->logging->log; my $file = $settings->logging->log_file; if ($settings->logging->bzip2) { no warnings 'once'; require IO::Compress::Bzip2; $self->{+LOGGER} = IO::Compress::Bzip2->new($file) or die "Could not open log file '$file': $IO::Compress::Bzip2::Bzip2Error"; } elsif ($settings->logging->gzip) { no warnings 'once'; require IO::Compress::Gzip; $self->{+LOGGER} = IO::Compress::Gzip->new($file) or die "Could not open log file '$file': $IO::Compress::Gzip::GzipError"; } else { $self->{+LOGGER} = open_file($file, '>'); } for my $ext ('jsonl', 'jsonl.bz2', 'jsonl.gz') { my $name = "./lastlog.$ext"; next unless -f $name; local ($!, $@) = (0, ''); eval { unlink($name) } or warn "Could not unlink '$name': ($!) $@"; } if ($file =~ m/\.(jsonl(?:\.(?:bz2|gz))?)$/) { my $ext = $1; my $name = "./lastlog.$ext"; if (eval { symlink($file, $name); 1 }) { $self->{+LAST_LOG} = $name; } else { warn "Could not symlink the log file to '$name': $@"; } } return $self->{+LOGGER}; } sub renderers { my $self = shift; return $self->{+RENDERERS} if $self->{+RENDERERS}; my $settings = $self->{+SETTINGS}; my @renderers; for my $class (@{$settings->display->renderers->{'@'}}) { require(mod2file($class)); my $args = $settings->display->renderers->{$class}; my $renderer = $class->new(@$args, settings => $settings, command_class => ref($self)); push @renderers => $renderer; } return $self->{+RENDERERS} = \@renderers; } sub start_auditor { my $self = shift; my $run = $self->build_run(); my $settings = $self->settings; my $ipc = $self->ipc; $ipc->spawn( stdin => $self->auditor_reader(), stdout => $self->auditor_writer(), no_set_pgrp => 1, command => [ $^X, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules auditor => 'Test2::Harness::Auditor', $run->run_id, procname_prefix => $settings->debug->procname_prefix, $self->stall_detector ? (stall_dir => File::Spec->catdir($self->workdir, 'stall')) : (), ], ); close($self->auditor_writer()); } # Off unless --stall-report was given. Only 'yath test' and the commands that # own their runner get one; App::Yath::Command::run overrides this, since its # runner is a persistent one it did not start and may be shared with other # sessions. sub stall_reporting { 1 } sub stall_detector { my $self = shift; return $self->{+STALL_DETECTOR} if exists $self->{+STALL_DETECTOR}; $self->{+STALL_DETECTOR} = undef; return undef unless $self->stall_reporting; my $settings = $self->settings; return undef unless $settings->check_prefix('runner'); my %spec = Test2::Harness::Stall::Detector->parse_spec($settings->runner->stall_report) or return undef; return $self->{+STALL_DETECTOR} = Test2::Harness::Stall::Detector->new( %spec, workdir => $self->workdir, job_count => $self->job_count, ); } sub check_stall { my $self = shift; my $detector = $self->stall_detector or return; # Diagnostics must never be able to end a healthy run, so nothing here is # allowed to escape. my $ok = eval { $self->report_stall($detector); 1 }; warn $@ unless $ok; return; } sub report_stall { my $self = shift; my ($detector) = @_; my $found = $detector->check or return; # Rooted at this process, so the tree covers the runner and its children # plus the collector and auditor, which are children of this process. my $capture = Test2::Harness::Stall::Capture->new( workdir => $self->workdir, root_pid => $$, ); my @pids = grep { $_ } $self->runner_pid, $found->{scheduler_pid}, values %{$found->{stage_pids} // {}}; push @pids => keys %{$self->ipc->procs // {}} if $self->ipc; my %seen; my $bundle = $capture->collect({ %$found, state => undef, tasks => undef, harness_pids => [grep { $_ > 0 && !$seen{$_}++ } @pids], }); my $report = Test2::Harness::Stall::Report->new( workdir => $self->workdir, run_id => $self->{+RUN_ID}, report_dir => $self->settings->runner->stall_report_dir, ); $bundle->{state_summary} = $report->state_summary($found->{state}, $found->{tasks}); $report->emit($bundle); return; } sub collector_options { () } sub start_collector { my $self = shift; my $dir = $self->workdir; my $run = $self->build_run(); my $settings = $self->settings; my $runner_pid = $self->runner_pid; my ($rh, $wh); pipe($rh, $wh) or die "Could not create pipe"; my %options = (show_runner_output => 1); if ($settings->check_prefix('display')) { $options{show_runner_output} = $settings->display->hide_runner_output ? 0 : 1; $options{truncate_runner_output} = $settings->display->truncate_runner_output; } %options = ( %options, $self->collector_options(), ); my $ipc = $self->ipc; $ipc->spawn( stdout => $self->collector_writer, stdin => $rh, no_set_pgrp => 1, command => [ $^X, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules collector => 'Test2::Harness::Collector', $dir, $run->run_id, $runner_pid, %options, ], ); close($rh); print $wh encode_json($run) . "\n"; close($wh); close($self->collector_writer()); } sub start_runner { my $self = shift; my %args = @_; $args{monitor_preloads} //= $self->monitor_preloads; my $settings = $self->settings; my $dir = $settings->workspace->workdir; my @prof; if ($settings->runner->nytprof) { push @prof => '-d:NYTProf'; } my $ipc = $self->ipc; my $proc = $ipc->spawn( stderr => File::Spec->catfile($dir, 'error.log'), stdout => File::Spec->catfile($dir, 'output.log'), env_vars => { @prof ? (NYTPROF => 'start=no:addpid=1') : () }, no_set_pgrp => 1, command => [ $^X, @prof, $self->spawn_args($settings), $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules runner => $dir, %args, ], ); $self->{+RUNNER_PID} = $proc->pid; return $proc; } sub parse_args { my $self = shift; my $settings = $self->settings; my $args = $self->args; my $dest = $settings->finder->search; for my $arg (@$args) { next if $arg eq '--'; if ($arg eq '::') { $dest = $settings->run->test_args; next; } push @$dest => $arg; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::test - Run tests =head1 DESCRIPTION This yath command (which is also the default command) will run all the test files for the current project. If no test files are specified this command will look for the 't', and 't2' directories, as well as the 'test.pl' file. This command is always recursive when given directories. This command will add 'lib', 'blib/arch' and 'blib/lib' to the perl path for you by default (after any -I's). You can specify -l if you just want lib, -b if you just want the blib paths. If you specify both -l and -b both will be added in the order you specify (order relative to any -I options will also be preserved. If you do not specify they will be added in this order: -I's, lib, blib/lib, blib/arch. You can also add --no-lib and --no-blib to avoid both. Any command line argument that is not an option will be treated as a test file or directory of test files to be run. If you wish to specify the ARGV for tests you may append them after '::'. This is mainly useful for Test::Class::Moose and similar tools. EVERY test run will get the same ARGV. =head1 USAGE $ yath [YATH OPTIONS] test [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --fail-on-resource-skip =item --no-fail-on-resource-skip Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C<YATH_JOB_COUNT>, C<T2_HARNESS_JOB_COUNT>, C<HARNESS_JOB_COUNT> =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource-timeout SECONDS =item --rt SECONDS =item --no-resource-timeout Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout) =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C<T2_HARNESS_JOB_CONCURRENCY> =item --stall-report =item --stall-report=STRONG:LOOSE =item --stall-report=SECONDS =item --no-stall-report Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath's own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200) =item --stall-report-dir path/to/dir =item --no-stall-report-dir Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable. =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C<PERL_USE_UNSAFE_INC> =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C<!T2_NO_FORK>, C<T2_HARNESS_FORK>, C<!T2_HARNESS_NO_FORK>, C<YATH_FORK>, C<!YATH_NO_FORK> =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C<T2_HARNESS_TEMP_DIR>, C<YATH_TEMP_DIR>, C<TMPDIR>, C<TEMPDIR>, C<TMP_DIR>, C<TEMP_DIR> =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C<T2_WORKDIR>, C<YATH_WORKDIR> =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������Cover.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 52667�15267772575� 22105� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Plugin�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Cover; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::JSON qw/encode_json stream_json_l/; use Test2::Harness::Util::UUID qw/gen_uuid/; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-aggregator -no_aggregate +metrics +outfile +exclude_roots +path_cache/; use App::Yath::Options; option_group {prefix => 'cover', category => "Cover Options"} => sub { post \&post_process; option types => ( alt => ['cover-type'], type => 'm', default => sub { [qw/pl pm/] }, ); option dirs => ( alt => ['cover-dir'], type => 'm', default => sub { ['lib'] }, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; push @$$slot => glob($norm); }, ); option exclude_dirs => ( alt => ['cover-exclude-dir'], type => 'm', description => "Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma.", action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; for my $path (map { clean_path($_) } glob($norm)) { # The resolved path is what gets transmitted, so a comma in an # ancestor directory breaks a value that had none of its own. if ($path =~ m/,/) { my $from = $path eq $raw ? "" : " (from '$raw')"; die "--cover-exclude-dirs cannot use a path containing a comma. '$path'$from has one. Coverage plugin arguments reach each test as a comma separated list, so such a path cannot survive.\n"; } $handler->($slot, $path); } }, ); option exclude_private => ( type => 'b', default => 0, description => "", ); option files => ( type => 'b', description => "Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference)", ); option metrics => ( type => 'b', description => '', ); option write => ( type => 'd', normalize => \&clean_path, long_examples => ['', '=coverage.jsonl', '=coverage.json'], description => "Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files).", action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path("coverage.jsonl") if $raw eq '1'; return $$slot = $norm; }, ); option aggregator => ( alt => ['cover-agg'], type => 's', long_examples => [' ByTest', ' ByRun', ' +Custom::Aggregator'], description => 'Choose a custom aggregator subclass', normalize => sub { my ($agg) = @_; return $agg if $agg =~ s/^\+//; return "Test2::Harness::Log::CoverageAggregator::$agg"; }, ); option class => ( type => 's', description => 'Choose a Test2::Plugin::Cover subclass', default => 'Test2::Plugin::Cover', ); option manager => ( type => 's', description => "Coverage 'from' manager to use when coverage data does not provide one", long_examples => [' My::Coverage::Manager'], applicable => \&changes_applicable, ); option from_type => ( type => 's', description => 'File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run.', long_examples => [' json', ' jsonl', ' log'], ); option maybe_from_type => ( type => 's', 'description' => 'Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect', long_examples => [' json', ' jsonl', ' log'], ); option from => ( type => 's', description => "This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid.", long_examples => [' path/to/log.jsonl', ' http://example.com/coverage', ' path/to/coverage.jsonl'] ); option maybe_from => ( type => 's', description => "This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid.", long_examples => [' path/to/log.jsonl', ' http://example.com/coverage', ' path/to/coverage.jsonl'] ); }; sub changes_applicable { my ($option, $options) = @_; # Cannot use this options with projects return 0 if $options->command_class && $options->command_class->isa('App::Yath::Command::projects'); return 1; } sub spawn_args { my $self = shift; my ($settings) = @_; return () unless $settings->cover->files || $settings->cover->metrics || $settings->cover->write; my $class = $settings->cover->class; return ('-M' . $class . '=disabled,1'); } sub post_process { my %params = @_; my $settings = $params{settings}; my $cover = $settings->cover; if ($cover->files || $cover->write || $cover->metrics) { my $cover_class = $cover->class // 'Test2::Plugin::Cover'; eval { require(mod2file($cover_class)); 1 } or die "Could not enable file coverage, could not load '$cover_class': $@"; # Older versions accept the 'exclude' parameter and ignore it, which # would record an excluded tree while reporting success. eval { $cover_class->VERSION('0.000029'); 1 } or die "Could not enable file coverage: $@"; push @{$settings->run->load_import->{'@'}} => $cover_class; # Repeated pairs, not a single arrayref: this list is joined with # commas into a -M argument for tests that do not run under a preload. $settings->run->load_import->{$cover_class} = [map { (exclude => $_) } @{$cover->exclude_dirs // []}]; } } sub annotate_event { my $self = shift; return if $self->{+NO_AGGREGATE}; my ($e, $settings) = @_; unless ($self->{+AGGREGATOR}) { my $do_cover = $settings->cover->files; my $file = $settings->cover->write; my $metrics = $settings->cover->metrics; unless ($file || $metrics || $do_cover) { $self->{+NO_AGGREGATE} = 1; return; } my $agg = $settings->cover->aggregator; if (!$agg) { if ($file) { if ($file =~ m/\.json$/) { $agg = 'Test2::Harness::Log::CoverageAggregator::ByRun'; } elsif ($file =~ m/\.jsonl$/) { $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } } else { $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } } my $encode; if ($agg eq 'Test2::Harness::Log::CoverageAggregator::ByRun') { $encode = \&encode_json; } elsif ($agg eq 'Test2::Harness::Log::CoverageAggregator::ByTest') { $encode = sub { encode_json($_[0]) . "\n" }; } require(mod2file($agg)); $self->{+AGGREGATOR} = $agg->new( $file ? (file => $file) : (), $encode ? (encode => $encode) : (), ); } my $fd = $e->{facet_data}; my @out; # A process yath did not launch can still emit coverage into a job's event # stream without ever seeing the exclusions. This is the one point every # coverage event passes through, so the exclusions are applied again here. $self->_filter_coverage($fd->{coverage}, $settings) if $fd->{coverage}; if ($fd->{coverage} || $fd->{harness_job_end} || $fd->{harness_job_start}) { if (my $list = $self->{+AGGREGATOR}->process_event($e)) { die "Aggregator flushed without a job end!" unless $fd->{harness_job_end}; die "Aggregator flushed more than 1 job!" unless @$list == 1; push @out => (job_coverage => {details => 'Job Coverage', manager => $list->[0]->{manager}, files => $list->[0]->{files}, test => $list->[0]->{test}}); } } # The aggregator has taken what it needs, and the file map is reproduced in # the job or run coverage data it produces, so sending it onward costs # bandwidth and storage for a copy nothing reads. push @out => (-rewrite => 1) if $fd->{coverage} && $self->_collapse_coverage($fd); if ($fd->{harness_final}) { my $cover = $settings->cover; my $aggregator = $self->{+AGGREGATOR} or return; my $metrics; $metrics = $self->metrics($settings) if $cover->metrics; my $final = $aggregator->finalize(); my $percentages = $self->_percentages($metrics); my $raw = join ", ", map { "$_->[0]: $_->[2]/$_->[1] ($_->[3])" } @$percentages; my $details = join ", ", map { "$_->[0] $_->[3]" } @$percentages; $details = "coverage metrics" unless length $details; push @out => ( run_fields => [ {name => 'coverage', details => $details, data => $metrics, $raw ? (raw => $raw) : ()}, ], ); push @out => ( run_coverage => { details => 'Run Coverage', files => $final->[0]->{files}, testmeta => $final->[0]->{testmeta}, }, ) if $final && @$final; } return @out; } sub _exclude_roots { my $self = shift; my ($settings) = @_; return $self->{+EXCLUDE_ROOTS} if exists $self->{+EXCLUDE_ROOTS}; my $dirs = $settings->cover->exclude_dirs; return $self->{+EXCLUDE_ROOTS} = ($dirs && @$dirs) ? [map { clean_path($_) } @$dirs] : undef; } # Coverage paths are relative to the root the producer measured against, which # it names in the facet. A producer may choose that root deliberately, so the # keys are left exactly as reported; the root is used only to work out which # file each key names, so an exclusion can be applied without guessing. sub _filter_coverage { my $self = shift; my ($coverage, $settings) = @_; my $files = $coverage->{files}; return unless $files && ref($files) eq 'HASH'; my $exclude = $self->_exclude_roots($settings) or return; my $root = $coverage->{root}; # Coverage names the same files for every test, so resolving each one once # for the whole run keeps this off the event loop's critical path. my $cache = $self->{+PATH_CACHE} //= {}; for my $file (keys %$files) { # A custom filter may return an absolute path, which needs no root. my $path = $cache->{($root // '') . "\0" . $file} //= clean_path((defined($root) && !File::Spec->file_name_is_absolute($file)) ? "$root/$file" : $file); next unless $self->_excluded($path, $exclude); # An older producer that does not name its root has been assumed to # share the run root. Act on that guess only when a file is actually # there. next unless defined($root) || -e $path; delete $files->{$file}; } return; } sub _excluded { my $self = shift; my ($path, $exclude) = @_; for my $root (@$exclude) { return 1 if $path eq $root; return 1 if index($path, "$root/") == 0; } return 0; } sub _collapse_coverage { my $self = shift; my ($fd) = @_; my $coverage = $fd->{coverage}; my $files = $coverage->{files}; return 0 unless $files && ref($files) eq 'HASH'; my $file_count = keys %$files; # '*' is code outside any sub and '<>' is a file that was only opened, # neither is a subroutine. my $sub_count = 0; for my $file (keys %$files) { $sub_count += grep { $_ ne '*' && $_ ne '<>' } keys %{$files->{$file} // {}}; } my $details = "This test covered $file_count source files."; $coverage->{file_count} = $file_count; $coverage->{sub_count} = $sub_count; $coverage->{details} = $details; $coverage->{files} = "Removed, reproduced in the aggregated coverage data"; # These were counted before anything was excluded. $fd->{about}->{details} = $details if $fd->{about} && $fd->{about}->{details}; for my $info (@{$fd->{info} // []}) { next unless ($info->{tag} // '') eq 'COVERAGE'; $info->{details} = $details; } return 1; } sub metrics { my $self = shift; my ($settings) = @_; my $cover = $settings->cover; return unless $cover->metrics; my $aggregator = $self->{+AGGREGATOR}; return $self->{+METRICS} //= $aggregator->build_metrics( dirs => $cover->dirs, types => $cover->types, exclude_private => $cover->exclude_private, exclude_dirs => $cover->exclude_dirs, ); } sub _percentages { my $self = shift; my ($metrics) = @_; return unless $metrics; my @out; for my $metric (sort keys %$metrics) { next if $metric eq 'untested'; my $data = $metrics->{$metric} or next; my ($total, $tested) = @{$data}{qw/total tested/}; push @out => [$metric, $total, $tested, $total ? (int(($tested / $total) * 100) . '%') : '100%']; } return \@out; } sub finalize { my $self = shift; my ($settings) = @_; my $cover = $settings->cover; my $file = $cover->write; my $metrics = $cover->metrics; return unless $file || $metrics; print "\nCoverage:\n"; my $aggregator = $self->{+AGGREGATOR}; if ($metrics) { my $data = $self->metrics($settings); require Term::Table; my $table = Term::Table->new( header => [qw/METRIC TOTAL TESTED PERCENTAGE/], rows => $self->_percentages($data), ); print map { "$_\n" } $table->render; } print "Wrote coverage file: $file\n" if $file; print "\n"; } sub _deduce_content_type { my ($path, $type) = @_; if ($type) { if ($type eq 'json') { return { content_type => 'application/json', parser => 'json', format => $type, }; } elsif ($type eq 'jsonl' || $type eq 'log') { return { content_type => 'application/jsonl', parser => 'jsonl', format => $type, }; } } if ($path =~ m/\.jsonl/) { return { content_type => 'application/jsonl', parser => 'jsonl', format => undef, }; } if ($path =~ m/\.json/) { return { content_type => 'application/json', parser => 'json', format => undef, }; } return {}; } sub get_coverage_tests { my $self = shift; my ($settings, $changes) = @_; my $cover = $settings->cover; my $from = $cover->from; my $maybe = $cover->maybe_from; return unless $from || $maybe; if ($maybe) { my $type_data = $self->_deduce_content_type($maybe, $cover->maybe_from_type); my @out; my $ok = eval { @out = $self->_get_coverage_tests($settings, $changes, $maybe, $type_data); 1 }; my $err = $@; return @out if $ok; warn "Could not get coverage from '$maybe', continuing anyway... error was: $err"; } return $self->_get_coverage_tests($settings, $changes, $from) if $from; return; } sub _get_coverage_tests { my $self = shift; my ($settings, $changes, $source, $type_data) = @_; my @out; stream_json_l( $source => sub { push @out => $self->coverage_handler($settings, $changes, $type_data, @_) }, $type_data->{content_type} ? (http_args => [{headers => {'Content-Type' => $type_data->{content_type}}}]) : (), ); return @out; } sub coverage_handler { my $self = shift; my ($settings, $changes, $type_data, $set, $res) = @_; return unless $set; my ($agg, $data); if (my $fd = $set->{facet_data}) { if ($data = $fd->{job_coverage}) { require 'Test2/Harness/Log/CoverageAggregator/ByTest.pm' unless $INC{'Test2/Harness/Log/CoverageAggregator/ByTest.pm'}; $agg = 'Test2::Harness::Log::CoverageAggregator::ByTest'; } elsif ($data = $fd->{run_coverage}) { require 'Test2/Harness/Log/CoverageAggregator/ByRun.pm' unless $INC{'Test2/Harness/Log/CoverageAggregator/ByRun.pm'}; $agg = 'Test2::Harness::Log::CoverageAggregator::ByRun'; } else { return; } } else { $data = $set; $agg = $set->{aggregator} // return; my $aggfile = mod2file($agg); require($aggfile) unless $INC{$aggfile}; } return $agg->get_coverage_tests($settings, $changes, $data); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Cover - Plugin to collect and report basic coverage data =head1 DESCRIPTION Simple coverage data, file and sub coverage only. Use L<Devel::Cover> if you want deep coverage stats. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������Test2.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 52137�15267772575� 22101� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Formatter�����������������������������������������������������������������������������������������������������������������������������package Test2::Formatter::Test2; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Util::Term qw/term_size/; use Test2::Harness::Util qw/hub_truth apply_encoding/; use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; use Test2::Util qw/IS_WIN32 clone_io/; use Time::HiRes qw/time/; use IO::Handle; use File::Spec(); use Test2::Formatter::Test2::Composer; use parent 'Test2::Formatter'; sub import { my $class = shift; return if $ENV{HARNESS_ACTIVE}; $class->SUPER::import; } use Test2::Util::HashBase qw{ -composer -last_depth -_buffered <job_io +io <enc_io -_encoding -show_buffer -color -progress -tty -no_wrap -verbose -job_length -ecount -job_colors -active_files -_active_disp -_file_stats -job_names -is_persistent -interactive }; sub TAG_WIDTH() { 8 } sub hide_buffered() { 0 } sub DEFAULT_TAG_COLOR() { return ( 'DEBUG' => Term::ANSIColor::color('red'), 'DIAG' => Term::ANSIColor::color('yellow'), 'ERROR' => Term::ANSIColor::color('red'), 'FATAL' => Term::ANSIColor::color('bold red'), 'FAIL' => Term::ANSIColor::color('red'), 'HALT' => Term::ANSIColor::color('bold red'), 'PASS' => Term::ANSIColor::color('green'), '! PASS !' => Term::ANSIColor::color('cyan'), 'TODO' => Term::ANSIColor::color('cyan'), 'NO PLAN' => Term::ANSIColor::color('yellow'), 'SKIP' => Term::ANSIColor::color('bold cyan'), 'SKIP ALL' => Term::ANSIColor::color('bold white on_blue'), 'STDERR' => Term::ANSIColor::color('yellow'), 'RUN INFO' => Term::ANSIColor::color('bold bright_blue'), 'JOB INFO' => Term::ANSIColor::color('bold bright_blue'), 'LAUNCH' => Term::ANSIColor::color('bold bright_white'), 'RETRY' => Term::ANSIColor::color('bold bright_white'), 'PASSED' => Term::ANSIColor::color('bold bright_green'), 'TO RETRY' => Term::ANSIColor::color('bold bright_yellow'), 'FAILED' => Term::ANSIColor::color('bold bright_red'), 'REASON' => Term::ANSIColor::color('magenta'), 'TIMEOUT' => Term::ANSIColor::color('magenta'), 'TIME' => Term::ANSIColor::color('blue'), 'MEMORY' => Term::ANSIColor::color('blue'), ); } sub DEFAULT_FACET_COLOR() { return ( time => Term::ANSIColor::color('blue'), memory => Term::ANSIColor::color('blue'), about => Term::ANSIColor::color('magenta'), amnesty => Term::ANSIColor::color('cyan'), assert => Term::ANSIColor::color('bold bright_white'), control => Term::ANSIColor::color('bold red'), error => Term::ANSIColor::color('yellow'), info => Term::ANSIColor::color('yellow'), meta => Term::ANSIColor::color('magenta'), parent => Term::ANSIColor::color('magenta'), trace => Term::ANSIColor::color('bold red'), ); } # These colors all look decent enough to use, ordered to avoid putting similar ones together use constant DEFAULT_JOB_COLOR_NAMES => ( 'bold green on_blue', 'bold blue on_white', 'bold black on_cyan', 'bold green on_bright_black', 'bold dark blue on_white', 'bold black on_green', 'bold cyan on_blue', 'bold black on_white', 'bold white on_cyan', 'bold cyan on_bright_black', 'bold white on_green', 'bold bright_black on_white', 'bold white on_blue', 'bold bright_cyan on_green', 'bold blue on_cyan', 'bold white on_bright_black', 'bold bright_black on_green', 'bold bright_green on_blue', 'bold bright_blue on_white', 'bold bright_white on_bright_black', 'bold yellow on_blue', 'bold bright_black on_cyan', 'bold bright_green on_bright_black', 'bold blue on_green', 'bold bright_cyan on_blue', 'bold bright_blue on_cyan', 'bold dark bright_white on_bright_black', 'bold bright_blue on_green', 'bold dark bright_blue on_white', 'bold bright_white on_blue', 'bold bright_cyan on_bright_black', 'bold bright_white on_cyan', 'bold bright_white on_green', 'bold bright_yellow on_blue', #'bold magenta on_white', #'bold dark magenta on_white', #'bold dark cyan on_white', 'bold dark bright_cyan on_bright_black', #'bold dark bright_green on_black', #'bold dark bright_yellow on_black', ); sub DEFAULT_JOB_COLOR() { return map { Term::ANSIColor::color($_) } DEFAULT_JOB_COLOR_NAMES; } sub DEFAULT_COLOR() { return ( reset => Term::ANSIColor::color('reset'), blob => Term::ANSIColor::color('bold bright_black on_white'), tree => Term::ANSIColor::color('bold bright_white'), tag_border => Term::ANSIColor::color('bold bright_white'), ); } my %FACET_TAG_BORDERS = ( 'default' => ['[', ']'], 'amnesty' => ['{', '}'], 'info' => ['(', ')'], 'error' => ['<', '>'], 'parent' => [' ', ' '], ); sub init { my $self = shift; $self->{+COMPOSER} ||= Test2::Formatter::Test2::Composer->new; $self->{+VERBOSE} = 1 unless defined $self->{+VERBOSE}; $self->{+JOB_LENGTH} ||= 2; my $io = $self->{+IO} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!"; $io->autoflush(1); $self->{+TTY} = -t $io unless defined $self->{+TTY}; my $use_color = ref($self->{+COLOR}) ? 1 : delete($self->{+COLOR}); $use_color = $self->{+TTY} unless defined $use_color; if ($use_color && USE_ANSI_COLOR) { $self->{+SHOW_BUFFER} = 1 unless defined $self->{+SHOW_BUFFER}; if ($use_color) { $self->{+COLOR} = { DEFAULT_COLOR(), TAGS => {DEFAULT_TAG_COLOR()}, FACETS => {DEFAULT_FACET_COLOR()}, JOBS => [DEFAULT_JOB_COLOR()], } unless defined $self->{+COLOR}; $self->{+JOB_COLORS} = {free => [@{$self->{+COLOR}->{JOBS}}]}; } } else { $self->{+SHOW_BUFFER} = 0 unless defined $self->{+SHOW_BUFFER}; } $self->{+ECOUNT} //= 0; my $reset = $use_color ? Term::ANSIColor::color('reset') : ''; my $cyan = $use_color ? Term::ANSIColor::color('cyan') : ''; $self->{+_ACTIVE_DISP} = ["[${cyan}INITIALIZING${reset}]", '']; $self->{+_FILE_STATS} = { passed => 0, failed => 0, running => 0, todo => 0, total => 0, }; } sub io { my $self = shift; my ($job_id) = @_; return $self->{+IO} unless defined $job_id; return $self->{+JOB_IO}->{$job_id} // $self->{+IO}; } sub encoding { my $self = shift; if (@_) { my ($enc, $job_id) = @_; if (defined $job_id) { my $io; unless ($io = $self->{+ENC_IO}->{$enc}) { $io = $self->{+ENC_IO}->{$enc} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!"; $io->autoflush(1); apply_encoding($io, $enc); } $self->{+JOB_IO}->{$job_id} = $io; } else { apply_encoding($self->{+IO}, $enc); } $self->{+_ENCODING} = $enc; } return $self->{+_ENCODING}; } if ($^C) { no warnings 'redefine'; *write = sub {}; } sub write { my ($self, $e, $num, $f) = @_; $f ||= $e->facet_data; my $should_show = $self->update_active_disp($f); $self->{+ECOUNT}++; my $job_id = $f->{harness}->{job_id}; $self->encoding($f->{control}->{encoding}, $job_id) if $f->{control}->{encoding}; my $hf = hub_truth($f); my $depth = $hf->{nested} || 0; return if $depth && (!$self->{+SHOW_BUFFER} || !$self->{+PROGRESS}); my $lines; if (!$self->{+VERBOSE}) { if ($depth) { $lines = []; } else { $lines = $self->render_quiet($f); } } elsif ($depth) { my $tree = $self->render_tree($f, '>'); $lines = $self->render_buffered_event($f, $tree); } else { my $tree = $self->render_tree($f,); $lines = $self->render_event($f, $tree); } $should_show ||= $lines && @$lines; unless ($should_show || $self->{+VERBOSE}) { if (my $last = $self->{last_rendered}) { return if time - $last < 0.2; $self->{last_rendered} = time; } else { $self->{last_rendered} = time; } } push @{$self->{+JOB_COLORS}->{free}} => delete $self->{+JOB_COLORS}->{used}->{$job_id} if $job_id && $f->{harness_job_end}; # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $io = $self->io($job_id); if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } if (!$self->{+VERBOSE}) { print $io $_, "\n" for @$lines; if ($self->{+TTY} && $self->{+PROGRESS}) { print $io $self->render_status($f); $self->{+_BUFFERED} = 1; } } elsif ($depth && $lines && @$lines && !$self->{+INTERACTIVE}) { print $io $lines->[0]; $self->{+_BUFFERED} = 1; } else { print $io $_, "\n" for @$lines; } delete $self->{+JOB_IO}->{$job_id} if $job_id && $f->{harness_job_end}; } sub finalize { my $self = shift; my $io = $self->{+IO}; print $io "\r\e[K" if $self->{+_BUFFERED}; return; } sub step { my $self = shift; return unless $self->update_active_disp; my $io = $self->io(0); if ($self->{+_BUFFERED}) { print $io "\r\e[K"; $self->{+_BUFFERED} = 0; } if ($self->{+TTY} && $self->{+PROGRESS}) { print $io $self->render_status(); $self->{+_BUFFERED} = 1; } } sub update_active_disp { my $self = shift; my ($f) = @_; my $should_show = 0; my $stats = $self->{+_FILE_STATS}; my $out = 0; $out = $self->update_spinner($stats) unless $stats->{started}; return $out unless $f; if (my $task = $f->{harness_job_queued}) { $self->{+JOB_NAMES}->{$task->{job_id}} = $task->{job_name} || $task->{job_id}; $stats->{total}++; $stats->{todo}++; } if ($f->{harness_job_launch}) { my $job = $f->{harness_job}; $self->{+ACTIVE_FILES}->{File::Spec->abs2rel($job->{file})} = $job->{job_name} || $job->{job_id}; $should_show = 1; $stats->{running}++; $stats->{todo}--; $stats->{started} //= 1; } if ($f->{harness_job_end}) { my $file = $f->{harness_job_end}->{file}; delete $self->{+ACTIVE_FILES}->{File::Spec->abs2rel($file)}; $should_show = 1; $stats->{running}--; if ($f->{harness_job_end}->{fail}) { $stats->{failed}++; } else { $stats->{passed}++; } } return $out unless $should_show; my $statline = join '|' => ( $self->_highlight($stats->{passed}, 'P', 'green'), $self->_highlight($stats->{failed}, 'F', 'red'), $self->_highlight($stats->{running}, 'R', 'cyan'), $self->_highlight($stats->{todo}, 'T', 'yellow'), ); $statline = "[$statline]"; my $active = $self->{+ACTIVE_FILES}; return $self->{+_ACTIVE_DISP} = [$statline, ''] unless $active && keys %$active; my $reset = $self->reset; my $str .= "("; { no warnings 'numeric'; $str .= join(' ' => map { m{([^/]+)$}; "$active->{$_}:$1" } sort { ($active->{$a} || 0) <=> ($active->{$b} || 0) or $a cmp $b } keys %$active); } $str .= ")"; $self->{+_ACTIVE_DISP} = [$statline, $str]; return 1; } sub update_spinner { my $self = shift; my ($stats) = @_; $stats->{spinner} //= '|'; $stats->{spinner_time} //= time - 1; $stats->{blink_time} //= time - 1; $stats->{blink} //= ''; if (time - $stats->{spinner_time} > 0.1) { $stats->{spinner_time} = time; my $start = substr($stats->{spinner}, 0, 1); $stats->{spinner} = '\\' if $start eq '-'; $stats->{spinner} = '-' if $start eq '/'; $stats->{spinner} = '/' if $start eq '|'; $stats->{spinner} = '|' if $start eq '\\'; } elsif(time - $stats->{blink_time} > 0.5) { $stats->{blink_time} = time; $stats->{blink} = $stats->{blink} ? '' : 'bold bright_'; } else { return 0; } my $yellow = $self->{+COLOR} ? Term::ANSIColor::color($stats->{blink} . 'yellow') : ''; my $cyan = $self->{+COLOR} ? Term::ANSIColor::color('cyan') : ''; my $green = $self->{+COLOR} ? Term::ANSIColor::color('bold bright_green') : ''; my $bold = $self->{+COLOR} ? Term::ANSIColor::color('bold bright_white') : ''; my $reset = $self->reset; $self->{+_ACTIVE_DISP} = [ join( '' => ( $bold => "[ ", $reset, $green => $stats->{spinner}, $reset, '' => " ", $self->{+IS_PERSISTENT} ? ( $yellow => "Waiting for busy runner", $reset, '' => " ", $reset => "(see ", $reset, $cyan => "yath status", $reset, $reset => ")", $reset, ) : ($yellow => "INITIALIZING", $reset), '' => " ", $green => $stats->{spinner}, $reset, $bold => " ]", $reset, ) ), '', ]; return 1; } sub _highlight { my $self = shift; my ($val, $label, $color) = @_; return "${label}:${val}" unless $val && $self->{+COLOR}; return sprintf('%s%s:%d%s', Term::ANSIColor::color($color), $label, $val, $self->reset); } sub colorstrip { my $self = shift; my ($str) = @_; return $str unless USE_ANSI_COLOR; return Term::ANSIColor::colorstrip($str); } sub render_status { my $self = shift; my $reset = $self->reset; my $cyan = $self->{+COLOR} ? Term::ANSIColor::color('cyan') : ''; my $str = "$self->{+_ACTIVE_DISP}->[0] Events: $self->{+ECOUNT} ${cyan}$self->{+_ACTIVE_DISP}->[1]${reset}"; my $max = term_size() || 80; if (length($str) > $max) { my $nocolor = $self->colorstrip($str); $str = substr($nocolor, 0, $max - 8) . " ...)$reset" if length($nocolor) > $max; $str =~ s/\(/$cyan(/; $str =~ s/^\[[^\]]+\]/$self->{+_ACTIVE_DISP}->[0]/; } return $str; } sub render_buffered_event { my $self = shift; my ($f, $tree) = @_; my $comp = $self->{+COMPOSER}->render_one_line($f) or return; return unless @$comp; return [$self->build_line($tree, @$comp)]; } sub render_event { my $self = shift; my ($f, $tree) = @_; my $comps = $self->{+COMPOSER}->render_verbose($f); my (@parent, @times); if ($f->{parent}) { @parent = $self->render_parent($f, $tree); if (@$comps && $comps->[-1]->[0] eq 'times') { my $times = pop(@$comps); @times = $self->build_line($tree, @$times); } } my @out; for my $comp (@$comps) { my $ctree = $tree; substr($ctree, -2, 2, '+~') if $comp->[0] eq 'assert' && $f->{parent}; push @out => $self->build_line($ctree, @$comp); } push @out => (@parent, @times); return \@out; } sub render_quiet { my $self = shift; my ($f, $tree) = @_; my @out; my $comps = $self->{+COMPOSER}->render_brief($f); for my $comp (@$comps) { my $ctree = $tree ||= $self->render_tree($f); substr($ctree, -2, 2, '+~') if $comp->[0] eq 'assert' && $f->{parent}; push @out => $self->build_line($ctree, @$comp); } if ($f->{parent} && !$f->{amnesty}) { push @out => $self->render_parent($f, $tree ||= $self->render_tree($f), quiet => 1); } return \@out; } sub reset { my $self = shift; return $self->{+COLOR} ? $self->{+COLOR}->{reset} : ''; } sub job_color { my $self = shift; my ($id, $set) = @_; return '' unless $self->{+JOB_COLORS}; return $self->{+JOB_COLORS}->{used}->{$id} || '' unless $set; return $self->{+JOB_COLORS}->{used}->{$id} ||= shift @{$self->{+JOB_COLORS}->{free}} || ''; } sub render_tree { my $self = shift; my ($f, $char) = @_; $char ||= '|'; my $job = ''; if ($f->{harness} && $f->{harness}->{job_id}) { my $id = $f->{harness}->{job_id}; my $name = $self->{+JOB_NAMES}->{$id}; my ($color, $reset) = ('', ''); if ($self->{+JOB_COLORS}) { $color = $self->job_color($id, 'set'); $reset = $self->reset; } my $len = length($name); if (!$self->{+JOB_LENGTH} || $len > $self->{+JOB_LENGTH}) { $self->{+JOB_LENGTH} = $len; } else { $len = $self->{+JOB_LENGTH}; } $job = sprintf("%sjob %${len}s%s ", $color, $name, $reset || ''); } my $hf = hub_truth($f); my $depth = $hf->{nested} || 0; my @pipes = (' ', map $char, 1 .. $depth); return join(' ' => $job, @pipes) . ' '; } sub build_line { my $self = shift; my ($tree, $facet, $tag, $text) = @_; $tree ||= ''; $tag ||= ''; $text ||= ''; chomp($text); substr($tree, -2, 1, '+') if $facet eq 'assert'; $tag = substr($tag, 0 - TAG_WIDTH, TAG_WIDTH) if length($tag) > TAG_WIDTH; my $max = $self->{+TTY} && !$self->{+NO_WRAP} ? (term_size() || 80) : undef; my $color = $self->{+COLOR}; my $reset = $self->reset; my $tcolor = $color ? $color->{TAGS}->{$tag} || $color->{FACETS}->{$facet} || '' : ''; my ($ps, $pe) = @{$FACET_TAG_BORDERS{$facet} || $FACET_TAG_BORDERS{default}}; $tag = uc($tag); my $length = length($tag); if ($length > TAG_WIDTH) { $tag = substr($tag, 0, TAG_WIDTH); } elsif($length < TAG_WIDTH) { my $pad = (TAG_WIDTH - $length) / 2; my $padl = $pad + (TAG_WIDTH - $length) % 2; $tag = (' ' x $padl) . $tag . (' ' x $pad); } my $start; if ($color) { my $border = $color->{tag_border} || ''; $start = "${reset}${border}${ps}${reset}${tcolor}${tag}${reset}${border}${pe}${reset}"; } else { $start = "${ps}${tag}${pe}"; } $start .= " "; if ($tree) { if ($color) { my $trcolor = $color->{tree} || ''; $start .= $trcolor . $tree . $reset; } else { $start .= $tree; } } my @lines = split /[\r\n]/, $text; @lines = ($text) unless @lines; my @out; for my $line (@lines) { if(@lines > 1 && $max && length("$ps$tag$pe $tree$line") > $max) { @out = (); last; } if ($color) { push @out => "${start}${tcolor}${line}$reset"; } else { push @out => "${start}${line}"; } } return @out if @out; return ( "$start----- START -----", $text, "$start------ END ------", ) unless $color; my $blob = $color->{blob} || ''; return ( "$start${blob}----- START -----$reset", "${tcolor}${text}${reset}", "$start${blob}------ END ------$reset", ); } sub render_parent { my $self = shift; my ($f, $tree, %params) = @_; my $meth = $params{quiet} ? 'render_quiet' : 'render_event'; my @out; for my $sf (@{$f->{parent}->{children}}) { $sf->{harness} ||= $f->{harness}; my $tree = $self->render_tree($sf); push @out => @{$self->$meth($sf, $tree)}; } return unless @out; push @out => ( $self->build_line("$tree^", 'parent', '', ''), ); return @out; } sub DESTROY { my $self = shift; my $io = $self->{+IO} or return; # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; print $io Term::ANSIColor::color('reset') if USE_ANSI_COLOR; print $io "\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Test2 - An alternative to TAP, used by Test2::Harness. =head1 DESCRIPTION This formatter is the primary formatter used for final result rendering when you use Test2::Harness. This formatter is NOT designed to have its output consumed by code/machine/harnesses. The goal of this formatter is to have output that is easily read by humans. =head1 SYNOPSIS If you are running a test directly with perl and want to use this formatter: $ perl -MTest2::Formatter::Test2 path/to/test.t You could also use the module directly in your test, but that is not recommended as your test would then be unable to be run via prove or other harnesses. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Auditor.pm������������������������������������������������������������������������������������������100644��001750��001750�� 7745�15267772575� 22134� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Auditor; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use Time::HiRes qw/time/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Event; use Test2::Harness::Auditor::Watcher; use Test2::Harness::Util::HashBase qw{ <action <run_id +broken <watchers <queued }; sub init { my $self = shift; $self->{+WATCHERS} //= {}; } sub process { my $self = shift; while (my $line = <STDIN>) { my $data = decode_json($line); last unless defined $data; my $e = Test2::Harness::Event->new($data); # If process_event does not return anything we need to record just this # event. If it does return then we want to record what it returns. if (my @events = $self->process_event($e)) { $self->{+ACTION}->($_) for @events; } else { $self->{+ACTION}->($e); } } } sub process_event { my $self = shift; my ($e) = @_; my $job_id = $e->job_id; my $job_try = $e->job_try // 0; # Do nothing for non-job events return $e unless $job_id; my $f = $e->facet_data; if (my $task = $f->{harness_job_queued}) { $self->{+WATCHERS}->{$job_id} //= []; $self->{+QUEUED}->{$job_id} //= $task; return $e; } my $tries = $self->{+WATCHERS}->{$job_id} or return $self->broken($e, "Never saw queue entry"); if (my $job = $f->{harness_job}) { $tries->[$job_try] = Test2::Harness::Auditor::Watcher->new(job => $job, try => $job_try); } my $watcher = $tries->[$job_try] or return $self->broken($e, "never saw harness_job facet"); return $watcher->process($e); } sub broken { my $self = shift; my ($e, $message) = @_; $self->{+BROKEN}->{$e->job_id}++; push @{$e->facet_data->{errors} //= []} => {details => $message, fail => 1}; return $e; } sub finish { my $self = shift; my $final_data = {pass => 1}; while (my ($job_id, $watchers) = each %{$self->{+WATCHERS}}) { my $file = File::Spec->abs2rel($self->{+QUEUED}->{$job_id}->{file}); if (@$watchers) { push @{$final_data->{failed}} => [$job_id, $file, $watchers->[-1]->failed_subtest_tree] if $watchers->[-1]->fail; push @{$final_data->{retried}} => [$job_id, scalar(@$watchers), $file, $watchers->[-1]->pass ? 'YES' : 'NO'] if @$watchers > 1; if (my $halt = $watchers->[-1]->halt) { push @{$final_data->{halted}} => [$job_id, $file, $halt]; } } else { push @{$final_data->{unseen}} => [$job_id, $self->{+QUEUED}->{$job_id}->{file}]; } } $final_data->{pass} = 0 if $final_data->{failed} or $final_data->{unseen}; my $e = Test2::Harness::Event->new( job_id => 0, stamp => time, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => {harness_final => $final_data}, ); $self->{+ACTION}->($e); $self->{+ACTION}->(undef); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor - Auditor that validates test results by processing an event stream. =head1 DESCRIPTION The auditor is responsible for taking a stream of events and determining what is passing or failing. An L<Test2::Harness::Auditor::Watcher> instance is created for every job_id seen, and events for each job are passed to the proper watcher for state management. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������failed����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20652� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������fail.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22243� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failed����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22276� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failed����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������log_dir���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21045� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������foo.tx����������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22306� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/log_dir���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 244�15267772575� 22400� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(!$INC{'App/Yath/Plugin/TestPlugin.pm'}, "Plugin is not loaded for test processes"); is($ENV{T2_HARNESS_JOB_DURATION}, 'long'); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������preload���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21054� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������aaa.tx����������������������������������������������������������������������������������������������100644��001750��001750�� 201�15267772575� 22264� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_STAGE}, 'AAA', "Running in stage 'AAA'"); ok($INC{'AAA.pm'}, "Preloaded AAA"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������bbb.tx����������������������������������������������������������������������������������������������100644��001750��001750�� 201�15267772575� 22267� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_STAGE}, 'BBB', "Running in stage 'BBB'"); ok($INC{'BBB.pm'}, "Preloaded BBB"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ccc.tx����������������������������������������������������������������������������������������������100644��001750��001750�� 1372�15267772575� 22324� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-STAGE-CCC is($ENV{T2_HARNESS_STAGE}, 'CCC', "Running in stage 'CCC'"); ok($INC{'CCC.pm'}, "Preloaded CCC"); is( [sort { $TestPreload::HOOKS{$a}->[0] <=> $TestPreload::HOOKS{$b}->[0] } keys %TestPreload::HOOKS], [qw/INIT PRE_FORK POST_FORK PRE_LAUNCH/], "Hooks happened in order" ); is( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{PRE_LAUNCH}->[1], "POST_FORK and PRE_LAUNCH happened in the same PID" ); isnt( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{INIT}->[1], "POST_FORK and INIT are not in the same PID" ); isnt( $TestPreload::HOOKS{POST_FORK}->[1], $TestPreload::HOOKS{PRE_FORK}->[1], "POST_FORK and PRE_FORK are not in the same PID" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������replay����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20722� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������fail.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22313� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/replay����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22346� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/replay����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������retry�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20573� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������retry.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 1152�15267772575� 22454� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/retry�����������������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������stall_report.t��������������������������������������������������������������������������������������100644��001750��001750�� 10206�15267772575� 22504� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::JSON qw/decode_json/; use File::Spec(); use File::Temp qw/tempdir/; # Always somewhere of our own. The bundle defaults to the directory yath was # run from, and the suite must not need the distribution directory to be # writable -- at install time it may not be. my $BUNDLE_DIR = tempdir(CLEANUP => 1); sub bundles { return glob(File::Spec->catfile($BUNDLE_DIR, 'yath-stall-report-*.json')); } my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # BlockingResource lets one test start, then blocks the scheduler inside # available() for a bounded period before letting the rest through. With a # short --stall-report the main process should notice and print a report while # the scheduler is still stuck, and the run should still finish normally -- # reporting never ends a run. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+BlockingResource', '--stall-report=3:3', "--stall-report-dir=$BUNDLE_DIR"], # The fixture stops blocking as soon as its stack has been taken, so this # is a ceiling for a machine too slow to get there, not a wait. It stays # well under App::Yath::Tester's own timeout, which would kill the run. env => {BLOCKING_RESOURCE_MAX => 30}, exit => 0, test => sub { my $out = shift; like($out->{output}, qr/YATH STALL REPORT BEGIN/, "printed a stall report"); like($out->{output}, qr/no test has started in/, "said what it observed"); like($out->{output}, qr/may be benign/, "said the report may be benign"); # The whole signal-to-trace chain: four separate call sites have to # agree on the stall directory, and if any disagrees the report says # "No stack traces were produced" -- indistinguishable from the # legitimate case where a process could not run its handler. like($out->{output}, qr/BlockingResource::available/, "captured the stack of the stuck scheduler"); my @bundles = bundles(); ok(@bundles, "wrote a bundle that outlives the run") or return; my $size = -s $bundles[0]; ok($size > 1024, "bundle has the detail the text report leaves out") or diag("size: $size"); like($bundles[0], qr/yath-stall-report-[0-9A-F-]+-\d+\.json$/i, "named by run id and report number"); # The bundle also goes into the aux log, which the collector forwards # to the yath UI. It has to be one physical line there, or the # collector makes an info facet per line instead of one for the whole # bundle. encode_json escapes embedded newlines, which is what keeps # that true however large the bundle gets. # The renderer prefixes the tag it derived from the aux log's name; # what matters is that the bundle is one line behind that prefix. my ($line) = map { m/^\(\s*STALL\s*\)\s+(\{.*)$/ ? $1 : () } split /\n/, $out->{output}; ok($line, "the bundle reached the log as a single line") or return; my $data = eval { decode_json($line) }; ok($data, "and it parses") or diag($@); ok($data->{samples} && @{$data->{samples}}, "with the per-process samples in it"); }, ); # A healthy run says nothing about stalls and is not truncated. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', '--stall-report=60:60', "--stall-report-dir=$BUNDLE_DIR"], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr/STALL REPORT/, "no report on a healthy run"); }, ); # Disabled by default. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+BlockingResource', "--stall-report-dir=$BUNDLE_DIR"], # No detector runs at all here, so the length of the block has no bearing # on the assertion. Keep it short instead of sitting out the fixture default. env => {BLOCKING_RESOURCE_MAX => 2}, exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr/STALL REPORT/, "no report when the option is not given"); }, ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������stamps����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20735� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������fail.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22326� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stamps����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22361� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stamps����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass.txxx�������������������������������������������������������������������������������������������100644��001750��001750�� 150�15267772575� 22424� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test������������������������������������������������������������������������������������������������������������������������������use Test2::V0; is (scalar @ARGV, 2); is ( $ARGV[0], 'foobar'); is ( $ARGV[1], 'baz'); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass2.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22255� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/times�����������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20745� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������Git.t�����������������������������������������������������������������������������������������������100755��001750��001750�� 10533�15267772575� 22042� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Plugin��������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin::Git'; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; # HARNESS-DURATION-SHORT use Test2::Harness::Settings; subtest NOTHING => sub { my $control = mock $CLASS => ( override => [ can_run => sub { undef }, git_cmd => sub { return }, ], ); local $ENV{GIT_COMMAND}; local $ENV{GIT_LONG_SHA}; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); ok(!$meta->{git}, "no git added to meta"); is(@$fields, 0, "No fields added"); }; subtest ENV => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA} = "1230988f2c2bd26a1691a82766d5bf5c7524b123"; local $ENV{GIT_SHORT_SHA} = "1230988"; local $ENV{GIT_STATUS} = " M lib/App/Yath/Command.pm"; local $ENV{GIT_BRANCH} = "my.super-long-branch-name-needs-to-be-trimmed"; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.super-long-branch-name-needs-to-be-trimmed', sha => '1230988f2c2bd26a1691a82766d5bf5c7524b123', status => ' M lib/App/Yath/Command.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.super-long-branch', name => 'git', raw => 'my.super-long-branch-name-needs-to-be-trimmed', } ], "Added git field", ); }; subtest CMD => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA}; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.branch.foo', sha => '4570988f2c2bd26a1691a82766d5bf5c7524bcea', status => ' M lib/App/Yath/Plugin/Git.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.branch.foo', name => 'git', raw => 'my.branch.foo', } ], "Added git field", ); }; subtest MIX => sub { my $script = __FILE__; $script =~ s/\.t$/\.script/; local $ENV{GIT_COMMAND} = $script; local $ENV{GIT_LONG_SHA} = "1230988f2c2bd26a1691a82766d5bf5c7524b123"; local $ENV{GIT_SHORT_SHA}; local $ENV{GIT_STATUS}; local $ENV{GIT_BRANCH}; my $meta = {}; my $fields = []; $CLASS->inject_run_data(meta => $meta, fields => $fields); is( $meta, { git => { branch => 'my.branch.foo', sha => '1230988f2c2bd26a1691a82766d5bf5c7524b123', status => ' M lib/App/Yath/Plugin/Git.pm', }, }, "Added git info to meta-data" ); is( $fields, [ { data => $meta->{git}, details => 'my.branch.foo', name => 'git', raw => 'my.branch.foo', } ], "Added git field", ); }; #subtest changed_files => sub { # my $settings = Test2::Harness::Settings->new(); # $settings->define_prefix('git'); # $settings->git->vivify_field('change_base'); # # my $script = __FILE__; # $script =~ s/\.t$/\.script/; # local $ENV{GIT_COMMAND} = $script; # # is( # [$CLASS->changed_files($settings)], # [['a.file', '*', 'sub1', 'sub3']], # "Got changed file" # ); # # $settings->git->field(change_base => 'master'); # is( # [$CLASS->changed_files($settings)], # [ # ['a.file', '*', 'sub1', 'sub3'], # ['b.file', '*', 'sub1'], # ['c.file', 'sub1'], # ], # "Got changed files from change_base" # ); #}; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������abort.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 70124�15267772575� 22242� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::abort; use strict; use warnings; our $VERSION = '1.000182'; use Time::HiRes qw/sleep/; use Term::Table; use File::Spec(); use App::Yath::Util qw/find_pfile/; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command::status'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Abort all currently running or queued tests without killing the runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will kill all running tests and clear the queue, but will not close the runner. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; # Get the output from finding the pfile $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; print "\nTruncating Queue...\n\n"; $state->truncate; $state->poll; my $running = $state->running_tasks; for my $task (values %$running) { my $pid = $self->get_job_pid($task->{run_id}, $task->{job_id}) // next; my $file = $task->{rel_file}; print "Killing test $pid - $file...\n"; kill('INT', $pid); } print "\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::abort - Abort all currently running or queued tests without killing the runner =head1 DESCRIPTION This command will kill all running tests and clear the queue, but will not close the runner. =head1 USAGE $ yath [YATH OPTIONS] abort [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������spawn.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 33715�15267772575� 22270� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::spawn; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Options; use Time::HiRes qw/sleep time/; use File::Temp qw/tempfile/; use Test2::Harness::Util qw/parse_exit/; use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Launch a perl script from the preloaded environment" } sub cli_args { "[--] path/to/script.pl [options and args]" } sub description { return <<" EOT"; This will launch the specified script from the preloaded yath process. NOTE: environment variables are not automatically passed to the spawned process. You must use -e or -E (see help) to specify what environment variables you care about. EOT } option_group {prefix => 'spawn', category => 'spawn options'} => sub { option stage => ( short => 's', type => 's', description => 'Specify the stage to be used for launching the script', long_examples => [ ' foo'], short_examples => [ ' foo'], default => 'default', ); option copy_env => ( short => 'e', type => 'm', description => "Specify environment variables to pass along with their current values, can also use a regex", long_examples => [ ' HOME', ' SHELL', ' /PERL_.*/i' ], short_examples => [ ' HOME', ' SHELL', ' /PERL_.*/i' ], ); option env_var => ( field => 'env_vars', short => 'E', type => 'h', long_examples => [' VAR=VAL'], short_examples => ['VAR=VAL', ' VAR=VAL'], description => 'Set environment variables for the spawn', ); }; sub read_line { my ($fh, $timeout) = @_; $timeout //= 300; my $start = time; while (1) { if ($timeout < (time - $start)) { my @caller = caller; die "Timed out at $caller[1] line $caller[2].\n"; } seek($fh, 0,1) if eof($fh); my $out = <$fh>; unless (defined $out) { sleep 0.02; next; } chomp($out); return $out; } } # This is here for subclasses sub queue_spawn { my $self = shift; my ($args) = @_; $self->state->queue_spawn($args); } sub run_script { shift @ARGV // die "No script specified" } sub stage { $_[0]->settings->spawn->stage } sub env_vars { my $self = shift; my $settings = $self->settings; my $env = {}; for my $var (@{$settings->spawn->copy_env}) { if ($var =~ m{^/(.*)/(\w*)$}s) { my ($re, $opts) = ($1, $2); my $pattern = length($opts) ? "(?$opts)$re" : $re; $env->{$_} = $ENV{$_} for grep { m/$pattern/ } keys %ENV; } else { $env->{$var} = $ENV{$var}; } } my $set = $settings->spawn->env_vars; $env->{$_} = $set->{$_} for keys %$set; return $env; } sub set_pname { my $self = shift; my ($run) = @_; $0 = "yath-" . $self->name . " $run " . join (' ', @ARGV); } sub pre_process_argv { shift @ARGV if @ARGV && $ARGV[0] eq '--'; } sub sig_handlers { qw/INT TERM HUP QUIT USR1 USR2 STOP WINCH/ } sub set_sig_handlers { my $self = shift; my ($wpid) = @_; local $@; eval { my $s = $_; $SIG{$s} = sub { kill($s, $wpid) } } for $self->sig_handlers; } sub clear_sig_handlers { my $self = shift; local $@; eval { my $s = $_; $SIG{$s} = 'DEFAULT' } for $self->sig_handlers; } sub pre_exit_hook {} sub run { my $self = shift; $self->pre_process_argv; my $run = $self->run_script; $self->set_pname($run); my ($fh, $name) = tempfile(UNLINK => 1); close($fh); $self->queue_spawn({ stage => $self->stage // 'default', file => $run, owner => $$, ipcfile => $name, args => [@ARGV], env_vars => $self->env_vars, }); open($fh, '<', $name) or die "Could not open ipcfile: $!"; my $mpid = read_line($fh); my $wpid = read_line($fh); my $win = read_line($fh); $self->set_sig_handlers($wpid); open(my $wfh, '>>', "/proc/$mpid/fd/$win") or die "Could not open /proc/$mpid/fd/$win: $!"; $wfh->autoflush(1); STDIN->blocking(0); while (0 < kill(0, $mpid)) { my $line = <STDIN>; if (defined $line) { print $wfh $line; } else { sleep 0.02; } } $self->clear_sig_handlers(); my $exit = read_line($fh) // die "Could not get exit code"; $exit = parse_exit($exit); if ($exit->{sig}) { print STDERR "Terminated with signal: $exit->{sig}.\n"; kill($exit->{sig}, $$); } print STDERR "Exited with code: $exit->{err}.\n" if $exit->{err}; $self->pre_exit_hook($exit); exit($exit->{err}); } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::spawn - Launch a perl script from the preloaded environment =head1 DESCRIPTION This will launch the specified script from the preloaded yath process. NOTE: environment variables are not automatically passed to the spawned process. You must use -e or -E (see help) to specify what environment variables you care about. =head1 USAGE $ yath [YATH OPTIONS] spawn [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 spawn options =over 4 =item --copy-env HOME =item --copy-env SHELL =item --copy-env /PERL_.*/i =item -e HOME =item -e SHELL =item -e /PERL_.*/i =item --no-copy-env Specify environment variables to pass along with their current values, can also use a regex Can be specified multiple times =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables for the spawn Can be specified multiple times =item --stage foo =item -s foo =item --no-stage Specify the stage to be used for launching the script =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������start.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 55553�15267772575� 22301� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::start; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Util qw/find_pfile/; use App::Yath::Options; use Test2::Harness::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::File::JSON; use Test2::Harness::IPC; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use Test2::Harness::Util qw/mod2file open_file parse_exit clean_path/; use Test2::Util::Table qw/table/; use Test2::Harness::Util::IPC qw/run_cmd USE_P_GROUPS/; use POSIX; use File::Spec; use Sys::Hostname qw/hostname/; use Time::HiRes qw/sleep/; use Carp qw/croak/; use File::Path qw/remove_tree/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::PreCommand', 'App::Yath::Options::Runner', 'App::Yath::Options::Workspace', 'App::Yath::Options::Persist', 'App::Yath::Options::Collector', ); option_group {prefix => 'runner', category => "Persistent Runner Options"} => sub { option reload => ( short => 'r', type => 'b', description => "Attempt to reload modified modules in-place, restarting entire stages only when necessary.", default => 0, ); option restrict_reload => ( type => 'D', long_examples => ['', '=path'], short_examples => ['', '=path'], description => "Only reload modules under the specified path, if no path is specified look at anything under the .yath.rc path, or the current working directory.", normalize => sub { $_[0] eq '1' ? $_[0] : clean_path($_[0]) }, action => \&restrict_action, ); option quiet => ( short => 'q', type => 'c', description => "Be very quiet.", default => 0, ); }; sub restrict_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; if ($norm eq '1') { my $hset = $settings->harness; my $path = $hset->config_file || $hset->cwd; $path //= do { require Cwd; Cwd::getcwd() }; $path =~ s{\.yath\.rc$}{}g; push @{$$slot} => $path; } else { push @{$$slot} => $norm; } } sub MAX_ATTACH() { 1_048_576 } sub group { 'persist' } sub always_keep_dir { 1 } sub summary { "Start the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command is used to start a persistent instance of yath. A persistent instance is useful because it allows you to preload modules in advance, reducing start time for any tests you decide to run as you work. A running instance will watch for changes to any preloaded files, and restart itself if anything changes. Changed files are blacklisted for subsequent reloads so that reloading is not a frequent occurence when editing the same file over and over again. EOT } sub run { my $self = shift; $ENV{TEST2_HARNESS_NO_WRITE_TEST_INFO} //= 1; my $settings = $self->settings; my $dir = $settings->workspace->workdir; my $pfile = find_pfile($settings, vivify => 1, no_checks => 1); if (-f $pfile) { remove_tree($dir, {safe => 1, keep_root => 0}); die "Persistent harness appears to be running, found $pfile\n"; } $self->write_settings_to($dir, 'settings.json'); my $run_queue = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'run_queue.jsonl')); $run_queue->start(); $self->setup_plugins(); $self->setup_resources(); my $stderr = File::Spec->catfile($dir, 'error.log'); my $stdout = File::Spec->catfile($dir, 'output.log'); my @prof; if ($settings->runner->nytprof) { push @prof => '-d:NYTProf'; } my $pid = run_cmd( stderr => $stderr, stdout => $stdout, no_set_pgrp => !$settings->runner->daemon, command => [ $^X, @prof, $settings->harness->script, (map { "-D$_" } @{$settings->harness->dev_libs}), '--no-scan-plugins', # Do not preload any plugin modules runner => $dir, monitor_preloads => 1, persist => $pfile, jobs_todo => 0, ], ); unless ($settings->runner->quiet) { print "\nPersistent runner started!\n"; print "Runner PID: $pid\n"; print "Runner dir: $dir\n"; print "\nUse `yath watch` to monitor the persistent runner\n\n" if $settings->runner->daemon; } Test2::Harness::Util::File::JSON->new(name => $pfile)->write({ pid => $pid, dir => $dir, version => $VERSION, user => $ENV{USER}, hostname => hostname(), }); return 0 if $settings->runner->daemon; $SIG{TERM} = sub { kill(TERM => $pid) }; $SIG{INT} = sub { kill(INT => $pid) }; my $err_fh = open_file($stderr, '<'); my $out_fh = open_file($stdout, '<'); local $?; while (1) { my $out = waitpid($pid, WNOHANG); my $wstat = $?; my $count = 0; seek($out_fh, 0, 1) if eof($out_fh); while (my $line = <$out_fh>) { $count++; print STDOUT $line; } seek($err_fh, 0, 1) if eof($err_fh); while (my $line = <$err_fh>) { $count++; print STDERR $line; } sleep(0.02) unless $out || $count; next if $out == 0; return 255 if $out < 0; my $exit = parse_exit($?); return $exit->{err} || $exit->{sig} || 0; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::start - Start the persistent test runner =head1 DESCRIPTION This command is used to start a persistent instance of yath. A persistent instance is useful because it allows you to preload modules in advance, reducing start time for any tests you decide to run as you work. A running instance will watch for changes to any preloaded files, and restart itself if anything changes. Changed files are blacklisted for subsequent reloads so that reloading is not a frequent occurence when editing the same file over and over again. =head1 USAGE $ yath [YATH OPTIONS] start [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 Persistent Runner Options =over 4 =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --reload =item -r =item --no-reload Attempt to reload modified modules in-place, restarting entire stages only when necessary. =item --restrict-reload =item --restrict-reload=path =item --no-restrict-reload Only reload modules under the specified path, if no path is specified look at anything under the .yath.rc path, or the current working directory. Can be specified multiple times =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --daemon =item --no-daemon Start the runner as a daemon (Default: True) =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --fail-on-resource-skip =item --no-fail-on-resource-skip Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C<YATH_JOB_COUNT>, C<T2_HARNESS_JOB_COUNT>, C<HARNESS_JOB_COUNT> =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource-timeout SECONDS =item --rt SECONDS =item --no-resource-timeout Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout) =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C<T2_HARNESS_JOB_CONCURRENCY> =item --stall-report =item --stall-report=STRONG:LOOSE =item --stall-report=SECONDS =item --no-stall-report Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath's own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200) =item --stall-report-dir path/to/dir =item --no-stall-report-dir Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable. =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C<PERL_USE_UNSAFE_INC> =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C<!T2_NO_FORK>, C<T2_HARNESS_FORK>, C<!T2_HARNESS_NO_FORK>, C<YATH_FORK>, C<!YATH_NO_FORK> =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C<T2_HARNESS_TEMP_DIR>, C<YATH_TEMP_DIR>, C<TMPDIR>, C<TEMPDIR>, C<TMP_DIR>, C<TEMP_DIR> =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C<T2_WORKDIR>, C<YATH_WORKDIR> =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������times.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 30365�15267772575� 22257� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::times; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Util::Times qw/render_duration/; use Test2::Harness::Util::File::JSONL; use App::Yath::Options; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/-log_file <fields/; include_options( 'App::Yath::Options::Debug', ); sub summary { "Get times from a test log" } sub group { 'log' } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] [Field1] [Field2]" } sub description { return <<" EOT"; This command will consume the log of a previous run, and output all timing data from shortest test to longest. You can specify a sort order by listing fields in your desired order after the log file on the command line. EOT } my @NUMERIC = qw/total startup events cleanup/; my %NUMERIC = map { $_ => 1 } @NUMERIC; my @ALPHA = qw/file/; my %ALPHA = map { $_ => 1 } @ALPHA; my @FIELDS = (@NUMERIC, @ALPHA); my %FIELDS = map { $_ => 1 } @FIELDS; sub run { my $self = shift; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my %seen; my @fields; for my $field (@$args, @FIELDS) { $field = lc($field); next if $seen{$field}++; die "'$field' is not a valid field\n" unless $FIELDS{$field}; push @fields => $field; } $self->{+FIELDS} = \@fields; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my @jobs; while (1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; next unless $f->{harness_job_end}; my $job = {}; $job->{file} = $f->{harness_job_end}->{rel_file} if $f->{harness_job_end} && $f->{harness_job_end}->{rel_file}; $job->{time} = $f->{harness_job_end}->{times}->{totals} if $f->{harness_job_end} && $f->{harness_job_end}->{times}; push @jobs => $job; } } my @rows; my $totals = {file => 'TOTAL'}; @jobs = sort { $self->sort_compare($a, $b) } @jobs; for my $job (@jobs) { my $data = $job->{time}; push @rows => $self->build_row({%$data, file => $job->{file}}); $totals->{$_} += $data->{$_} for @NUMERIC; } push @rows => [map { '--' } @fields]; push @rows => $self->build_row($totals); require Term::Table; my $table = Term::Table->new( header => [map { ucfirst($_) } @fields], rows => \@rows, ); print "$_\n" for $table->render; return 0; } sub build_row { my $self = shift; my ($data) = @_; return [map { $NUMERIC{$_} && defined($data->{$_}) ? render_duration($data->{$_}) : $data->{$_} } @{$self->{+FIELDS}}]; } sub sort_compare { my $self = shift; my ($ja, $jb) = @_; my $order = $self->{+FIELDS}; my $ta = $ja->{time}; my $tb = $jb->{time}; for my $field (@$order) { my $fa = $ta->{$field}; my $fb = $tb->{$field}; my $da = defined $fa; my $db = defined $fb; next unless $da || $db; return 1 if $da && !$db; return -1 if $db && !$da; my $delta = $ALPHA{$field} ? lc($fa) cmp lc($fb) : $fa <=> $fb; return $delta if $delta; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::times - Get times from a test log =head1 DESCRIPTION This command will consume the log of a previous run, and output all timing data from shortest test to longest. You can specify a sort order by listing fields in your desired order after the log file on the command line. =head1 USAGE $ yath [YATH OPTIONS] times [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������watch.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 26127�15267772575� 22245� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::watch; use strict; use warnings; our $VERSION = '1.000182'; use Time::HiRes qw/sleep/; use Test2::Harness::Util::File::JSON; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Monitor the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will tail the logs from a persistent instance of yath. STDOUT and STDERR will be printed as seen, so may not be in proper order. EOT } sub run { my $self = shift; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; my $stop; $stop = 1 if @$args && $args->[0] eq 'STOP'; my $pfile = find_pfile($self->settings, no_fatal => 1) or die "No persistent harness was found for the current path.\n"; print "\nFound: $pfile\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; print "\n"; my $err_f = File::Spec->catfile($data->{dir}, 'error.log'); my $out_f = File::Spec->catfile($data->{dir}, 'output.log'); my $err_fh = open_file($err_f, '<'); my $out_fh = open_file($out_f, '<'); my $auxdir = File::Spec->catdir($data->{dir}, 'aux_logs'); my %aux; while (1) { my $count = 0; seek($out_fh, 0, 1) if eof($out_fh); while (my $line = <$out_fh>) { $count++; print STDOUT $line; } seek($err_fh, 0, 1) if eof($err_fh); while (my $line = <$err_fh>) { $count++; print STDERR $line; } if (-d $auxdir) { opendir(my $dh, $auxdir) or die "Could not open auxdir: $!"; for my $file (readdir($dh)) { next if $aux{$file}; next unless $file =~ m/\.log$/; my $full = File::Spec->catfile($auxdir, $file); next unless -f $full; $aux{$file} = open_file($full, '<'); $count++; } } for my $file (sort keys %aux) { my $fh = $aux{$file}; my $ofh = $file =~ m/STDERR/ ? \*STDERR : \*STDOUT; seek($fh, 0, 1) if eof($fh); while (my $line = <$fh>) { $count++; print $ofh $line; } } next if $count; last if $stop; last unless -f $pfile; sleep 0.02; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::watch - Monitor the persistent test runner =head1 DESCRIPTION This command will tail the logs from a persistent instance of yath. STDOUT and STDERR will be printed as seen, so may not be in proper order. =head1 USAGE $ yath [YATH OPTIONS] watch [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������which.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 22526�15267772575� 22240� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::which; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util::File::JSON; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Locate the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This will tell you about any persistent runners it can find. EOT } sub run { my $self = shift; my $pfile = find_pfile($self->settings, no_fatal => 1); unless ($pfile) { print "\nNo persistent harness was found for the current path.\n\n"; return 0; } print "\nFound: $pfile\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); print " PID: $data->{pid}\n"; print " Dir: $data->{dir}\n"; print "\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::which - Locate the persistent test runner =head1 DESCRIPTION This will tell you about any persistent runners it can find. =head1 USAGE $ yath [YATH OPTIONS] which [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������Debug.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 22455�15267772575� 22242� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Debug; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::JSON qw/encode_pretty_json/; use Test2::Util::Table qw/table/; use Test2::Harness::Util qw/find_libraries mod2file clean_path/; use Errno qw/EINTR/; use App::Yath::Options; option_group {prefix => 'debug', category => 'Help and Debugging'} => sub { post 99999 => \&_post_process_show_opts; post 99998 => \&_post_process_interactive; post \&_post_process_version; post \&_post_process_help; option dummy => ( short => 'd', description => 'Dummy run, do not actually execute anything', env_vars => [qw/T2_HARNESS_DUMMY/], clear_env_vars => 1, default => 0, ); option procname_prefix => ( type => 's', default => '', description => 'Add a prefix to all proc names (as seen by ps).', ); option keep_dirs => ( short => 'k', alt => ['keep_dir'], description => 'Do not delete directories when done. This is useful if you want to inspect the directories used for various commands.', default => 0, ); option 'show-opts' => ( description => 'Exit after showing what yath thinks your options mean', pre_command => 1, ); option version => ( short => 'V', description => "Exit after showing a helpful usage message", pre_command => 1, ); option help => ( short => 'h', description => "exit after showing help information", ); option interactive => ( short => 'i', description => 'Use interactive mode, 1 test at a time, stdin forwarded to it', ); option summary => ( type => 'd', description => "Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/summary.json'], normalize => \&normalize_summary, action => \&summary_action, applicable => sub { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Run'}; return 0; }, ); }; sub normalize_summary { my $val = shift; return $val if $val eq '1'; $val =~ s/\.json$//g; $val .= '.json'; return clean_path($val); } sub summary_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path($norm) unless $norm eq '1'; return if $$slot; return $$slot = clean_path('summary.json'); } sub _post_process_help { my %params = @_; return unless $params{settings}->debug->help; my $help; if (my $cmd = $params{command}) { $help = $cmd->cli_help(%params); } else { $help = __PACKAGE__->cli_help(%params); } if (eval { require IO::Pager; 1 }) { local $SIG{PIPE} = sub {}; my $pager = IO::Pager->new(*STDOUT); $pager->print($help); } else { print $help; } exit 0; } sub _post_process_show_opts { my %params = @_; return unless $params{settings}->debug->show_opts; my $settings = $params{settings}; print "\nCommand selected: " . $params{command}->name . " (" . ref($params{command}) . ")\n" if $params{command}; my $args = $params{args}; print "\nCommand args: " . join(', ' => @$args) . "\n" if @$args; my $out = encode_pretty_json($settings); print "\nCurrent command line and config options result in these settings:\n"; print "$out\n"; exit 0; } my $RAN = 0; sub _post_process_interactive { return if $RAN++; my %params = @_; return unless $params{settings}->debug->interactive; my $settings = $params{settings}; my ($fifo); if ($settings->check_prefix('workspace')) { my $dir = $settings->workspace->workdir; $fifo = "$dir/fifo-$$"; } else { require File::Temp; my $fh; ($fh, $fifo) = File::Temp::tempfile("YATH-FIFO-$$-XXXXXX", TMPDIR => 1); close($fh); unlink($fifo); } ${$settings->debug->vivify_field('fifo')} = $fifo; if ($settings->check_prefix('display')) { my $display = $settings->display; $display->field(quiet => 0) if $display->check_field('quiet'); $display->field(verbose => 1) if $display->check_field('verbose') && !$display->verbose; } if ($settings->check_prefix('formatter')) { my $formatter = $settings->formatter; $formatter->field(qvf => 0) if $formatter->check_field('qvf'); } if ($settings->check_prefix('run')) { $settings->run->env_vars->{YATH_INTERACTIVE} = $fifo; $ENV{YATH_INTERACTIVE} = $fifo; } my $pid = fork() // die "Could not fork: $!"; if ($pid) { require Scope::Guard; require POSIX; POSIX::mkfifo($fifo, 0700) or die "Failed to make fifo ($fifo): $!"; my $fh; my $cleanup = sub { close($fh) if $fh; unlink($fifo) if -e $fifo; }; my $old_int_handler = $SIG{INT}; my $old_term_handler = $SIG{TERM}; $SIG{INT} = sub { $cleanup->('INT'); $old_int_handler->() if ref $old_int_handler; exit 1; }; $SIG{TERM} = sub { $cleanup->('TERM'); $old_term_handler->() if ref $old_term_handler; exit 1; }; $SIG{PIPE} = sub { exit 1 }; $SIG{CHLD} = sub { local $?; my $res = waitpid($pid, 0); my $exit = ($? >> 8); close($fh) if $fh; unlink($fifo) if -e $fifo; # Forward the exit code from our child exit($exit); }; for (1 .. 10) { last if open($fh, '>', $fifo); die "Could not open fifo ($fifo): $!" unless $! == EINTR; sleep 0.2; } die "Could not open fifo ($fifo): $!" unless $fh; $fh->autoflush(1); my $guard = Scope::Guard->new($cleanup); while(1) { my $data = <STDIN>; if (defined($data) && length($data)) { print $fh $data; next; } next if defined($data); next if kill(0, $pid); print STDERR "Lost child process $pid\n"; $cleanup->(); exit 255; } } close(STDIN); open(STDIN, '<', '/dev/null'); require Time::HiRes; while (! -e $fifo) { Time::HiRes::sleep(0.02) }; } sub _post_process_version { my %params = @_; return unless $params{settings}->debug->version; require App::Yath; my $out = <<" EOT"; Yath version: $App::Yath::VERSION Extended Version Info EOT my $plugin_libs = find_libraries('App::Yath::Plugin::*'); my @vers = ( [perl => $^V], ['App::Yath' => App::Yath->VERSION], ( map { eval { require(mod2file($_)); 1 } ? [$_ => $_->VERSION // 'N/A'] : [$_ => 'N/A'] } qw/Test2::API Test2::Suite Test::Builder/ ), ( map { eval { require($plugin_libs->{$_}); 1 } && [$_ => $_->VERSION // 'N/A'] } sort keys %$plugin_libs ), ); $out .= join "\n" => table( header => [qw/COMPONENT VERSION/], rows => \@vers, ); print "$out\n\n"; exit 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Debug - Debug options for Yath =head1 DESCRIPTION This is where debug related command line options live. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head2 COMMAND OPTIONS =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Notify.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 46725�15267772575� 22275� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Plugin�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Notify; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::JSON qw/encode_json/; use Test2::Harness::Util qw/mod2file/; use Sys::Hostname qw/hostname/; use Carp qw/croak confess/; use App::Yath::Options; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-final -tries -problems -problem_cids +text_mod +text_mod_handles_events +text_mod_fail/; # Notifications only apply to commands which build a run. sub applicable { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Run'}; return 0; } option_group {prefix => 'notify', category => "Notification Options", applicable => \&applicable} => sub { option slack => ( type => 'm', description => "Send results to a slack channel and/or user", long_examples => [" '#foo'", " '\@bar'"], ); option slack_fail => ( type => 'm', description => "Send failing results to a slack channel and/or user", long_examples => [" '#foo'", " '\@bar'"], ); option slack_url => ( type => 's', description => "Specify an API endpoint for slack webhook integrations", long_examples => [" https://hooks.slack.com/..."], ); option slack_owner => ( type => 'b', description => "Send slack notifications to the slack channels/users listed in test meta-data when tests fail.", default => 0, ); option no_batch_slack => ( type => 'b', default => 0, description => 'Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen.', ); option email_from => ( type => 's', long_examples => [' foo@example.com'], description => "If any email is sent, this is who it will be from", default => sub { my $user = getlogin() || scalar(getpwuid($<)) || $ENV{USER} || 'unknown'; my $host = hostname() || 'unknown'; return "${user}\@${host}"; }, ); option email => ( type => 'm', long_examples => [' foo@example.com'], description => "Email the test results to the specified email address(es)", ); option email_fail => ( type => 'm', long_examples => [' foo@example.com'], description => "Email failing results to the specified email address(es)", ); option email_owner => ( type => 'b', description => 'Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner', default => 0, ); option no_batch_email => ( type => 'b', default => 0, description => 'Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen.', ); option text => ( type => 's', alt => ['message', 'msg'], description => "Add a custom text snippet to email/slack notifications", ); option text_module => ( type => 's', alt => ['message_module'], description => "Use the specified module to generate messages for emails and/or slack.", ); post sub { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $set_by_cli = $options->set_by_cli->{notify}; # Should we use email? if (@{$settings->notify->email} || $settings->notify->email_owner) { $settings->notify->field(email_owner => 1) unless $set_by_cli->{email_owner}; # Do we have Email::Stuffer? eval { require Email::Stuffer; 1 } or die "Cannot use --email-owner without Email::Stuffer, which is not installed.\n"; push @{$settings->harness->plugins} => __PACKAGE__->new() unless grep { $_->isa(__PACKAGE__) } @{$settings->harness->plugins}; } my $use_slack = grep { $settings->notify->$_ } qw/slack_url slack_owner/; $use_slack ||= grep { @{$settings->notify->$_} } qw/slack slack_fail/; if ($use_slack) { die "slack url must be provided in order to use slack" unless $settings->notify->slack_url; eval { require HTTP::Tiny; 1 } or die "Cannot use slack without HTTP::Tiny which is not installed.\n"; die "HTTP::Tiny reports that it does not support SSL, cannot use slack without ssl." unless HTTP::Tiny::can_ssl(); $settings->notify->field(slack_owner => 1) unless $set_by_cli->{slack_owner}; push @{$settings->harness->plugins} => __PACKAGE__->new() unless grep { $_->isa(__PACKAGE__) } @{$settings->harness->plugins}; } }; }; sub text_mod { my $self = shift; my ($settings) = @_; croak 'settings is a required argument' unless $settings; return $self->{+TEXT_MOD} if exists $self->{+TEXT_MOD}; if (my $tm = $settings->notify->text_module) { my $file = mod2file($tm); if (eval { require $file; 1 }) { my $inst = $tm->can('new') ? $tm->new() : $tm; $self->{+TEXT_MOD_HANDLES_EVENTS} = $inst->can('handle_event') ? 1 : 0; return $self->{+TEXT_MOD} = $inst; } else { my $err = $@; warn "Cannot use module '$tm' for notification text generation: $err"; chomp($self->{+TEXT_MOD_FAIL} = $err); } } $self->{+TEXT_MOD_HANDLES_EVENTS} = 0; return $self->{+TEXT_MOD} = undef; } sub handle_event { my $self = shift; my ($e, $settings) = @_; my $f = $e->facet_data; $self->record_problem($f); my $tm = $self->text_mod($settings); if ($tm && $self->{+TEXT_MOD_HANDLES_EVENTS}) { $tm->handle_event($e, $f, settings => $settings, notify => $self); } return $self->handle_job_end($e, $f, $settings) if $f->{harness_job_end}; return $self->handle_final($e, $f, $settings) if $f->{harness_final}; return; } sub record_problem { my $self = shift; my ($f) = @_; return unless $self->has_fail_or_error($f); my $job_id = $f->{harness}->{job_id}; my $job_try = $f->{harness}->{job_try} // 0; push @{$self->{+PROBLEMS}->{$job_id}->{$job_try}} => $self->prune_subtests($f); } sub has_fail_or_error { my $self = shift; my ($f, %params) = @_; return 0 if $f->{trace}->{nested} && !$params{allow_nested}; return 0 if $f->{amnesty} && @{$f->{amnesty}}; my $out = 0; my $cid = $f->{trace}->{cid}; $out = 1 if $cid && $self->{+PROBLEM_CIDS}->{$cid} && $f->{info} && @{$f->{info}}; $out = 1 if $f->{errors} && @{$f->{errors}}; $out = 1 if $f->{assert} && !$f->{assert}->{pass}; $self->{+PROBLEM_CIDS}->{$cid} = 1 if $cid && $out; return $out; } sub prune_subtests { my $self = shift; my ($f) = @_; my $p = $f->{parent} // return $f; my $c = $p->{children} // return $f; return $f unless @$c; my $out = {}; $out->{$_} = $f->{$_} for grep { $f->{$_} } qw/assert about trace errors info harness control/; $out->{parent} = {%$p, children => [map { $self->prune_subtests($_) } grep { $self->has_fail_or_error($_, allow_nested => 1) } @$c]}; return $out; } sub handle_final { my $self = shift; my ($e, $f, $settings) = @_; $self->{+FINAL} = $e; } sub handle_job_end { my $self = shift; my ($e, $f, $settings) = @_; return unless $f->{harness_job_end}->{fail}; my $job_id = $f->{harness}->{job_id}; if ($f->{harness_job_end}->{retry}) { $self->{+TRIES}->{$job_id}++; return; } my @args = ($e, $f, $self->{+TRIES}->{$job_id}, $settings); $self->send_job_notification_slack(@args); $self->send_job_notification_email(@args); } sub send_job_notification_slack { my $self = shift; my ($e, $f, $tries, $settings) = @_; return unless $settings->notify->no_batch_slack; my $tf = Test2::Harness::TestFile->new(file => $f->{harness_job_end}->{abs_file}); my @slack; push @slack => $tf->meta('slack') if $settings->notify->slack_owner; push @slack => @{$settings->notify->slack_fail}; return unless @slack; my $text = $self->gen_text(scope => 'job', service => 'slack', settings => $settings, file => $tf, tries => $tries); $self->_send_slack($text, $settings, @slack); } sub gen_slack_job_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $tf = $params{file} // croak "'file' is required"; my $tries = $params{tries} // 0; my $host = hostname(); my $file = $tf->relative; return join "\n\n" => grep { $_ } $settings->notify->text, "Failed test on $host: '$file'.", $tries ? ("Test was run " . (1 + $tries) . " time(s).") : (), join "\n" => map {"> <$_|$_>"} @{$settings->run->links}; } sub _send_slack { my $self = shift; my ($text, $settings, @to) = @_; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); for my $dest (@to) { my $r = $ht->post( $settings->notify->slack_url, { headers => {'content-type' => 'application/json'}, content => encode_json({channel => $dest, text => $text}), }, ); warn "Failed to send slack message to '$dest'" unless $r->{success}; } } sub send_job_notification_email { my $self = shift; my ($e, $f, $tries, $settings) = @_; return unless $settings->notify->no_batch_email; my $tf = Test2::Harness::TestFile->new(file => $f->{harness_job_end}->{abs_file}); my @to; push @to => $tf->meta('owner') if $settings->notify->email_owner; push @to => @{$settings->notify->email_fail}; return unless @to; my $text = $self->gen_text(scope => 'job', service => 'email', settings => $settings, file => $tf, tries => $tries); my $subject = "Failed test on " . hostname() . ": '" . $tf->relative . "'."; $self->_send_email($subject, $text, $settings, @to); } sub gen_email_job_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $tf = $params{file} // croak "'file' is required"; my $tries = $params{tries} // 0; my $host = hostname(); my $file = $tf->relative; return join "\n\n" => grep { $_ } $settings->notify->text, "Failed test on $host: '$file'.", $tries ? ("Test was run " . (1 + $tries) . " time(s).") : (), join "\n" => @{$settings->run->links}; } sub _send_email { my $self = shift; my ($subject, $text, $settings, @to) = @_; my $mail = Email::Stuffer->to(@to); $mail->from($settings->notify->email_from); $mail->subject($subject); my $rtype = ref($text) // ''; if (!$rtype) { $mail->text_body($text); } elsif ($rtype eq 'HASH') { $mail->text_body($text->{text}) if $text->{text}; $mail->html_body($text->{html}) if $text->{html}; } else { warn "Invalid text type: '$rtype'"; } eval { $mail->send_or_die; 1 } or warn $@; } sub finish { my $self = shift; my %params = @_; my $settings = $params{settings}; my $e = $self->{+FINAL} or return; my $f = $e->facet_data or return; my $final = $f->{harness_final} or return; $self->send_run_notification_slack($final, $settings); $self->send_run_notification_email($final, $settings); } sub send_run_notification_slack { my $self = shift; my ($final, $settings) = @_; return if $settings->notify->no_batch_slack; my @to = @{$settings->notify->slack}; push @to => @{$settings->notify->slack_fail} unless $final->{pass}; my $files = ""; if ($final->{failed}) { for my $set (@{$final->{failed}}) { my $file = $set->[1]; $files = $files ? "$files\n$file" : $file; next unless $settings->notify->slack_owner; my $tf = Test2::Harness::TestFile->new(file => $file); push @to => $tf->meta('slack'); } } return unless @to; my $text = $self->gen_text( scope => 'run', service => 'slack', settings => $settings, final => $final, files => $files, ); $self->_send_slack($text, $settings, @to); } sub gen_slack_run_text { my $self = shift; my %params = @_; my $settings = $params{settings} // croak "'settings' is required"; my $final = $params{final} // croak "'final' is required"; my $files = $params{files} // ''; my $host = hostname(); return join "\n\n" => grep { $_ } ( $settings->notify->text, ($final->{pass} ? "Tests passed on $host" : "Tests failed on $host"), ($files ? $files : ()), join("\n" => map {"> <$_|$_>"} @{$settings->run->links}), ); } sub send_run_notification_email { my $self = shift; my ($final, $settings) = @_; return if $settings->notify->no_batch_email; my @to = @{$settings->notify->email}; push @to => @{$settings->notify->email_fail} unless $final->{pass}; my $files = ""; if ($final->{failed}) { for my $set (@{$final->{failed}}) { my $file = $set->[1]; $files = $files ? "$files\n$file" : $file; next unless $settings->notify->email_owner; my $tf = Test2::Harness::TestFile->new(file => $file); push @to => $tf->meta('owner'); } } return unless @to; my $subject = $self->gen_text( scope => 'run', service => 'email_subject', settings => $settings, final => $final, files => $files, ); my $text = $self->gen_text( scope => 'run', service => 'email', settings => $settings, final => $final, files => $files, subject => $subject, ); $self->_send_email($subject, $text, $settings, @to); } sub gen_email_subject_run_text { my $self = shift; my %params = @_; my $final = $params{final} // croak "'final' is required"; my $host = hostname(); return $final->{pass} ? "Tests passed on $host" : "Tests failed on $host"; } sub gen_email_run_text { my $self = shift; my %params = @_; my $subject = $params{subject} // $self->gen_text(%params, service => 'email_subject'); my $settings = $params{settings} // croak "'settings' is required"; my $final = $params{final} // croak "'final' is required"; my $files = $params{files} // ''; return join "\n\n" => grep { $_ } ( $settings->notify->text, $subject, ($files ? $files : ()), join("\n" => @{$settings->run->links}), ); } sub gen_text { my $self = shift; my %params = @_; my $scope = $params{scope} or croak "'scope' is required"; my $service = $params{service} or croak "'service' is required"; my $settings = $params{settings} or croak "'settings' is required"; my $meth = "gen_${service}_${scope}_text"; if (my $tm = $self->text_mod($settings)) { return $tm->$meth(%params, notify => $self) if $tm->can($meth); } if ($self->can($meth)) { my $text = $self->$meth(%params); my $mod = $settings->notify->text_module; $text = <<" EOT" if $self->{+TEXT_MOD_FAIL} && $service !~ m/subject/i; ******************************************************************************* There was an error loading the text generation module '$mod'. Because of this error the default notification text has been used. The error encountered was: $self->{+TEXT_MOD_FAIL} ******************************************************************************* $text EOT return $text; } confess "No notification text method '$meth'"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::Notify - Plugin to send email and/or slack notifications =head1 DESCRIPTION This plugin is used for sending email and/or slack notifications from yath. =head1 SYNOPSIS =head2 IN A TEST #!/usr/bin/perl use Test2::V0; # HARNESS-META owner author@example.com # HARNESS-META slack #slack_channel # HARNESS-META slack #slack_user You can use the C<# HARNESS-META owner EMAIL_ADDRESS> to specify an "owner" email address. You can use the C<# HARNESS-META slack USER/CHANNEL> to specify a slack user or channel that owns the test. =head2 RUNNING WITH NOTIFICATIONS ENABLED $ yath test -pNotify ... Also of note, most of the time you can just specify the notification options you want and the plugin will load as needed as long as C<--no-scan-plugins> was not specified. =head3 EMAIL $ yath test --notify-email-owner --notify-email-from user@example.com --notify-email-fail fixer@example.com =head3 SLACK A slack hooks url is always needed for slack to work. $ yath test --notify-slack-url https://hooks.slack.com/... --notify-slack-fail '#foo' --notify-slack-owner =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������YathUI.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 25105�15267772575� 22155� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Plugin�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::YathUI; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use Test2::Harness::Util qw/read_file mod2file looks_like_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use App::Yath::Options; use parent 'App::Yath::Plugin'; sub can_log { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Logging'}; return 0; } sub can_finder { my ($option, $options) = @_; return 1 if $options->included->{'App::Yath::Options::Finder'}; return 0; } option_group {prefix => 'yathui', category => "YathUI Options"} => sub { option url => ( type => 's', alt => ['uri'], description => "Yath-UI url", long_examples => [" http://my-yath-ui.com/..."], ); option api_key => ( type => 's', description => "Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user" ); option project => ( type => 's', description => "The Yath-UI project for your test results", ); option mode => ( type => 's', default => 'qvfd', description => "Set the upload mode (default 'qvfd')", long_examples => [ ' summary', ' qvf', ' qvfd', ' complete', ], ); option retry => ( type => 'c', description => "How many times to try an operation before giving up", default => 0, ); option grace => ( description => "If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going.", default => 0, ); option durations => ( description => "Poll duration data from Yath-UI to help order tests efficiently", default => 0, applicable => \&can_finder, ); option coverage => ( description => "Poll coverage data from Yath-UI to determine what tests should be run for changed files", default => 0, applicable => \&can_finder, ); # TODO # option median_durations => ( # type => 'b', # description => "Get median duration data", # default => 0, # ); option medium_duration => ( type => 's', description => "Minimum duration length (seconds) before a test goes from SHORT to MEDIUM", long_examples => [' 5'], default => 5, ); option long_duration => ( type => 's', description => "Minimum duration length (seconds) before a test goes from MEDIUM to LONG", long_examples => [' 10'], default => 10, ); option upload => ( description => "Upload the log to Yath-UI", default => 0, applicable => \&can_log, ); post -1 => sub { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $has_finder = $options->included->{'App::Yath::Options::Finder'}; my $has_logger = $options->included->{'App::Yath::Options::Logging'}; my $has_durations = $has_finder && $settings->yathui->durations; my $has_upload = $has_logger && $settings->yathui->upload; my $has_coverage = $has_finder && $settings->yathui->coverage; return unless $has_durations || $has_upload || $has_coverage; my $url = $settings->yathui->url or die "'--yathui-url URL' is required to use durations, coverage, or upload a log"; my $project = $settings->yathui->project or die "'--yathui-project NAME' is required to use durations, coverage, or upload a log"; my $grace = $settings->yathui->grace; $url =~ s{/+$}{}g; if ($has_upload) { $settings->logging->field(log => 1); $settings->logging->field(bzip2 => 1); } if ($has_coverage) { my $curl = join '/' => ($url, 'coverage', $project); $settings->cover->field(($grace ? 'maybe_from' : 'from'), $curl); } if ($has_durations) { my $med = $settings->yathui->medium_duration; my $long = $settings->yathui->long_duration; my $durl = join '/' => ($url, 'durations', $project, $med, $long); $settings->finder->field(($grace ? 'maybe_durations' : 'durations'), $durl); } return; }; }; sub grab_rerun { my $this = shift; my ($rerun, %params) = @_; return (0) if $rerun =~ m/\.jsonl(\.gz|\.bz2)?/; my $settings = $params{settings}; my $mode_hash = $params{mode_hash}; my $path; if ($rerun eq '1') { my $project = $settings->yathui->project or return (0); my $user = $settings->yathui->user // $ENV{USER}; $path = "$project/$user"; print "Re-run requested with no paremeters, ${ \__PACKAGE__ } querying YathUI (web request) for last run matching $path...\n"; # API Qwerk :-/ $path .= '/0'; } elsif (looks_like_uuid($rerun)) { $path = "$rerun"; print "Re-run requested with UUID, ${ \__PACKAGE__ } querying YathUI (web request) for matching run, or latest run from project or user matching the UUID\n"; } else { return (0); } $path = "rerun/$path"; my ($ok, $res, $data) = $this->_request($settings, $path, {json => 1}); if (!$ok) { print "Error getting a re-run data from yathui: $data...\n"; return (1); } return (1, $data); } sub _request { my $this = shift; my ($settings, $path, $payload) = @_; my $url = $settings->yathui->url; $url =~ s{/+$}{}g; $url = join "/" => ($url, $path); my %fields; for my $field (qw/project api_key mode/) { my $val = $settings->yathui->field($field) or next; $fields{$field} = $val; } require HTTP::Tiny; eval { require HTTP::Tiny::Multipart; 1 } or die "To use --yathui-* you must install HTTP::Tiny::Multipart.\n"; my $res; for (0 .. $settings->yathui->retry) { my $http = HTTP::Tiny->new; $res = $http->post_multipart( $url => { headers => {'Content-Type' => 'application/json'}, %fields, %$payload, }, ); next unless $res; last if $res->{status} eq '200'; } my ($ok, $msg); if ($res && $res->{status} eq '200') { my $data; $ok = eval { $data = decode_json($res->{content}); 1 }; if ($ok) { return (1, $res, $data); } else { $msg = $@; } } else { if ($res) { $msg = "Server responded with " . $res->{status} . ":\n" . ($res->{content} // 'NO CONTENT'); } else { $msg = "Failed to upload yathui log, no response object"; } } return (0, $res, $msg); } sub finish { my $this = shift; my %params = @_; my $settings = $params{settings}; return unless $settings->yathui->upload; my $log_file = $settings->logging->log_file; my ($filename) = reverse File::Spec->splitpath($log_file); my ($ok, $res, $data) = $this->_request( $settings, 'upload', { log_file => { filename => $filename, content => read_file($log_file, no_decompress => 1), content_type => 'application/x-bzip2', }, action => 'Upload Log', json => 1, } ); die "Error connecting to YathUI: $data\n" unless $ok; my $msg; if ($data->{errors} && @{$data->{errors}}) { $ok = 0; $msg = join "\n" => (@{$data->{errors}}); } elsif ($data->{messages}) { $ok = 1; my $url = $settings->yathui->url; $url =~ s{/+$}{}g; $msg = join "\n" => ( @{$data->{messages}}, $data->{run_id} ? ("YathUI run url: " . join '/' => ($url, 'run', $data->{run_id})) : (), ); } else { $ok = 0; $msg = "No messages recieved"; } chomp($msg); $msg = "YathUI Upload: $msg"; if ($ok) { print "\n$msg\n"; } else { if ($settings->yathui->grace) { warn $msg; } else { die $msg; } } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::YathUI - Plugin to interact with a YathUI server =head1 DESCRIPTION If you have a Yath-UI L<Test2::Harness::UI> server, you can use this module to have yath automatically upload logs or retrieve durations data =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Stream.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 27621�15267772575� 22333� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Formatter�����������������������������������������������������������������������������������������������������������������������������package Test2::Formatter::Stream; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak confess/; use Time::HiRes qw/time/; use IO::Handle; use File::Spec(); use List::Util qw/first/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/JSON JSON_IS_XS/; use Test2::Harness::Util qw/hub_truth apply_encoding/; use Test2::Util qw/get_tid ipc_separator/; use parent qw/Test2::Formatter/; use Test2::Util::HashBase qw/-io _encoding _no_header _no_numbers _no_diag -stream_id -tb -tb_handles -dir -_pid -_tid -_fh <job_id -ugids/; BEGIN { my $J = JSON->new; $J->indent(0); $J->convert_blessed(1); $J->allow_blessed(1); $J->utf8(1); require constant; constant->import(ENCODER => $J); if (JSON_IS_XS) { require JSON::PP; my $JPP = JSON::PP->new; $JPP->indent(0); $JPP->convert_blessed(1); $JPP->allow_blessed(1); $JPP->utf8(1); constant->import(ENCODER_PP => $JPP); } } my ($ROOT_TID, $ROOT_PID, $ROOT_DIR, $ROOT_JOB_ID, $ROOT_UGIDS); sub import { my $class = shift; my %params = @_; confess "$class no longer accept the 'file' argument, it now takes a 'dir' argument" if exists $params{file}; $class->SUPER::import(); $ROOT_PID = $$; $ROOT_TID = get_tid(); $ROOT_DIR = $params{dir} if $params{dir}; $ROOT_JOB_ID = $params{job_id} if $params{job_id}; $ROOT_UGIDS = [$<, $>, $(, $)]; if ($ROOT_DIR && ! -d $ROOT_DIR) { mkdir($ROOT_DIR) or die "Could not make root dir: $!"; } } sub hide_buffered { 0 } sub fh { my $self = shift; my $dir = $self->{+DIR} or return undef; my $pid = $self->{+_PID}; my $tid = $self->{+_TID}; if ($pid && $pid != $$) { delete $self->{+_PID}; delete $self->{+_FH}; } if ($tid && $tid != get_tid()) { delete $self->{+_TID}; delete $self->{+_FH}; } return $self->{+_FH} if $self->{+_FH}; $self->{+STREAM_ID} = 1; $pid = $self->{+_PID} = $$; $tid = $self->{+_TID} = get_tid(); my $file = File::Spec->catfile($dir, join(ipc_separator() => 'events', $pid, $tid) . ".jsonl"); my @now = ($<, $>, $(, $)); local ($<, $>, $(, $)) = @{$self->{+UGIDS}} if $self->{+UGIDS} && first { $self->{+UGIDS}->[$_] ne $now[$_] } 0 .. $#now; mkdir($dir) or die "Could not make dir '$dir': $!" unless -d $dir; confess "File '$file' already exists!" if -f $file; open(my $fh, '>', $file) or die "Could not open file: $file"; $fh->autoflush(1); # Do not apply encoding to the UTF8 output, we let the utf8 formatter # handle that. This means do not apply encoding to $self->{+_FH}. return $self->{+_FH} = $fh; } sub init { my $self = shift; $self->{+STREAM_ID} = 1; $self->{+UGIDS} //= [$<, $>, $(, $)]; # To create necessary directories as soon as possible $self->fh(); for (@{$self->{+IO}}) { $_->autoflush(1); } STDOUT->autoflush(1); STDERR->autoflush(1); if ($INC{'Test2/API.pm'}) { Test2::API::test2_stdout()->autoflush(1); Test2::API::test2_stderr()->autoflush(1); } if ($self->{check_tb}) { require Test::Builder::Formatter; $self->{+TB} = Test::Builder::Formatter->new(); $self->{+TB_HANDLES} = [@{$self->{+TB}->handles}]; } } sub new_root { my $class = shift; my %params = @_; $ROOT_PID = $$ unless defined $ROOT_PID; $ROOT_TID = get_tid() unless defined $ROOT_TID; confess "new_root called from child process!" if $ROOT_PID != $$; confess "new_root called from child thread!" if $ROOT_TID != get_tid(); require Test2::API; my $io = $params{+IO} = [Test2::API::test2_stdout(), Test2::API::test2_stderr()]; $_->autoflush(1) for @$io; confess "T2_STREAM_FILE is no longer used, see T2_STREAM_DIR" if exists $ENV{T2_STREAM_FILE}; $params{+DIR} ||= $ENV{T2_STREAM_DIR} || $ROOT_DIR; $params{+JOB_ID} ||= $ENV{T2_STREAM_JOB_ID} || $ROOT_JOB_ID || 1; # DO NOT REOPEN THEM! delete $ENV{T2_FORMATTER} if $ENV{T2_FORMATTER} && $ENV{T2_FORMATTER} eq 'Stream'; delete $ENV{T2_STREAM_DIR}; delete $ENV{T2_STREAM_JOB_ID}; $ROOT_DIR = undef; $params{check_tb} = 1 if $INC{'Test/Builder.pm'}; $params{+UGIDS} = $ROOT_UGIDS if $ROOT_UGIDS; return $class->new(%params); } sub record { my $self = shift; my ($facets, $num) = @_; my $stamp = time; my $times = [times]; my @sync = @{$self->{+IO}}; my $leader = 0; my $fh = $self->fh; unless($fh) { $leader = 1; $fh = shift @sync; } if ($facets->{control}->{halt}) { my $reason = $facets->{control}->{details} || ""; if ($leader) { print $fh "\nBail out! $reason\n"; } else { open(my $bh, '>', File::Spec->catfile($self->{+DIR}, 'bail')) or die "Could not create bail file: $!"; print $bh $reason; close($bh); } } my $tid = get_tid(); my $id = $self->{+STREAM_ID}++; my $json; { no warnings 'once'; local *UNIVERSAL::TO_JSON = sub { "$_[0]" }; my $event_id = $facets->{about}->{uuid} ||= gen_uuid(); if (JSON_IS_XS) { for my $encoder (ENCODER, ENCODER_PP) { local $@; my $ok = eval { $json = $encoder->encode( { stamp => $stamp, times => $times, stream_id => $id, tid => $tid, pid => $$, event_id => $event_id, facet_data => $facets, assert_count => $self->{+_NO_NUMBERS} ? undef : $num, } ); 1; }; my $err = $@; last if $ok; # Intercept bug in JSON::XS so we can fall back to JSON::PP next if $encoder eq ENCODER && $err =~ m/Modification of a read-only value attempted/; # Different error, time to die. die $err; } } else { $json = ENCODER->encode( { stamp => $stamp, times => $times, stream_id => $id, tid => $tid, pid => $$, event_id => $event_id, facet_data => $facets, assert_count => $self->{+_NO_NUMBERS} ? undef : $num, } ); } } # Local is expensive! Only do it if we really need to. local($\, $,) = (undef, '') if $\ || $,; my $job_id = $self->{+JOB_ID}; print $fh $leader ? ("T2-HARNESS-$job_id-EVENT: ", $json, "\n") : ($json, "\n"); print $_ "T2-HARNESS-$job_id-ESYNC: ", join(ipc_separator() => $$, $tid, $id) . "\n" for @sync; } sub encoding { my $self = shift; if (@_) { my ($enc) = @_; $self->record({control => {encoding => $enc}}); $self->_set_encoding($enc); $self->{+TB}->encoding($enc) if $self->{+TB}; } return $self->{+_ENCODING}; } sub _set_encoding { my $self = shift; if (@_) { my ($enc) = @_; # Do not apply encoding to the UTF8 output, we let the utf8 formatter # handle that. This means do not apply encoding to $self->{+_FH}. apply_encoding(\*STDOUT, $enc); apply_encoding(\*STDERR, $enc); my $job_id = $self->{+JOB_ID}; for my $fh (@{$self->{+IO}}) { print $fh "T2-HARNESS-$job_id-ENCODING: $enc\n"; apply_encoding($fh, $enc); } } return $self->{+_ENCODING}; } if ($^C) { no warnings 'redefine'; *write = sub { }; } sub write { my ($self, $e, $num, $f) = @_; $f ||= $e->facet_data; $self->_set_encoding($f->{control}->{encoding}) if $f->{control}->{encoding}; # Hide these if we must, but do not remove them for good. local $f->{info} if $self->{+_NO_DIAG}; local $f->{plan} if $self->{+_NO_HEADER}; my $tb_only = 0; if ($self->{+TB}) { $tb_only ||= $self->{+TB_HANDLES}->[0] != $self->{+TB}->{handles}->[0]; $tb_only ||= $self->{+TB_HANDLES}->[1] != $self->{+TB}->{handles}->[1]; my $todo_match = $self->{+TB_HANDLES}->[0] == $self->{+TB}->{handles}->[2] || $self->{+TB_HANDLES}->[1] == $self->{+TB}->{handles}->[2]; $tb_only ||= !$todo_match; if ($tb_only) { my $buffered = hub_truth($f)->{buffered}; $self->{+TB}->write($e, $num, $f) if $self->{+TB} && !$buffered; return; } } $self->record($f, $num); } sub no_header { $_[0]->{+_NO_HEADER} } sub no_diag { $_[0]->{+_NO_DIAG} } sub no_numbers { $_[0]->{+_NO_NUMBERS} } sub handles { my $self = shift; return $self->{+TB}->handles if $self->{+TB}; return; } sub set_no_header { my $self = shift; ($self->{+_NO_HEADER}) = @_; $self->{+TB}->set_no_header(@_) if $self->{+TB}; $self->{+_NO_HEADER}; } sub set_no_diag { my $self = shift; ($self->{+_NO_DIAG}) = @_; $self->{+TB}->set_no_diag(@_) if $self->{+TB}; $self->{+_NO_DIAG}; } sub set_no_numbers { my $self = shift; ($self->{+_NO_NUMBERS}) = @_; $self->{+TB}->set_no_numbers(@_) if $self->{+TB}; $self->{+_NO_NUMBERS}; } sub set_handles { my $self = shift; return $self->{+TB}->set_handles(@_) if $self->{+TB}; return; } sub terminate { my $self = shift; return $self->SUPER::terminate(@_) unless $self->{+TB}; return $self->{+TB}->terminate(@_); } sub finalize { my $self = shift; return $self->SUPER::finalize(@_) unless $self->{+TB}; return $self->{+TB}->finalize(@_); } sub DESTROY {} our $AUTOLOAD; sub AUTOLOAD { my $this = shift; my $meth = $AUTOLOAD; $meth =~ s/^.*:://g; my $type = ref($this); return $this->{+TB}->$meth(@_) if $type && $this->{+TB} && $this->{+TB}->can($meth); $type ||= $this; croak qq{Can't locate object method "$meth" via package "$type"}; } sub isa { my $in = shift; return $in->SUPER::isa(@_) unless ref($in) && $in->{+TB}; return $in->SUPER::isa(@_) || $in->{+TB}->isa(@_); } sub can { my $in = shift; return $in->SUPER::can(@_) unless ref($in) && $in->{+TB}; return $in->SUPER::can(@_) || $in->{+TB}->can(@_); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Stream - Test2 Formatter that directly writes events. =head1 DESCRIPTION This formatter writes all test2 events to event files (one per process/thread) instead of writing them to STDERR/STDOUT. It will output synchronization messages to STDERR/STDOUT every time an event is written. From this data the test output can be properly reconstructed in order with STDERR/STDOUT and events mostly synced so that they appear in the correct order. This formatter is not usually useful to humans. This formatter is used by L<Test2::Harness> when possible to prevent the loss of data that normally occurs when TAP is used. =head1 SYNOPSIS If you really want your test to output this: use Test2::Formatter::Stream; use Test2::V0; ... Otherwise just use L<App::Yath> without the C<--no-stream> argument and this formatter will be used when possible. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������Renderer.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 6003�15267772575� 22255� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Renderer; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Util::HashBase qw/-settings -verbose -progress -color -command_class/; sub render_event { croak "$_[0] forgot to override 'render_event()'" } sub step {} sub finish { } sub signal { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Renderer - Base class for Test2::Harness event renderers. =head1 DESCRIPTION =head1 ATTRIBUTES These are set at construction time and cannot be changed. =over 4 =item $settings = $renderer->settings Get the L<Test2::Harness::Settings> reference. =item $int = $renderer->verbose Get the verbosity level. =item $bool = $renderer->progress True if progress indicators should be shown. =item $bool = $renderer->color True if color should be used. =back =head1 METHODS =over 4 =item $renderer->render_event($event) Called for every event. Return is ignored. =item $renderer->finish(%ARGS) Called once after testing is done. C<%ARGS>: =item $renderer->signal($signal) Called when the rendering process receives a signal. This is your chance to do any cleanup or report the signal. This is not an event, you can ignore it. Do not exit or throw any exceptions here please. =over 4 =item settings => $settings Get the L<Test2::Harness::Settings> reference. =item pass => $bool True if tests passed. =item tests_seen => $int Number of test files seen. =item asserts_seen => $int Number of assertions made. =item final_data => $final_data The final_data looks like this, note that some data may not be present if it is not applicable. The data structure can be as simple as C<< { pass => $bool } >>. { pass => $pass, # boolean, did the test run pass or fail? failed => [ # Jobs that failed, and did not pass on a retry [$job_id1, $file1], # Failing job 1 [$job_id2, $file2], # Failing job 2 ... ], retried => [ # Jobs that failed and were retried [$job_id1, $times_run1, $file1, $passed_eventually1], # Passed_eventually is a boolean [$job_id2, $times_run2, $file2, $passed_eventually2], ... ], hatled => [ # Jobs that caused the entire test suite to halt [$job_id1, $file1, $halt_reason1], # halt_reason is a human readible string [$job_id2, $file2, $halt_reason2], ], } =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Settings.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 10402�15267772575� 22325� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Settings; use strict; use warnings; our $VERSION = '1.000182'; use Carp(); use Scalar::Util(); use Test2::Harness::Settings::Prefix; sub new { my $class = shift; my $hash; if (@_ == 1) { require Test2::Harness::Util::File::JSON; my $settings_file = Test2::Harness::Util::File::JSON->new(name => $_[0]); $hash = $settings_file->read; } else { $hash = {@_}; } for my $key (keys %$hash) { my $val = delete $hash->{$key}; if (Scalar::Util::blessed($val)) { Carp::croak("All prefixes must contain instances of Test2::Harness::Settings::Prefix") unless $val->isa('Test2::Harness::Settings::Prefix'); $hash->{$key} = $val; next; } Carp::croak("All prefixes must be defined as hashes") unless ref($val) eq 'HASH'; $hash->{$key} = Test2::Harness::Settings::Prefix->new(%$val); } return bless(\$hash, $class); } sub define_prefix { my $self = shift; my ($prefix) = @_; return ${$self}->{$prefix} //= Test2::Harness::Settings::Prefix->new; } sub check_prefix { my $self = shift; my ($prefix) = @_; return exists(${$self}->{$prefix}); } sub prefix { my $self = shift; my ($prefix, @args) = @_; Carp::croak("Too many arguments for prefix()") if @args; Carp::croak("The '$prefix' prefix is not defined") unless ${$self}->{$prefix}; return ${$self}->{$prefix}; } sub build { my $self = shift; my ($prefix, $class, @args) = @_; my $p = $self->prefix($prefix); $p->build($class, @args); } our $AUTOLOAD; sub AUTOLOAD { my $this = shift; my $prefix = $AUTOLOAD; $prefix =~ s/^.*:://g; return if $prefix eq 'DESTROY'; Carp::croak("Method $prefix() must be called on a blessed instance") unless ref($this); Carp::croak("Too many arguments for $prefix()") if @_; $this->prefix($prefix); } sub TO_JSON { my $self = shift; return {%$$self}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Settings - Configuration settings for Test2::Harness. =head1 DESCRIPTION This module represents the options provided at the command line. Each option has a prefix, and each prefix can be accessed from the settings. =head1 SYNOPSIS # You will rarely if ever need to construct settings yourself, usually a # component of Test2::Harness will expose them to you. my $settings = $thing->settings; # All prefixes have a method generated for them via AUTOLOAD my $display = $settings->display; # You can also use the prefix method my $display = $settings->prefix('display'); # The prefix can be used in a similar way my $verbose = $settings->display->verbose; See L<Test2::Harness::Settings::Prefix> for more details on how to use the prefixes. =head1 METHODS Note that any prefix that does not conflict with the predefined methods can be accessed via AUTOLOAD generating the methods as needed. =over 4 =item $settings->define_prefix($prefix_name) This is used to create a prefix. =item $bool = $settings->check_prefix($prefix_name) This is used to check if a prefix is defined or not. =item $prefix = $settings->prefix($prefix_name) =item $prefix = $settings->$prefix_name This will retrieve a prefix if it exists. If the prefix is not defined this will throw an exception. If you are unsure if a prefix exists use C<$settings->check_prefix($prefix_name)>. =item $thing = $settings->build($prefix_name, $class, @args) This will create an instance of C<$class> passing the key/value pairs from the specified prefix as arguments. Additional arguments can be provided in C<@args>. =item $hashref = $settings->TO_JSON() This method allows settings to be serialized into JSON. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TestFile.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 46005�15267772575� 22254� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::TestFile; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Time::HiRes qw/time/; use List::Util 1.45 qw/uniq/; use Test2::Harness::Util qw/open_file clean_path/; use Test2::Harness::Util::UUID qw/gen_uuid/; use File::Spec; use Test2::Harness::Util::HashBase qw{ <file +relative <_scanned <_headers +_shbang <is_binary <non_perl input env_vars test_args queue_args job_class comment _category _stage _duration _min_slots _max_slots }; sub set_duration { $_[0]->set__duration(lc($_[1])) } sub set_category { $_[0]->set__category(lc($_[1])) } sub set_stage { $_[0]->set__stage($_[1]) } sub set_min_slots { $_[0]->set__min_slots($_[1]) } sub set_max_slots { $_[0]->set__max_slots($_[1]) } sub retry { $_[0]->headers->{retry} } sub set_retry { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{retry} = $val; } sub retry_isolated { $_[0]->headers->{retry_isolated} } sub set_retry_isolated { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{retry_isolated} = $val; } sub set_smoke { my $self = shift; my $val = @_ ? $_[0] : 1; $self->scan; $self->{+_HEADERS}->{features}->{smoke} = $val; } sub init { my $self = shift; my $file = $self->file; # We want absolute path $file = clean_path($file, 0); $self->{+FILE} = $file; $self->{+QUEUE_ARGS} ||= []; croak "Invalid test file '$file'" unless -f $file; if($self->{+IS_BINARY} = -B $file && !-z $file) { $self->{+NON_PERL} = 1; die "Cannot run binary test file '$file': file is not executable.\n" unless $self->is_executable; } } sub relative { my $self = shift; return $self->{+RELATIVE} //= File::Spec->abs2rel($self->{+FILE}); } my %DEFAULTS = ( timeout => 1, fork => 1, preload => 1, stream => 1, run => 1, isolation => 0, smoke => 0, io_events => 1, ); sub check_feature { my $self = shift; my ($feature, $default) = @_; $default = $DEFAULTS{$feature} unless defined $default; return $default unless defined $self->headers->{features}->{$feature}; return 1 if $self->headers->{features}->{$feature}; return 0; } sub check_stage { my $self = shift; return $self->{+_STAGE} if $self->{+_STAGE}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{stage} || undef; } sub check_min_slots { my $self = shift; return $self->{+_MIN_SLOTS} if $self->{+_MIN_SLOTS}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{min_slots} // undef; } sub check_max_slots { my $self = shift; return $self->{+_MAX_SLOTS} if $self->{+_MAX_SLOTS}; $self->_scan unless $self->{+_SCANNED}; return $self->{+_HEADERS}->{max_slots} // undef; } sub meta { my $self = shift; my ($key) = @_; $self->_scan unless $self->{+_SCANNED}; my $meta = $self->{+_HEADERS}->{meta} or return (); return () unless $key && $meta->{$key}; return @{$meta->{$key}}; } sub check_duration { my $self = shift; return $self->{+_DURATION} if $self->{+_DURATION}; $self->_scan unless $self->{+_SCANNED}; my $duration = $self->{+_HEADERS}->{duration}; return $duration if $duration; my $timeout = $self->check_feature(timeout => 1); # 'long' for anything with no timeout return 'long' unless $timeout; return 'medium'; } sub check_category { my $self = shift; return $self->{+_CATEGORY} if $self->{+_CATEGORY}; $self->_scan unless $self->{+_SCANNED}; my $category = $self->{+_HEADERS}->{category}; return $category if $category; my $isolate = $self->check_feature(isolation => 0); # 'isolation' queue if isolation requested return 'isolation' if $isolate; return 'general'; } sub event_timeout { $_[0]->headers->{timeout}->{event} } sub post_exit_timeout { $_[0]->headers->{timeout}->{postexit} } sub conflicts_list { return $_[0]->headers->{conflicts} || []; # Assure conflicts is always an array ref. } sub shares_list { return $_[0]->headers->{shares} || []; # Assure shares is always an array ref. } sub headers { my $self = shift; $self->_scan unless $self->{+_SCANNED}; return {} unless $self->{+_HEADERS}; return {%{$self->{+_HEADERS}}}; } sub shbang { my $self = shift; $self->_scan unless $self->{+_SCANNED}; return {} unless $self->{+_SHBANG}; return {%{$self->{+_SHBANG}}}; } sub switches { my $self = shift; my $shbang = $self->shbang or return []; my $switches = $shbang->{switches} or return []; return $switches; } sub is_executable { my $self = shift; my ($file) = @_; $file //= $self->{+FILE}; return -x $file; } sub scan { my $self = shift; $self->_scan(); return; } sub _scan { my $self = shift; return if $self->{+_SCANNED}++; return if $self->{+IS_BINARY}; my $fh = open_file($self->{+FILE}); my $comment = $self->{+COMMENT} // '#'; my %headers; for (my $ln = 1; my $line = <$fh>; $ln++) { chomp($line); next if $line =~ m/^\s*$/; if ($ln == 1 && $line =~ m/^#!/) { my $shbang = $self->_parse_shbang($line); if ($shbang) { $self->{+_SHBANG} = $shbang; if ($shbang->{non_perl}) { $self->{+NON_PERL} = 1; } next; } } # Uhg, breaking encapsulation between yath and the harness if ($line =~ m/^\s*#\s*THIS IS A GENERATED YATH RUNNER TEST/) { $headers{features}->{run} = 0; next; } next if $line =~ m/^\s*#/ && $line !~ m/^\s*#\s*HARNESS-.+/; # Ignore commented lines which aren't HARNESS-? next if $line =~ m/^\s*(use|require|BEGIN|package)\b/; # Only supports single line BEGINs last unless $line =~ m/^\s*\Q$comment\E\s*HARNESS-(.+)$/; my ($dir, $rest) = split /[-\s]+/, $1, 2; $dir = lc($dir); my @args; if ($dir eq 'meta') { @args = split /\s+/, $rest, 2; # Check for white space delimited @args = split(/[-]+/, $rest, 2) if scalar @args == 1; # Check for dash delimited $args[1] =~ s/\s+(?:#.*)?$// if defined $args[1]; # Strip trailing white space and comment if present } elsif ($rest) { $rest =~ s/\s+(?:#.*)?$//; # Strip trailing white space and comment if present @args = split /[-\s]+/, $rest; } if ($dir eq 'no') { my $feature = lc(join '_' => @args); if ($feature eq 'retry') { $headers{retry} = 0 } else { $headers{features}->{$feature} = 0; } } elsif ($dir eq 'smoke') { $headers{features}->{smoke} = 1; } elsif ($dir eq 'retry') { $headers{retry} = 1 unless @args || defined $headers{retry}; for my $arg (@args) { if ($arg =~ m/^\d+$/) { $headers{retry} = int $arg; } elsif ($arg =~ m/^iso/i) { $headers{retry} //= 1; $headers{retry_isolated} = 1; } else { warn "Unknown 'HARNESS-RETRY' argument '$arg' at $self->{+FILE} line $ln.\n"; } } } elsif ($dir eq 'yes' || $dir eq 'use') { my $feature = lc(join '_' => @args); $headers{features}->{$feature} = 1; } elsif ($dir eq 'stage') { my ($name) = @args; $headers{stage} = $name; } elsif ($dir eq 'meta') { my ($key, $val) = @args; $key = lc($key); push @{$headers{meta}->{$key}} => $val; } elsif ($dir eq 'duration' || $dir eq 'dur') { my ($name) = @args; $name = lc($name); $headers{duration} = $name; } elsif ($dir eq 'category' || $dir eq 'cat') { my ($name) = @args; $name = lc($name); if ($name =~ m/^(long|medium|short)$/i) { $headers{duration} = $name; } else { $headers{category} = $name; } } elsif ($dir eq 'conflicts') { my @conflicts_array; foreach my $arg (@args) { push @conflicts_array, lc($arg); } # Allow multiple lines with # HARNESS-CONFLICTS FOO $headers{conflicts} ||= []; push @{$headers{conflicts}}, @conflicts_array; # Make sure no more than 1 conflict is ever present. @{$headers{conflicts}} = uniq @{$headers{conflicts}}; } elsif ($dir eq 'shares') { # Allow multiple lines with # HARNESS-SHARES FOO $headers{shares} ||= []; push @{$headers{shares}}, map { lc($_) } @args; # Make sure no more than 1 share of a name is ever present. @{$headers{shares}} = uniq @{$headers{shares}}; } elsif ($dir eq 'timeout') { my ($type, $num, $extra) = @args; $type = lc($type); $num = lc($num); ($type, $num) = ('postexit', $extra) if $type eq 'post' && $num eq 'exit'; warn "'" . uc($type) . "' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at $self->{+FILE} line $ln.\n" unless $type =~ m/^(event|postexit)$/; $headers{timeout}->{$type} = $num; } elsif ($dir eq 'job' && $rest =~ m/slots\s+(\d+)(?:\s+(\d+))?$/i) { $headers{min_slots} //= $1; $headers{max_slots} //= $2 ? $2 : $1; } else { warn "Unknown harness directive '$dir' at $self->{+FILE} line $ln.\n"; } } # An exclusive lock on a name gazumps a shared one, so if a file asks for # both we keep the exclusive and drop the shared. This is probably a # mistake on the author's part, so warn. if ($headers{conflicts} && $headers{shares}) { my %exclusive = map { ($_ => 1) } @{$headers{conflicts}}; for my $both (grep { $exclusive{$_} } @{$headers{shares}}) { warn "'$both' is listed as both a conflict and a share in $self->{+FILE}, treating it as a conflict.\n"; } @{$headers{shares}} = grep { !$exclusive{$_} } @{$headers{shares}}; } $self->{+_HEADERS} = \%headers; } sub _parse_shbang { my $self = shift; my $line = shift; return {} if !defined $line; my %shbang; # NOTE: Test this, the dashes should be included with the switches my $shbang_re = qr{ ^ \#!.*perl.*? # the perl path (?: \s (-.+) )? # the switches, maybe \s* $ }xi; if ($line =~ $shbang_re) { my @switches; @switches = grep { m/\S/ } split /\s+/, $1 if defined $1; $shbang{switches} = \@switches; $shbang{line} = $line; } elsif ($line =~ m/^#!/ && $line !~ m/perl/i) { $shbang{line} = $line; $shbang{non_perl} = 1; } return \%shbang; } sub queue_item { my $self = shift; my ($job_name, $run_id, %inject) = @_; die "The '$self->{+FILE}' test specifies that it should not be run by Test2::Harness.\n" unless $self->check_feature(run => 1); my $category = $self->check_category; my $duration = $self->check_duration; my $stage = $self->check_stage; my $min_slots = $self->check_min_slots; my $max_slots = $self->check_max_slots; my $smoke = $self->check_feature(smoke => 0); my $fork = $self->check_feature(fork => 1); my $preload = $self->check_feature(preload => 1); my $timeout = $self->check_feature(timeout => 1); my $stream = $self->check_feature(stream => 1); my $io_events = $self->check_feature(io_events => 1); my $retry = $self->retry; my $retry_isolated = $self->retry_isolated; my $binary = $self->{+IS_BINARY} ? 1 : 0; my $non_perl = $self->{+NON_PERL} ? 1 : 0; my $et = $self->event_timeout; my $pet = $self->post_exit_timeout; my $job_class = $self->job_class; my $input = $self->input; my $test_args = $self->test_args; my $env_vars = $self->env_vars; if ($env_vars) { my $mix = delete $inject{env_vars}; $env_vars = {%$mix, %$env_vars} if $mix; } return { binary => $binary, category => $category, conflicts => $self->conflicts_list, shares => $self->shares_list, duration => $duration, file => $self->file, rel_file => $self->relative, job_id => gen_uuid(), job_name => $job_name, run_id => $run_id, non_perl => $non_perl, stage => $stage, stamp => time, switches => $self->switches, use_fork => $fork, use_preload => $preload, use_stream => $stream, use_timeout => $timeout, smoke => $smoke, io_events => $io_events, rank => $self->rank, defined($input) ? (input => $input) : (), defined($env_vars) ? (env_vars => $env_vars) : (), defined($test_args) ? (test_args => $test_args) : (), defined($job_class) ? (job_class => $job_class) : (), defined($retry) ? (retry => $retry) : (), defined($retry_isolated) ? (retry_isolated => $retry_isolated) : (), defined($et) ? (event_timeout => $et) : (), defined($pet) ? (post_exit_timeout => $self->post_exit_timeout) : (), defined($min_slots) ? (min_slots => $min_slots) : (), defined($max_slots) ? (max_slots => $max_slots) : (), @{$self->{+QUEUE_ARGS}}, %inject, }; } my %RANK = ( smoke => 1, immiscible => 10, long => 20, medium => 50, short => 80, isolation => 100, ); sub rank { my $self = shift; return $RANK{smoke} if $self->check_feature('smoke'); my $rank = $RANK{$self->check_category}; $rank ||= $RANK{$self->check_duration}; $rank ||= 1; return $rank; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::TestFile - Abstraction of a test file and its meta-data. =head1 DESCRIPTION When Test2::Harness finds test files to run each one gets an instance of this class to represent it. This class will scan test files to find important meta data (binary vs script, inline harness directives, etc). The meta-data this class can find helps yath decide when and how to run the test. If you write a custom L<Test2::Harness::Finder> or use some L<Test2::Harness::Plugin> callbacks you may have to use, or even construct instances of this class. =head1 SYNOPSIS use Test2::Harness::TestFile; my $tf = Test2::Harness::TestFile->new(file => "path/to/file.t"); # For an example 1, 1 works, but normally they are job_name and run_id. my $meta_data = $tf->queue_item(1, 1); =head1 ATTRIBUTES =over 4 =item $filename = $tf->file Set during object construction, and cannot be changed. =item $bool = $tf->is_binary Automatically set during construction, cannot be changed or set manually. =item $bool = $tf->non_perl Automatically set during construction, cannot be changed or set manually. =item $string = $tf->comment =item $tf->set_comment($string) Defaults to '#' can be set during construction, or changed if needed. This is used to tell yath what character(s) are used to denote a comment. This is necessary for finding harness directives. In perl the '#' character is used, and that is the default value. This is here to support non-perl tests. =item $class = $tf->job_class =item $tf->set_job_class($class) Default it undef (let the runner pick). You can change this if you want the test to run with a custom job subclass. =item $arrayref = $tf->queue_args =item $tf->set_queue_args(\@ARGS) Key/Value pairs to append to the queue_item() data. =back =head1 METHODS =over 4 =item $cat = $tf->check_category() =item $tf->set_category($cat) This is how you find the category for a file. You can use C<set_category()> to assign/override a category. =item $dur = $tf->check_duration() =item $tf->set_duration($dur) Get the duration of the test file ('LONG', 'MEDIUM', 'SHORT'). You can override with C<set_duration()>. =item $stage = $tf->check_stage() =item $tf->set_stage($stage) Get the preload stage the test file thinks it should be run in. You can override with C<set_stage()>. =item $bool = $tf->check_feature($name) This checks for the C<# HARNESS-NO-NAME> or C<# HARNESS-USE-NAME> or C<# HARNESS-YES-NAME> directives. C<NO> will result in a false boolean. C<YES> and C<USE> will result in a true boolean. If no directive is found then C<undef> will be returned. =item $arrayref = $tf->conflicts_list() Get a list of conflict markers. =item $arrayref = $tf->shares_list() Get a list of shared-use markers. =item $seconds = $tf->event_timeout() If they test specifies an event timeout this will return it. =item %headers = $tf->headers() This returns the header data from the test file. =item $bool = $tf->is_executable() Check if the test file is executable or not. =item $data = $tf->meta($key) Get the meta-data for the specific key. =item $seconds = $tf->post_exit_timeout() If the test file has a custom post-exit timeout, this will return it. =item $hashref = $tf->queue_item($job_name, $run_id) This returns the data used to add the test file to the runner queue. =item $int = $tf->rank() Returns an integer value used to sort tests into an efficient run order. =item $path = $tf->relative() Relative path to the test file. =item $tf->scan() Scan the file and populate the header data. Return nothing, takes no arguments. Automatically run by things that require the scan data. Results are cached. =item $tf->set_smoke($bool) Set smoke status. Smoke tests go to the front of the line when tests are sorted. =item $hashref = $tf->shbang() Get data gathered from parsing the tests shbang line. =item $arrayref = $tf->switches() A list of switches passed to perl, usually from the shbang line. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Util������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20727� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������IPC.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 21177�15267772575� 22070� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::IPC; use strict; use warnings; our $VERSION = '1.000182'; use Cwd qw/getcwd/; use Config qw/%Config/; use Test2::Util qw/CAN_REALLY_FORK/; use Importer Importer => 'import'; our @EXPORT_OK = qw{ USE_P_GROUPS run_cmd swap_io }; BEGIN { if ($Config{'d_setpgrp'}) { *USE_P_GROUPS = sub() { 1 }; } else { *USE_P_GROUPS = sub() { 0 }; } } if (CAN_REALLY_FORK) { *run_cmd = \&_run_cmd_fork; } else { *run_cmd = \&_run_cmd_spwn; } sub swap_io { my ($fh, $to, $die, $mode) = @_; $die ||= sub { my @caller = caller; my @caller2 = caller(1); die("$_[0] at $caller[1] line $caller[2] ($caller2[1] line $caller2[2], ${ \__FILE__ } line ${ \__LINE__ }).\n"); }; my $orig_fd; if (ref($fh) eq 'ARRAY') { ($orig_fd, $fh) = @$fh; } else { $orig_fd = fileno($fh); } $die->("Could not get original fd ($fh)") unless defined $orig_fd; if (ref($to)) { $mode //= $orig_fd ? '>&' : '<&'; open($fh, $mode, $to) or $die->("Could not redirect output: $!"); } else { $mode //= $orig_fd ? '>' : '<'; open($fh, $mode, $to) or $die->("Could not redirect output to '$to': $!"); } return if fileno($fh) == $orig_fd; $die->("New handle does not have the desired fd!"); } sub _run_cmd_fork { my %params = @_; my $cmd = $params{command} or die "No 'command' specified"; my $pid = fork; die "Failed to fork" unless defined $pid; if ($pid) { $_->() for @{$params{run_in_parent} // []}; return $pid; } else { $_->() for @{$params{run_in_child} // []}; } %ENV = (%ENV, %{$params{env}}) if $params{env}; setpgrp(0, 0) if USE_P_GROUPS && !$params{no_set_pgrp}; $cmd = [$cmd->()] if ref($cmd) eq 'CODE'; if (my $dir = $params{chdir} // $params{ch_dir}) { chdir($dir) or die "Could not chdir: $!"; } my $stdout = $params{stdout}; my $stderr = $params{stderr}; my $stdin = $params{stdin}; open(my $OLD_STDERR, '>&', \*STDERR) or die "Could not clone STDERR: $!"; my $die = sub { my $caller1 = $params{caller1}; my $caller2 = $params{caller2}; my $msg = "$_[0] at $caller1->[1] line $caller1->[2] ($caller2->[1] line $caller2->[2]).\n"; print $OLD_STDERR $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDERR, $stderr, $die) if $stderr; swap_io(\*STDOUT, $stdout, $die) if $stdout; swap_io(\*STDIN, $stdin, $die) if $stdin; open(STDIN, "<", "/dev/null") if !$stdin; @$cmd = map { ref($_) eq 'CODE' ? $_->() : $_ } @$cmd; exec(@$cmd) or $die->("Failed to exec!"); } sub _run_cmd_spwn { my %params = @_; local %ENV = (%ENV, %{$params{env}}) if $params{env}; my $cmd = $params{command} or die "No 'command' specified"; $cmd = [$cmd->()] if ref($cmd) eq 'CODE'; my $cwd; if (my $dir = $params{chdir} // $params{ch_dir}) { $cwd = getcwd(); chdir($dir) or die "Could not chdir: $!"; } my $stdout = $params{stdout}; my $stderr = $params{stderr}; my $stdin = $params{stdin}; open(my $OLD_STDIN, '<&', \*STDIN) or die "Could not clone STDIN: $!"; open(my $OLD_STDOUT, '>&', \*STDOUT) or die "Could not clone STDOUT: $!"; open(my $OLD_STDERR, '>&', \*STDERR) or die "Could not clone STDERR: $!"; my $die = sub { my $caller1 = $params{caller1}; my $caller2 = $params{caller2}; my $msg = "$_[0] at $caller1->[1] line $caller1->[2] ($caller2->[1] line $caller2->[2], ${ \__FILE__ } line ${ \__LINE__ }).\n"; print $OLD_STDERR $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDERR, $stderr, $die) if $stderr; swap_io(\*STDOUT, $stdout, $die) if $stdout; $stdin ? swap_io(\*STDIN, $stdin, $die) : close(STDIN); local $?; my $pid; my $ok = eval { $pid = system 1, map { ref($_) eq 'CODE' ? $_->() : $_ } @$cmd }; my $bad = $?; my $err = $@; swap_io($stdin ? \*STDIN : [0, \*STDIN], $OLD_STDIN, $die); swap_io(\*STDERR, $OLD_STDERR, $die) if $stderr; swap_io(\*STDOUT, $OLD_STDOUT, $die) if $stdout; if ($cwd) { chdir($cwd) or die "Could not chdir: $!"; } die $err unless $ok; die "Spawn resulted in code $bad" if $bad && $bad != $pid; die "Failed to spawn" unless $pid; $_->() for @{$params{run_in_parent} // []}; return $pid; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::IPC - Utilities for IPC management. =head1 DESCRIPTION This package provides low-level IPC tools for Test2::Harness. =head1 EXPORTS All exports are optional and must be specified at import time. =over 4 =item $bool = USE_P_GROUPS() This is a shortcut for: use Config qw/%Config/; $Config{'d_setpgrp'}; =item swap_io($from, $to) =item swap_io($from, $to, \&die) This will close and re-open the file handle designated by C<$from> so that it redirects to the handle specified in C<$to>. It preserves the file descriptor in the process, and throws an exception if it fails to do so. swap_io(\*STDOUT, $fh); # STDOUT now points to wherever $fh did, but maintains the file descriptor number '2'. As long as the file descriptor is greater than 0 it will open for writing. If the descriptor is 0 it will open for reading, allowing for a swap of C<STDIN> as well. Extra effort is made to insure errors go to the real C<STDERR>, specially when trying to swap out C<STDERR>. If you have trouble with this, or do not trust it, you can provide a custom coderef as a third argument, this coderef will be used instead of C<die()> to throw exceptions. Note that the custom die logic when you do not provide your own bypasses the exception catching mechanism and will exit your program. If this is not desirable then you should provide a custom die subref. =item $pid = run_cmd(command => [...], %params) This function will run the specified command and return a pid to you. When possible this will be done via C<fork()> and C<exec()>. When that is not possible it uses the C<system(1, ...)> trick to spawn a new process. Some parameters do not work in the second case, and are silently ignored. Parameters: =over 4 =item command => [$command, sub { ... }, @args] =item command => sub { return ($command, @args) } This parameter is required. This should either be an arrayref of arguments for C<exec()>, or a coderef that returns a list of arguments for C<exec()>. On systems without fork/exec the arguments will be passed to C<system(1, $command, @args)> instead. If the command arrayref has a coderef in it, the coderef will be run and its return value(s) will be inserted in its place. This replacement happens post-chroot =item run_in_parent => [sub { ... }, sub { ... }] An arrayref of callbacks to be run in the parent process immediately after the child process is started. =item run_in_child => [sub { ... }, sub { ... }] An arrayref of callbacks to be run in the child process immediately after fork. This parameter is silently ignored on systems without fork/exec. =item env => { ENVVAR => $VAL, ... } A hashref of custom environment variables to set in the child process. In the fork/exec model this is done post-fork, in the spawn model this is done via local prior to the spawn. =item no_set_pgrp => $bool, Normally C<setpgrp(0,0)> is called on systems where it is supported. You can use this parameter to override the normal behavior. setpgrp() is not called in the spawn model, so this parameter is silently ignored there. =item chdir => 'path/to/dir' =item ch_dir => 'path/to/dir' chdir() to the specified directory for the new process. In the fork/exec model this is done post-fork in the child. In the spawn model this is done before the spawn, then a second chdir() puts the parent process back to its original dir after the spawn. =item stdout => $handle =item stderr => $handle =item stdin => $handle These can be used to provide custom STDERR, STDOUT, and STDIN. In the fork/exec model these are swapped into place post-fork in the child. In the spawn model the swap occurs pre-spawn, then the old handles are swapped back post-spawn. =back =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������cover_exclude.t�������������������������������������������������������������������������������������100644��001750��001750�� 23136�15267772575� 22627� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Require::Module 'Test2::Plugin::Cover' => '0.000030'; use Test2::Require::AuthorTesting; use App::Yath::Tester qw/yath/; use Test2::Harness::Util qw/clean_path/; use Test2::Util qw/CAN_REALLY_FORK/; use File::Spec(); use File::Temp qw/tempfile/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Coverage paths are relative to the run root, so every comparison below needs # this to be relative too, however the file was invoked. $dir = File::Spec->abs2rel($dir) if File::Spec->file_name_is_absolute($dir); my $abs_dir = clean_path($dir); my $KEEP = "$dir/lib/Keep.pm"; my $DEP = "$dir/deps/lib/Dep.pm"; my $DEP2 = "$dir/deps2/Dep2.pm"; my $VENDOR = "$dir/vendor/Vendor.pm"; # Every run also covers harness modules under lib/, which are not what this # file is about. Only the fixture tree is compared. sub fixture_files { my ($files) = @_; return [sort grep { m{^\Q$dir\E/} && m{\.pm$} } keys %{$files // {}}]; } # The coverage facet itself is collapsed before it is logged, so the file map # consumers see is what yath adds: job_coverage per job, or run_coverage at # the end, depending on the aggregator. sub event_files { my ($log) = @_; my %files; for my $event (log_events($log)) { my $fd = $event->{facet_data}; for my $cov (grep { $_ } $fd->{job_coverage}, $fd->{run_coverage}) { @files{keys %{$cov->{files}}} = values %{$cov->{files}}; } } return fixture_files(\%files); } sub log_events { my ($log) = @_; my @out; my @events = $log->poll(); while (@events) { my $event = shift @events; push @out => $event if $event; push @events => $log->poll; } return @out; } sub written_files { my ($cfile) = @_; open(my $fh, '<', $cfile) or die "Could not open coverage file '$cfile': $!"; my $data = decode_json(join '' => <$fh>); return fixture_files($data->{files}); } sub cover_run { my %params = @_; my ($fh, $cfile) = tempfile("cover-exclude-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.json'); close($fh); my $out = yath( command => 'test', log => 1, args => [ "-I$dir/lib", $dir, '--ext=tx', '-v', "--cover-write=$cfile", @{$params{args} // []}, ], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{PRELOAD: \Q$params{preload}\E$}m, "Ran under the expected transport") if defined $params{preload}; is(event_files($out->{log}), $params{expect}, "Coverage event has the expected files"); is(written_files($cfile), $params{expect}, "Aggregated run data has the expected files"); $params{test}->($out) if $params{test}; }, ); return $out; } subtest no_exclusions => sub { cover_run( preload => 0, expect => [sort($DEP, $DEP2, $KEEP, $VENDOR)], ); }; subtest one_exclusion => sub { cover_run( preload => 0, args => ["--cover-exclude-dirs=$dir/deps"], expect => [sort($DEP2, $KEEP, $VENDOR)], ); }; subtest multiple_exclusions => sub { cover_run( preload => 0, args => ["--cover-exclude-dirs=$dir/deps", "--cover-exclude-dir=$dir/vendor"], expect => [sort($DEP2, $KEEP)], ); }; subtest path_needing_normalization => sub { cover_run( preload => 0, args => ["--cover-exclude-dirs=./$dir/vendor/../deps/lib/.."], expect => [sort($DEP2, $KEEP, $VENDOR)], ); }; subtest wildcard_exclusion => sub { cover_run( preload => 0, args => ["--cover-exclude-dirs=$dir/deps*"], expect => [sort($KEEP, $VENDOR)], ); }; subtest preload => sub { skip_all "Cannot fork, skipping preload test" if $ENV{T2_NO_FORK} || !CAN_REALLY_FORK; cover_run( preload => 1, args => ['-PCoverExcludePreload', "--cover-exclude-dirs=$dir/deps", "--cover-exclude-dirs=$dir/vendor"], expect => [sort($DEP2, $KEEP)], ); }; # --cover-dirs picks the files metrics are calculated over, and exclusions are # subtracted from that set, so an excluded file is counted in neither the # totals nor the untested list. subtest metrics => sub { cover_run( expect => [sort($DEP, $DEP2, $KEEP, $VENDOR)], args => ['--cover-metrics', '--no-cover-dirs', "--cover-dirs=$dir"], test => sub { my $out = shift; like($out->{output}, qr{^\|\s*files\s*\|\s*5\s*\|\s*4\s*\|}m, "All 5 fixture modules counted, 4 tested"); like($out->{output}, qr{^\|\s*subs\s*\|\s*4\s*\|\s*4\s*\|}m, "All 4 fixture subs counted and tested"); }, ); cover_run( expect => [sort($DEP2, $KEEP, $VENDOR)], args => ['--cover-metrics', '--no-cover-dirs', "--cover-dirs=$dir", "--cover-exclude-dirs=$dir/deps"], test => sub { my $out = shift; like($out->{output}, qr{^\|\s*files\s*\|\s*4\s*\|\s*3\s*\|}m, "Excluded module dropped from the total"); like($out->{output}, qr{^\|\s*subs\s*\|\s*3\s*\|\s*3\s*\|}m, "Excluded sub dropped from the total"); }, ); }; subtest exclusions_in_verbose_output => sub { yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '-vv', '--cover-files', "--cover-exclude-dirs=$dir/deps"], exit => 0, test => sub { my $out = shift; like($out->{output}, qr{RUN INFO.*"exclude",}, "Verbose output shows the exclusion parameter"); like($out->{output}, qr{RUN INFO.*"\Q$abs_dir\E/deps"}, "Verbose output shows the normalized exclusion path"); }, ); }; # Coverage produced by a process yath did not launch cannot carry the # exclusions, so it is filtered again where every coverage event is seen. subtest out_of_band_producer => sub { my $oob = "$dir" . "_out_of_band"; my ($fh, $cfile) = tempfile("cover-exclude-oob-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.json'); close($fh); yath( command => 'test', pre => ["-D$oob/lib"], log => 1, args => [ "-I$oob/lib", $oob, '--ext=tx', '-v', '-p+CoverExcludePeek', '--cover-files', "--cover-write=$cfile", "--cover-exclude-dirs=$oob/deps", ], exit => 0, test => sub { my $out = shift; open(my $rfh, '<', $cfile) or die "Could not open coverage file '$cfile': $!"; my $data = decode_json(join '' => <$rfh>); my @files = sort keys %{$data->{files} // {}}; ok( (grep { m{OOBKeep\.pm$} } @files), "Kept a source file the test itself covered", ) or diag(join ", " => @files); is( [grep { m{OOBDep\.pm$} } @files], [], "Dropped every descendant's coverage of the excluded tree", ) or diag(join ", " => @files); # A producer's keys are relative to its own root and are left as # reported; the root is used only to resolve them for exclusion. ok( (grep { $_ eq 'lib/OOBRekey.pm' } @files), "A descendant with its own root keeps its own keys", ) or diag(join ", " => @files); ok( (grep { $_ eq 'OOBOutside.pm' } @files), "A descendant measured outside the project is not dropped", ) or diag(join ", " => @files); like( $out->{output}, qr{COVERAGE FACET: files=SCALAR file_count=\d+}, "Coverage facet reaching consumers carries counts, not the file map", ); my @raw = grep { $_->{facet_data}->{coverage} } log_events($out->{log}); ok(@raw, "Found coverage facets in the log"); is( [grep { ref($_->{facet_data}->{coverage}->{files}) } @raw], [], "The logged coverage facets are the collapsed ones", ); }, ); # Without this the assertion above could pass because the descendant never # reached the event stream at all. my ($fh2, $cfile2) = tempfile("cover-exclude-oob-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.json'); close($fh2); yath( command => 'test', args => ["-I$oob/lib", $oob, '--ext=tx', '-v', '--cover-files', "--cover-write=$cfile2"], exit => 0, test => sub { open(my $rfh, '<', $cfile2) or die "Could not open coverage file '$cfile2': $!"; my $data = decode_json(join '' => <$rfh>); my @files = sort keys %{$data->{files} // {}}; ok( (grep { m{OOBDep\.pm$} } @files), "Without the exclusion the descendant's coverage is recorded", ) or diag(join ", " => @files); }, ); }; subtest comma_is_rejected => sub { yath( command => 'test', args => ["-I$dir/lib", $dir, '--ext=tx', '--cover-files', "--cover-exclude-dirs=$dir/deps,$dir/vendor"], exit => T(), test => sub { my $out = shift; like( $out->{output}, qr{--cover-exclude-dirs cannot use a path containing a comma}, "Rejected the path and said why", ); like( $out->{output}, qr{'\Q$abs_dir\E/deps,}, "Checked the resolved path, not the value as typed", ); }, ); }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������failure_cases.t�������������������������������������������������������������������������������������100644��001750��001750�� 4301�15267772575� 22556� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-LONG use App::Yath::Tester qw/yath/; use File::Spec; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Timeouts short enough that the failing run does not sit out the default # ones. These apply to the failing run only: the passing run has nothing to # wait for, and a slow or loaded machine can easily take longer than 2 seconds # to get a test started, which would kill a test that was going to pass. my %CUSTOM = ( "timeout.tx" => ['--et', 2], "post_exit_timeout.tx" => ['--pet', 2], "noplan.tx" => ['--pet', 2], ); opendir(my $DH, $dir) or die "Could not open directory $dir: $!"; my @files = sort grep { -f File::Spec->canonpath("$dir/$_") } readdir($DH); closedir($DH); my @plain = grep { !$CUSTOM{$_} } @files; sub path_for { File::Spec->canonpath("$dir/$_[0]") } # One run for every fixture that needs no special handling, rather than one # run per fixture: starting yath costs far more than the assertions do. Each # file is checked by name in the output, which is more than the per-file runs # asserted -- they only looked at the exit code, which any one failure sets. yath( command => 'test', args => ['-j4', map { path_for($_) } @plain], env => {FAILURE_DO_PASS => 0}, exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*\Q$_\E}, "$_ failed") for @plain; }, ); # These three have to wait out a timeout, and the option that shortens it is # global, so they keep a run each rather than imposing one file's timeout on # another's failure mode. for my $file (sort keys %CUSTOM) { yath( command => 'test', args => [@{$CUSTOM{$file}}, path_for($file)], env => {FAILURE_DO_PASS => 0}, exit => T(), test => sub { my $out = shift; like($out->{output}, qr{FAILED.*\Q$file\E}, "$file failed"); }, ); } # Every fixture passes when told to, including the three above: with nothing # to wait for they need no custom timeouts. yath( command => 'test', args => ['-j4', map { path_for($_) } @files], env => {FAILURE_DO_PASS => 1}, exit => F(), ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������persist���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21117� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22543� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/persist���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fast.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 205�15267772575� 22503� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'FAST.pm'}, "Preloaded fast"); is($ENV{T2_HARNESS_STAGE}, 'FAST', "Running in 'FAST' stage"); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������slow.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 263�15267772575� 22536� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-STAGE-SLOW ok($INC{'FAST.pm'}, "Preloaded fast"); is($ENV{T2_HARNESS_STAGE}, 'FAST', "Running in 'FAST' stage despite asking for 'SLOW'"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������slots_per_job.t�������������������������������������������������������������������������������������100644��001750��001750�� 670�15267772575� 22602� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY} >= 1, "Have job concurrency set to a positive number ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); done_testing; ������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20534� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath����������������������������������������������������������������������������������������������������������������������������������Fail.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 1243�15267772575� 22105� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath/Plugin���������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Test; use strict; use warnings; our $VERSION = '0.001016'; use parent 'App::Yath::Plugin'; my %CALLS; sub options { push @{$CALLS{options}} => [@_]; return } sub pre_init { push @{$CALLS{pre_init}} => [@_]; return } sub post_init { push @{$CALLS{post_init}} => [@_]; return } sub find_files { push @{$CALLS{find_files}} => [@_]; return } sub block_default_search { push @{$CALLS{block_default_search}} => [@_]; return } sub CLEAR_CALLS { %CALLS = () } sub GET_CALLS { return { %CALLS } } use Carp qw/confess/; confess "Should not see this"; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������failed.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 31623�15267772575� 22360� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::failed; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Util::Table qw/table/; use Test2::Harness::Util::File::JSONL; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw{<log_file}; use App::Yath::Options; option brief => ( prefix => 'display', category => 'Display Options', description => 'Show only the files that failed, newline separated, no other output. If a file failed once but passed on a retry it will NOT be shown.', ); sub summary { "Show the failed tests from an event log" } sub group { 'log' } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] [job1, job2, ...]" } sub description { return <<" EOT"; This yath command will list the test scripts from an event log that have failed. The only required argument is the path to the log file, which may be compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only the listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. EOT } sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my %failed; while(1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; push @{$failed{$job_id}->{subtests}} => $self->subtests($f) if $f->{parent} && !$f->{trace}->{nested} && $self->include_subtest($f); next unless $f->{harness_job_end}; next unless $f->{harness_job_end}->{fail} || $failed{$job_id}; push @{$failed{$job_id}->{ends}} => $f->{harness_job_end}; } } my $rows = []; while (my ($job_id, $data) = each %failed) { my $ends = $data->{ends} // []; my %seen; my $subtests = join "\n" => grep { !$seen{$_}++ } sort @{$data->{subtests} // []}; if ($settings->display->brief) { print $ends->[-1]->{rel_file}, "\n" if $ends->[-1]->{fail}; } else { push @$rows => [$job_id, scalar(@$ends), $ends->[-1]->{rel_file}, $subtests, $ends->[-1]->{fail} ? "NO" : "YES"]; } } return 0 if $settings->display->brief; unless (@$rows) { print "\nNo jobs failed!\n"; return 0; } print "\nThe following jobs failed at least once:\n"; print join "\n" => table( collapse => 1, header => ['Job ID', 'Times Run', 'Test File', "Subtests", "Succeeded Eventually?"], rows => $rows, ); print "\n"; return 0; } sub include_subtest { my $self = shift; my ($f) = @_; return 0 unless $f->{parent} && keys %{$f->{parent}}; return 0 if $f->{assert}->{pass} || !keys %{$f->{assert}}; return 0 if $f->{amnesty} && @{$f->{amnesty}}; return 1; } sub subtests { my $self = shift; my ($f, $prefix) = @_; return unless $self->include_subtest($f); my $name = $f->{assert}->{details}; unless ($name) { my $frame = $f->{trace}->{frame}; $name = "Unnamed Subtest"; $name .= " ($frame->[1] line $frame->[2])" if $frame->[1] && $frame->[2]; } $name = "$prefix -> $name" if $prefix; my @out; push @out => $name; for my $child (@{$f->{parent}->{children}}) { next unless $child->{parent}; push @out => $self->subtests($child, $name); } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::failed - Show the failed tests from an event log =head1 DESCRIPTION This yath command will list the test scripts from an event log that have failed. The only required argument is the path to the log file, which may be compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only the listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. =head1 USAGE $ yath [YATH OPTIONS] failed [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --brief =item --no-brief Show only the files that failed, newline separated, no other output. If a file failed once but passed on a retry it will NOT be shown. =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������reload.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 23332�15267772575� 22400� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::reload; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use Test2::Harness::Util::File::JSON; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/open_file/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Reload the persistent test runner" } sub cli_args { "" } sub description { return <<" EOT"; This will send a SIGHUP to the persistent runner, forcing it to reload. This will also clear the blacklist allowing all preloads to load as normal. EOT } sub run { my $self = shift; my $pfile = find_pfile($self->settings, no_fatal => 1) or die "Could not find a persistent yath running.\n"; my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); my $blacklist = File::Spec->catfile($data->{dir}, 'BLACKLIST'); if (-e $blacklist) { print "Deleting module blacklist...\n"; unlink($blacklist) or warn "Could not delete blacklist file!"; } print "\nSending SIGHUP to $data->{pid}\n\n"; kill('HUP', $data->{pid}) or die "Could not send signal!\n"; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::reload - Reload the persistent test runner =head1 DESCRIPTION This will send a SIGHUP to the persistent runner, forcing it to reload. This will also clear the blacklist allowing all preloads to load as normal. =head1 USAGE $ yath [YATH OPTIONS] reload [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������replay.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 34746�15267772575� 22441� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::replay; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Options; require App::Yath::Command::test; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/+renderers <final_data <log_file <tests_seen <asserts_seen/; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Display', 'App::Yath::Options::PreCommand', ); sub group { 'log' } sub summary { "Replay a test run from an event log" } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] [job1, job2, ...]" } sub description { return <<" EOT"; This yath command will re-run the harness against an event log produced by a previous test run. The only required argument is the path to the log file, which maybe compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. EOT } sub init { my $self = shift; $self->SUPER::init() if $self->can('SUPER::init'); $self->{+TESTS_SEEN} //= 0; $self->{+ASSERTS_SEEN} //= 0; } sub run { my $self = shift; my $args = $self->args; my $settings = $self->settings; my $renderers = $self->App::Yath::Command::test::renderers; shift @$args if @$args && $args->[0] eq '--'; $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; my $jobs = @$args ? {map {$_ => 1} @$args} : undef; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); while (1) { my @events = $stream->poll(max => 1000) or last; for my $e (@events) { last unless defined $e; $self->{+TESTS_SEEN}++ if $e->{facet_data}->{harness_job_launch}; $self->{+ASSERTS_SEEN}++ if $e->{facet_data}->{assert}; if ($jobs) { my $f = $e->{facet_data}->{harness_job_start} // $e->{facet_data}->{harness_job_queued}; if ($f && !$jobs->{$e->{job_id}}) { for my $field (qw/rel_file abs_file file/) { my $file = $f->{$field} or next; next unless $jobs->{$file}; $jobs->{$e->{job_id}} = 1; last; } } } if (my $final = $e->{facet_data}->{harness_final}) { $self->{+FINAL_DATA} = $final; } else { next if $jobs && !$jobs->{$e->{job_id}}; $_->render_event($e) for @$renderers; } } } $_->finish() for @$renderers; my $final_data = $self->{+FINAL_DATA} or die "Log did not contain final data!\n"; $self->App::Yath::Command::test::render_final_data($final_data); $self->App::Yath::Command::test::render_summary($final_data->{pass}); return $final_data->{pass} ? 0 : 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::replay - Replay a test run from an event log =head1 DESCRIPTION This yath command will re-run the harness against an event log produced by a previous test run. The only required argument is the path to the log file, which maybe compressed. Any extra arguments are assumed to be job id's. If you list any jobs, only listed jobs will be processed. This command accepts all the same renderer/formatter options that the 'test' command accepts. =head1 USAGE $ yath [YATH OPTIONS] replay [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������runner.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 55135�15267772575� 22451� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::runner; use strict; use warnings; our $VERSION = '1.000182'; use Config qw/%Config/; use File::Spec; # For some reason Filter::Util::Class breaks the STDIN filehandle. This works # around that. my $FIX_STDIN; BEGIN { require goto::file; no strict 'refs'; no warnings 'redefine'; my $int_done; my $orig = goto::file->can('filter'); *goto::file::filter = sub { local $.; my $out = $orig->(@_); seek(STDIN, 0, 0) if $FIX_STDIN; unless ($int_done++) { if (my $fifo = $ENV{YATH_INTERACTIVE}) { my $ok; for (1 .. 10) { $ok = open(STDIN, '<', $fifo); last if $ok; die "Could not open fifo ($fifo): $!"; sleep 1; } die "Could not open fifo ($fifo): $!" unless $ok; print STDERR <<' EOT'; ******************************************************************************* * YATH IS RUNNING IN INTERACTIVE MODE * * * * STDIN is comming from a fifo pipe, not a TTY! * * * * The $ENV{YATH_INTERACTIVE} var is set to the FIFO being used. * * * * VERBOSE mode has been turned on for you * * * * Only 1 test will run at a time * * * * The main yath process no longer has STDIN, so yath plugins that wait for * * input WILL BREAK. * * * * Prompts that do not end with a newline may have a 1 second delay before * * they are displayed, they will be prefixed with [INTERACTIVE] * * * * Any stdin/stdout that is printed in 2 parts without a newline and more than * * a 1 second delay will be printed with the [INTERACTIVE] prefix, if they are * * not actually a prompt you can safely ignore them. * * * * It is possible that a prompt was displayed before this message, please * * check above if your prompt appears missing. This is an IO fluke, not a bug. * * * ******************************************************************************* EOT } } return $out; }; } use Test2::Harness::IPC(); use Carp qw/confess/; use Scalar::Util qw/openhandle/; use List::Util qw/first/; use File::Path qw/remove_tree/; use Scope::Guard; use Test2::Util qw/clone_io/; use Long::Jump qw/setjump longjump/; use Test2::Harness::Util qw/mod2file write_file_atomic open_file clean_path process_includes/; use Test2::Harness::Util::IPC qw/swap_io/; use Test2::Harness::Runner::Preloader(); use Test2::Harness::Stall::Detector(); use Test2::Harness::Stall::Trace qw/install_trace_handler/; my @SIGNALS = grep { $_ ne 'ZERO' } split /\s+/, $Config{sig_name}; # If FindBin is installed, go ahead and load it. We do not care much about # success vs failure here. BEGIN { local $@; eval { require FindBin; FindBin->import }; } use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'runner' } sub init { confess(ref($_[0]) . " is not intended to be instantiated") } sub run { confess(ref($_[0]) . " does not implement run()") } our $RUNNER_PID; sub generate_run_sub { my $class = shift; my ($symbol, $argv, $spawn_settings) = @_; my ($dir, %args) = @$argv; $RUNNER_PID = $$; my $runner_pid = $$; my $settings = Test2::Harness::Settings->new(File::Spec->catfile($dir, 'settings.json')); my $name = $ENV{NESTED_YATH} ? 'yath-nested-runner' : 'yath-runner'; $name = $settings->debug->procname_prefix . "-${name}" if $settings->debug->procname_prefix; $0 = $name; my $cleanup = $class->cleanup($settings, \%args, $dir); my $jump = setjump "Test-Runner" => sub { local $.; my %orig_sig = %SIG; # After the snapshot on purpose: the scheduler and stage forks inherit # this, and a test job sheds it when the guard below restores # %orig_sig. A job process must not keep it -- see the trace module. # Only when the feature is on: installing it changes what SIGUSR1 does # to a running yath process. # List context on purpose: parse_spec returns a list, so a boolean # test would see only its last value and miss STRONG:0. my %stall = $settings->check_prefix('runner') ? Test2::Harness::Stall::Detector->parse_spec($settings->runner->stall_report) : (); install_trace_handler(File::Spec->catdir($dir, 'stall')) if %stall; my $guard = Scope::Guard->new(sub { my %seen; for my $sig (@SIGNALS) { next if $seen{$sig}++; if (exists $orig_sig{$sig}) { $SIG{$sig} = $orig_sig{$sig}; } else { delete $SIG{$sig}; } } }); my $runner = $settings->build( runner => 'Test2::Harness::Runner', %args, dir => $dir, settings => $settings, fork_job_callback => sub { $class->launch_via_fork(@_) }, fork_spawn_callback => sub { $class->launch_spawn(@_) }, respawn_runner_callback => sub { return unless $$ == $runner_pid; longjump "Test-Runner" => 'respawn' }, ); my $exit = $runner->process(); if ($$ == $runner_pid) { $_->cleanup() for @{$runner->state->resources}; } my $complete = File::Spec->catfile($dir, 'complete'); write_file_atomic($complete, '1'); exit($exit // 1); }; die "Test runner completed, but failed to exit" unless $jump; my ($action, $job, $stage) = @$jump; if($action eq 'respawn') { print "$$ Respawning the runner...\n"; $cleanup->dismiss(1); exec($^X, $settings->harness->script, @{$spawn_settings->harness->orig_argv}); warn "exec failed!"; exit 1; } die "Invalid action: $action" if $action ne 'run_test'; if (my $chdir = $job->ch_dir) { chdir($chdir) or die "Could not chdir: $!"; } goto::file->import($job->run_file); $class->cleanup_process($job, $stage); DB::enable_profile() if $settings->runner->nytprof; } sub cleanup { my $class = shift; my ($settings, $args, $dir) = @_; my $pfile = $args->{persist} or return; my $pid = $$; return Scope::Guard->new(sub { return unless $pid == $$; unlink($pfile); remove_tree($dir, {safe => 1, keep_root => 0}) unless $settings->debug->keep_dirs; }); } sub get_stage { my $class = shift; my ($runner) = @_; return unless $runner->can('stage'); my $stage_name = $runner->stage or return; my $preloader = $runner->preloader or return; my $p = $preloader->staged or return; return $p->stage_lookup->{$stage_name}; } sub launch_spawn { my $class = shift; my ($runner, $spawn) = @_; my $pid = fork() // die $!; if ($pid) { local $?; waitpid($pid, 0); return; } require POSIX; POSIX::setsid or die "setsid: $!"; $pid = fork // die $!; exit 0 if $pid; eval { my ($wh); pipe(STDIN, $wh) or die "Could not create pipe: $!"; $pid = $class->launch_via_fork($runner, $spawn); if ($pid) { open(my $fh, '>>', $spawn->{task}->{ipcfile}) or die "Could not open pidfile: $!"; print $fh "$$\n$pid\n" . fileno($wh) . "\n"; $fh->flush(); local $?; waitpid($pid, 0); print $fh "$?\n"; close($fh); } exit(0); }; warn "Unknown problem daemonizing: $@"; exit(1); } sub launch_via_fork { my $class = shift; my ($runner, $job) = @_; my $stage = $class->get_stage($runner); $stage->do_pre_fork($job) if $stage; my $pid = fork(); die "Failed to fork: $!" unless defined $pid; # In parent return $pid if $pid; # In Child my $ok = eval { $0 = 'yath-pending-test'; setpgrp(0, 0) if Test2::Harness::IPC::USE_P_GROUPS(); $runner->stop(); $stage->do_post_fork($job) if $stage; longjump "Test-Runner" => ('run_test', $job, $stage); 1; }; my $err = $@; eval { warn $err } unless $ok; exit(1); } sub cleanup_process { my $class = shift; my ($job, $stage) = @_; $class->update_io($job); # Get the correct filehandles in place early $class->set_env($job); # Set up the necessary env vars $class->build_init_state($job); # Lots of 'misc' stuff. $class->do_loads($job); # Modules that we wanted loaded/imported post fork $class->test2_state($job); # Normalize the Test2 state $stage->do_pre_launch($job) if $stage; $class->final_state($job); # Important final cleanup } sub test2_state { my $class = shift; my ($job) = @_; if ($INC{'Test2/API.pm'}) { Test2::API::test2_stop_preload(); Test2::API::test2_post_preload_reset(); } if ($job->use_stream) { $ENV{T2_FORMATTER} = 'Stream'; require Test2::Formatter::Stream; Test2::Formatter::Stream->import(dir => $job->event_dir, job_id => $job->job_id); } if ($job->event_uuids) { require Test2::Plugin::UUID; Test2::Plugin::UUID->import(); } if ($job->mem_usage) { require Test2::Plugin::MemUsage; Test2::Plugin::MemUsage->import(); } if ($job->io_events) { require Test2::Plugin::IOEvents; Test2::Plugin::IOEvents->import(); } return; } sub final_state { my $class = shift; my ($job) = @_; @ARGV = $job->args; # toggle -w switch late $^W = 1 if $job->use_w_switch; # reset the state of empty pattern matches, so that they have the same # behavior as running in a clean process. # see "The empty pattern //" in perlop. # note that this has to be dynamically scoped and can't go to other subs "" =~ /^/; return; } sub do_loads { my $class = shift; my ($job) = @_; local $@; my $importer = eval <<' EOT' or die $@; package main; #line 0 "-" sub { $_[0]->import(@{$_[1]}) } EOT for my $set ($job->load_import) { my ($mod, $args) = @$set; my $file = mod2file($mod); local $0 = '-'; require $file; $importer->($mod, $args); } for my $mod ($job->load) { my $file = mod2file($mod); local $0 = '-'; require $file; } return; } sub build_init_state { my $class = shift; my ($job) = @_; $0 = $job->rel_file; $class->_reset_DATA(); @ARGV = (); srand(); # avoid child processes sharing the same seed value as the parent @INC = process_includes( list => [$job->includes], include_dot => $job->unsafe_inc, include_current => 1, clean => 1, ); # if FindBin is preloaded, reset it with the new $0 FindBin::init() if defined &FindBin::init; # restore defaults Getopt::Long::ConfigDefaults() if defined &Getopt::Long::ConfigDefaults; return; } sub set_env { my $class = shift; my ($job) = @_; my $env = $job->env_vars; { no warnings 'uninitialized'; $ENV{$_} = $env->{$_} for keys %$env; } $ENV{T2_HARNESS_FORKED} = 1; $ENV{T2_HARNESS_PRELOAD} = 1; return; } sub update_io { my $class = shift; my ($job) = @_; my $out_fh = open_file($job->out_file, '>'); my $err_fh = open_file($job->err_file, '>'); my $in_file = $job->in_file; my $in_fh; $in_fh = open_file($in_file, '<') if $in_file; $out_fh->autoflush(1); $err_fh->autoflush(1); # Keep a copy of the old STDERR for a while so we can still report errors my $stderr = clone_io(\*STDERR); my $die = sub { my @caller = caller; my @caller2 = caller(1); my $msg = "$_[0] at $caller[1] line $caller[2] ($caller2[1] line $caller2[2]).\n"; print $stderr $msg; print STDERR $msg; POSIX::_exit(127); }; swap_io(\*STDIN, $in_fh, $die, '<&') if $in_file; swap_io(\*STDOUT, $out_fh, $die, '>&'); swap_io(\*STDERR, $err_fh, $die, '>&'); $FIX_STDIN = 1 if $in_file; return; } # Heavily modified from forkprove sub _reset_DATA { my $class = shift; for my $set (@{$class->preload_list}) { my ($mod, $file, $pos) = @$set; my $fh = do { no strict 'refs'; *{$mod . '::DATA'}; }; # note that we need to ensure that each forked copy is using a # different file handle, or else concurrent processes will interfere # with each other close $fh if openhandle($fh); if (open $fh, '<', $file) { seek($fh, $pos, 0); } else { warn "Couldn't reopen DATA for $mod ($file): $!"; } } } # Heavily modified from forkprove sub preload_list { my $class = shift; my $list = []; for my $loaded (keys %INC) { next unless $loaded =~ /\.pm$/; my $mod = $loaded; $mod =~ s{/}{::}g; $mod =~ s{\.pm$}{}; my $fh = do { no strict 'refs'; no warnings 'once'; *{$mod . '::DATA'}; }; next unless openhandle($fh); push @$list => [$mod, $INC{$loaded}, tell($fh)]; } return $list; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::runner - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] runner [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������status.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 75356�15267772575� 22472� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::status; use strict; use warnings; our $VERSION = '1.000182'; use Term::Table(); use File::Spec(); use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command::run'; use Test2::Harness::Util::HashBase; sub group { 'persist' } sub summary { "Status info and process lists for the runner" } sub cli_args { "" } sub description { return <<" EOT"; This command will provide health details and a process list for the runner. EOT } sub pfile_params { (no_fatal => 1) } sub run { my $self = shift; my $data = $self->pfile_data(); my $state = Test2::Harness::Runner::State->new( workdir => $self->workdir, observe => 1, ); $state->poll; print "\n**** Pending tests: ****\n"; my $pending = $state->pending_tasks; for my $run ($state->run, @{$state->pending_runs // []}) { next unless $run; my $run_id =$run->{run_id} or next; print "\nRun $run_id:\n"; my $pending = $pending->{$run_id} // {}; my @tasks; my @check = ($pending); while (my $it = shift @check) { my $ref = ref($it); if ($ref eq 'ARRAY') { push @check => @$it; next; } if ($ref eq 'HASH') { if ($it->{job_id}) { push @tasks => $it; next; } push @check => values %$it; next; } } if (!@tasks) { print "--No pending tasks for this run--\n"; next; } my @rows = map {[$_->{job_id}, $_->{is_try} // $_->{job_try} // 0, $_->{rel_file}, join(', ' => @{$_->{conflicts} // []}), join(', ' => @{$_->{shares} // []})]} @tasks; my $run_table = Term::Table->new( collapse => 1, header => [qw/uuid try test conflicts shares/], rows => [ sort { $a->[2] cmp $b->[2] } @rows ], ); print "$_\n" for $run_table->render; } print "\n**** Runner Stages: ****\n"; my $stage_status = $state->stage_readiness // {}; my $reload_status = $state->reload_state // {}; my $reload_issues = 0; my $rows = []; for my $stage (keys %$stage_status) { my $pid = $stage_status->{$stage} ||= ''; my $ready = $pid ? 'YES' : 'NO'; $pid = 'N/A' if $pid && $pid == 1; my $issues = keys %{$reload_status->{$stage}}; my $reload = $issues ? 'YES' : 'NO'; $reload_issues += $issues; push @$rows => [$pid, $stage, $ready, $reload]; } @$rows = sort { $a->[0] <=> $b->[0] } @$rows; my $stage_table = Term::Table->new( collapse => 1, header => [qw/pid stage ready/, 'reload issues'], rows => $rows, ); print "$_\n" for $stage_table->render; if ($reload_issues) { my %seen; print "\n**** Reload issues: ****\n"; for my $stage (sort keys %$reload_status) { for my $file (keys %{$reload_status->{$stage}}) { next if $seen{$file}++; my $data = $reload_status->{$stage}->{$file} or next; print "\n==== SOURCE FILE: $file ====\n"; print $data->{error} if $data->{error}; print $_ for @{$data->{warnings} // []}; } } print "\n"; } print "\n**** Running tests: ****\n"; my $running = $state->running_tasks; my $running_tasks = [values %$running]; my @rows = map {[$self->get_job_pid($_->{run_id}, $_->{job_id}) // 'N/A', $_->{job_id}, $_->{is_try} // $_->{job_try} // 0, $_->{rel_file}, join(', ' => @{$_->{conflicts} // []}), join(', ' => @{$_->{shares} // []})]} @$running_tasks; if (@rows) { my $run_table = Term::Table->new( collapse => 1, header => [qw/pid uuid try test conflicts shares/], rows => [ sort { $a->[0] <=> $b->[0] } @rows ], ); print "$_\n" for $run_table->render; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::status - Status info and process lists for the runner =head1 DESCRIPTION This command will provide health details and a process list for the runner. =head1 USAGE $ yath [YATH OPTIONS] status [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 NO CATEGORY - FIX ME =over 4 =item --check-reload-state =item --no-check-reload-state Abort the run if there are unfixes reload errors and show a confirmation dialogue for unfixed reload warnings. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Finder.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 52755�15267772575� 22431� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Finder; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util qw/mod2file/; use App::Yath::Options; my %RERUN_MODES = ( all => "Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", failed => "Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", retried => "Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", passed => "Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", missed => "Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", ); option_group {prefix => 'finder', category => "Finder Options", builds => 'Test2::Harness::Finder'} => sub { option finder => ( type => 's', default => 'Test2::Harness::Finder', description => 'Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed.', long_examples => [' MyFinder', ' +Test2::Harness::Finder::MyFinder'], pre_command => 1, adds_options => 1, pre_process => \&finder_pre_process, action => \&finder_action, builds => undef, # This option is not for the build ); option extension => ( field => 'extensions', type => 'm', alt => ['ext'], description => 'Specify valid test filename extensions, default: t and t2', ); option search => ( type => 'm', description => 'List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix.', ); option no_long => ( description => "Do not run tests that have their duration flag set to 'LONG'", ); option only_long => ( description => "Only run tests that have their duration flag set to 'LONG'", ); option show_changed_files => ( description => "Print a list of changed files if any are found", applicable => \&changes_applicable, ); option changed_only => ( description => "Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff())", applicable => \&changes_applicable, ); option rerun => ( type => 'd', description => "Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that.", long_examples => ['', '=path/to/log.jsonl', '=plugin_specific_string'], ); option rerun_plugin => ( type => 'm', description => "What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority)", long_examples => [' Foo', ' +App::Yath::Plugin::Foo'], ); option rerun_modes => ( alt => ['rerun-mode'], type => 'm', description => "Pick which test categories to run", long_examples => [' failed,missed,...', map {" $_"} sort keys %RERUN_MODES], ); for my $mode (keys %RERUN_MODES) { option "rerun_$mode" => ( type => 'd', description => $RERUN_MODES{$mode}, long_examples => ['', '=path/to/log.jsonl', '=plugin_specific_string'], ignore_for_build => 1, ); } option changed => ( type => 'm', description => "Specify one or more files as having been changed.", long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_exclude_file => ( type => 'm', description => 'Specify one or more files to ignore when looking at changes', long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_exclude_pattern => ( type => 'm', description => 'Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check.', long_examples => [" '(apple|pear|orange)'"], applicable => \&changes_applicable, ); option changes_filter_file => ( type => 'm', description => 'Specify one or more files to check for changes. Changes to other files will be ignored', long_examples => [' path/to/file'], applicable => \&changes_applicable, ); option changes_filter_pattern => ( type => 'm', description => 'Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check.', long_examples => [" '(apple|pear|orange)'"], applicable => \&changes_applicable, ); option changes_diff => ( type => 's', description => "Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000`", long_examples => [' path/to/diff.diff'], applicable => \&changes_applicable, ); option changes_plugin => ( type => 's', description => "What plugin should be used to detect changed files.", long_examples => [' Git', ' +App::Yath::Plugin::Git'], applicable => \&changes_applicable, ); option changes_include_whitespace => ( type => 'b', description => "Include changed lines that are whitespace only (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_nonsub => ( type => 'b', description => "Exclude changes outside of subroutines (perl files only) (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_loads => ( type => 'b', description => "Exclude coverage tests which only load changed files, but never call code from them. (default: off)", applicable => \&changes_applicable, default => 0, ); option changes_exclude_opens => ( type => 'b', description => "Exclude coverage tests which only open() changed files, but never call code from them. (default: off)", applicable => \&changes_applicable, default => 0, ); option durations => ( type => 's', long_examples => [' file.json', ' http://example.com/durations.json'], short_examples => [' file.json', ' http://example.com/durations.json'], description => "Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work.", ); option maybe_durations => ( type => 's', long_examples => [' file.json', ' http://example.com/durations.json'], short_examples => [' file.json', ' http://example.com/durations.json'], description => "Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work.", ); option durations_threshold => ( alt => ['Dt'], type => 's', default => undef, description => "Only fetch duration data if running at least this number of tests. Default (-j value + 1)" ); option exclude_file => ( field => 'exclude_files', type => 'm', long_examples => [' t/nope.t'], short_examples => [' t/nope.t'], description => "Exclude a file from testing", ); option exclude_pattern => ( field => 'exclude_patterns', type => 'm', long_examples => [' t/nope.t'], short_examples => [' t/nope.t'], description => "Exclude a pattern from testing, matched using m/\$PATTERN/", ); option exclude_list => ( field => 'exclude_lists', type => 'm', long_examples => [' file.txt', ' http://example.com/exclusions.txt'], short_examples => [' file.txt', ' http://example.com/exclusions.txt'], description => "Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files).", ); option default_search => ( type => 'm', description => "Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line", ); option default_at_search => ( type => 'm', description => "Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line", ); post \&_post_process; }; sub _post_process { my %params = @_; my $settings = $params{settings}; my $options = $params{options}; my $finder = $settings->finder; my $rerun = $finder->rerun; for my $mode (sort keys %RERUN_MODES) { my $val = $finder->remove_field("rerun_$mode") or next; push @{$finder->rerun_modes} => $mode; next if $val eq '1'; $rerun //= $val; $rerun = $val if $rerun eq '1'; die "Multiple runs specified for rerun ($val and $rerun). Please pick one.\n" if $val ne $rerun; } $finder->field(rerun => $rerun); my (%seen, @keep); for my $mode (sort map { split /,/ } @{$finder->rerun_modes}) { next if $seen{$mode}++; die "Invalid rerun-mode '$mode'.\n" unless $RERUN_MODES{$mode}; push @keep => $mode; } push @keep => 'all' unless @keep; @{$finder->rerun_modes} = @keep; if (!defined($settings->finder->durations_threshold)) { if ($settings->check_prefix('runner')) { my $jc = $settings->runner->job_count // 1; $settings->finder->field(durations_threshold => $jc + 1); } $settings->finder->field(durations_threshold => 1); } $settings->finder->field(default_search => ['./t', './t2', 'test.pl']) unless $settings->finder->default_search && @{$settings->finder->default_search}; $settings->finder->field(default_at_search => ['./xt']) unless $settings->finder->default_at_search && @{$settings->finder->default_at_search}; @{$settings->finder->extensions} = ('t', 't2') unless @{$settings->finder->extensions}; s/^\.//g for @{$settings->finder->extensions}; } sub normalize_class { my ($class) = @_; $class = "Test2::Harness::Finder::$class" unless $class =~ s/^\+//; my $file = mod2file($class); require $file; return $class; } sub finder_pre_process { my %params = @_; my $class = $params{val} or return; $class = normalize_class($class); return unless $class->can('options'); $params{options}->include_from($class); } sub finder_action { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler, $options) = @_; my $class = $norm; $class = normalize_class($class); if ($class->can('options')) { $options->populate_pre_defaults(); $options->populate_cmd_defaults(); } $class->munge_settings($settings, $options) if $class->can('munge_settings'); $handler->($slot, $class); } sub changes_applicable { my ($option, $options) = @_; # Cannot use this options with projects return 0 if $options->command_class && $options->command_class->isa('App::Yath::Command::projects'); return 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Finder - Finder options for Yath. =head1 DESCRIPTION This is where the command line options for discovering test files are defined. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head2 COMMAND OPTIONS =head3 Finder Options =over 4 =item --changed path/to/file =item --no-changed Specify one or more files as having been changed. Can be specified multiple times =item --changed-only =item --no-changed-only Only search for tests for changed files (Requires a coverage data source, also requires a list of changes either from the --changed option, or a plugin that implements changed_files() or changed_diff()) =item --changes-diff path/to/diff.diff =item --no-changes-diff Path to a diff file that should be used to find changed files for use with --changed-only. This must be in the same format as `git diff -W --minimal -U1000000` =item --changes-exclude-file path/to/file =item --no-changes-exclude-file Specify one or more files to ignore when looking at changes Can be specified multiple times =item --changes-exclude-loads =item --no-changes-exclude-loads Exclude coverage tests which only load changed files, but never call code from them. (default: off) =item --changes-exclude-nonsub =item --no-changes-exclude-nonsub Exclude changes outside of subroutines (perl files only) (default: off) =item --changes-exclude-opens =item --no-changes-exclude-opens Exclude coverage tests which only open() changed files, but never call code from them. (default: off) =item --changes-exclude-pattern '(apple|pear|orange)' =item --no-changes-exclude-pattern Ignore files matching this pattern when looking for changes. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-filter-file path/to/file =item --no-changes-filter-file Specify one or more files to check for changes. Changes to other files will be ignored Can be specified multiple times =item --changes-filter-pattern '(apple|pear|orange)' =item --no-changes-filter-pattern Specify a pattern for change checking. When only running tests for changed files this will limit which files are checked for changes. Only files that match this pattern will be checked. Your pattern will be inserted unmodified into a `$file =~ m/$pattern/` check. Can be specified multiple times =item --changes-include-whitespace =item --no-changes-include-whitespace Include changed lines that are whitespace only (default: off) =item --changes-plugin Git =item --changes-plugin +App::Yath::Plugin::Git =item --no-changes-plugin What plugin should be used to detect changed files. =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =item --show-changed-files =item --no-show-changed-files Print a list of changed files if any are found =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������Runner.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 52363�15267772575� 22466� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Runner; use strict; use warnings; our $VERSION = '1.000182'; use List::Util qw/min/; use Test2::Util qw/IS_WIN32/; use App::Yath::Util qw/find_in_updir/; use Test2::Harness::Util qw/clean_path mod2file/; use Test2::Harness::Util::UUID qw/gen_uuid/; use File::Spec; use App::Yath::Options; my $DEFAULT_COVER_ARGS = '-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'; option_group {prefix => 'runner', category => "Runner Options"} => sub { option use_fork => ( alt => ['fork'], description => "(default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests.", env_vars => [qw/!T2_NO_FORK T2_HARNESS_FORK !T2_HARNESS_NO_FORK YATH_FORK !YATH_NO_FORK/], default => sub { return 0 if IS_WIN32; return 1; }, ); option abort_on_bail => ( type => 'b', default => 1, description => "Abort all testing if a bail-out is encountered (default: on)", ); option use_timeout => ( alt => ['timeout'], description => "(default: on) Enable/disable timeouts", default => 1, ); option shared_jobs_config => ( type => 's', description => 'Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name.', default => '.sharedjobslots.yml', long_examples => [ ' .sharedjobslots.yml', ' relative/path/.sharedjobslots.yml', ' /absolute/path/.sharedjobslots.yml' ], ); post \&jobs_post_process; option job_count => ( type => 's', short => 'j', alt => ['jobs'], description => 'Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable.', env_vars => [qw/YATH_JOB_COUNT T2_HARNESS_JOB_COUNT HARNESS_JOB_COUNT/], clear_env_vars => 1, long_examples => [' 4', ' 8:2'], short_examples => ['4', '8:2'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; my ($jobs, $slots) = split /:/, $norm; $$slot = $jobs; $settings->runner->slots_per_job($slots) if defined $slots; fix_job_resources($settings); }, ); option slots_per_job => ( type => 's', short => 'x', description => "This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'.", env_vars => ['T2_HARNESS_JOB_CONCURRENCY'], clear_env_vars => 1, long_examples => [' 2'], short_examples => ['2'], ); option dump_depmap => ( type => 'b', description => "When using staged preload, dump the depmap for each stage as json files", default => 0, ); option includes => ( name => 'include', short => 'I', type => 'm', description => "Add a directory to your include paths", ); option resources => ( name => 'resource', short => 'R', type => 'm', description => "Use a resource module to assign resource assignments to individual tests", long_examples => [' Port', ' +Test2::Harness::Runner::Resource::Port'], short_examples => [' Port'], normalize => sub { my $val = shift; $val = "Test2::Harness::Runner::Resource::$val" unless $val =~ s/^\+//; return $val; }, ); option tlib => ( description => "(Default: off) Include 't/lib' in your module path", default => 0, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => File::Spec->catdir('t', 'lib'); }, ); option lib => ( short => 'l', description => "(Default: include if it exists) Include 'lib' in your module path", default => 1, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => 'lib'; $settings->runner->lib(0); $settings->runner->blib(0); }, ); option blib => ( short => 'b', description => "(Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path", default => 1, action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; push @{$settings->runner->includes} => ( File::Spec->catdir('blib', 'lib'), File::Spec->catdir('blib', 'arch'), ); $settings->runner->lib(0); $settings->runner->blib(0); }, ); option unsafe_inc => ( description => "perl is removing '.' from \@INC as a security concern. This option keeps things from breaking for now.", env_vars => [qw/PERL_USE_UNSAFE_INC/], default => 0, ); option preloads => ( type => 'm', alt => ['preload'], short => 'P', description => 'Preload a module before running tests', ); option preload_threshold => ( short => 'W', alt => ['Pt'], type => 's', default => 0, description => "Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload." ); option nytprof => ( type => 'b', description => "Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork.", long_examples => [''], ); post \&cover_post_process; option cover => ( type => 'd', description => "Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: $DEFAULT_COVER_ARGS", long_examples => ['', '=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = $DEFAULT_COVER_ARGS if $norm eq '1'; return $$slot = $norm; }, ); option switch => ( field => 'switches', short => 'S', type => 'm', description => 'Pass the specified switch to perl for each test. This is not compatible with preload.', ); option fail_on_resource_skip => ( type => 'b', default => 0, description => 'Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing.', long_examples => [''], ); option resource_timeout => ( alt => ['rt'], type => 's', default => 0, long_examples => [' SECONDS'], short_examples => [' SECONDS'], description => 'Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout)', ); option stall_report => ( type => 'd', default => 0, autofill => '600:1200', long_examples => ['', '=STRONG:LOOSE', '=SECONDS'], description => 'Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath\'s own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200)', ); option stall_report_dir => ( type => 's', long_examples => [' path/to/dir'], description => 'Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable.', ); option event_timeout => ( alt => ['et'], type => 's', default => 60, long_examples => [' SECONDS'], short_examples => [' SECONDS'], description => 'Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever.', ); option post_exit_timeout => ( alt => ['pet'], type => 's', default => 15, long_examples => [' SECONDS'], short_examples => [' SECONDS'], description => 'Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis.' ); option runner_id => ( type => 's', default => sub { gen_uuid() }, description => 'Runner ID (usually a generated uuid)', ); }; sub jobs_post_process { my %params = @_; my $settings = $params{settings}; my $runner = $settings->runner or return; fix_job_resources($settings); $ENV{T2_HARNESS_MY_JOB_COUNT} = $runner->job_count; $ENV{T2_HARNESS_MY_MAX_JOB_CONCURRENCY} = $runner->slots_per_job; } sub fix_job_resources { my ($settings) = @_; my $runner = $settings->runner; require Test2::Harness::Runner::Resource::SharedJobSlots::Config; my $sconf = Test2::Harness::Runner::Resource::SharedJobSlots::Config->find(settings => $settings); my %found; for my $r (@{$runner->resources}) { require(mod2file($r)); next unless $r->job_limiter; $found{$r}++; } if ($sconf && !$found{'Test2::Harness::Runner::Resource::SharedJobSlots'} && !$sconf->disabled) { if (delete $found{'Test2::Harness::Runner::Resource::JobCount'}) { @{$settings->runner->resources} = grep { $_ ne 'Test2::Harness::Runner::Resource::JobCount' } @{$runner->resources}; } if (!keys %found) { require Test2::Harness::Runner::Resource::SharedJobSlots; unshift @{$runner->resources} => 'Test2::Harness::Runner::Resource::SharedJobSlots'; $found{'Test2::Harness::Runner::Resource::SharedJobSlots'}++; } } elsif (!keys %found) { require Test2::Harness::Runner::Resource::JobCount; unshift @{$runner->resources} => 'Test2::Harness::Runner::Resource::JobCount'; } if ($found{'Test2::Harness::Runner::Resource::SharedJobSlots'} && $sconf) { $runner->field(job_count => $sconf->default_slots_per_run || $sconf->max_slots_per_run) if $runner && !$runner->job_count; $runner->field(slots_per_job => $sconf->default_slots_per_job || $sconf->max_slots_per_job) if $runner && !$runner->slots_per_job; my $run_slots = $runner->job_count; my $job_slots = $runner->slots_per_job; die "Requested job count ($run_slots) exceeds the system shared limit (" . $sconf->max_slots_per_run . ").\n" if $run_slots > $sconf->max_slots_per_run; die "Requested job concurrency ($job_slots) exceeds the system shared limit (" . $sconf->max_slots_per_job . ").\n" if $job_slots > $sconf->max_slots_per_job; } $runner->field(job_count => 1) if $runner && !$runner->job_count; $runner->field(slots_per_job => 1) if $runner && !$runner->slots_per_job; my $run_slots = $runner->job_count; my $job_slots = $runner->slots_per_job; die "The slots_per_job (set to $job_slots) must not be larger than the job_count (set to $run_slots).\n" if $job_slots > $run_slots; } sub cover_post_process { my %params = @_; my $settings = $params{settings}; if ($ENV{T2_DEVEL_COVER} && !$settings->runner->cover) { $settings->runner->field(cover => $ENV{T2_DEVEL_COVER} eq '1' ? $ENV{T2_DEVEL_COVER} : $DEFAULT_COVER_ARGS); } return unless $settings->runner->cover; # For nested things $ENV{T2_NO_FORK} = 1; $ENV{T2_DEVEL_COVER} = $settings->runner->cover; $settings->runner->field(use_fork => 0); return unless $settings->check_prefix('run'); push @{$settings->run->load_import->{'@'}} => 'Devel::Cover'; $settings->run->load_import->{'Devel::Cover'} = [split(/,/, $settings->runner->cover)]; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Runner - Runner options for Yath. =head1 DESCRIPTION This is where command line options for the runner are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --fail-on-resource-skip =item --no-fail-on-resource-skip Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C<YATH_JOB_COUNT>, C<T2_HARNESS_JOB_COUNT>, C<HARNESS_JOB_COUNT> =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource-timeout SECONDS =item --rt SECONDS =item --no-resource-timeout Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout) =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C<T2_HARNESS_JOB_CONCURRENCY> =item --stall-report =item --stall-report=STRONG:LOOSE =item --stall-report=SECONDS =item --no-stall-report Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath's own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200) =item --stall-report-dir path/to/dir =item --no-stall-report-dir Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable. =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C<PERL_USE_UNSAFE_INC> =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C<!T2_NO_FORK>, C<T2_HARNESS_FORK>, C<!T2_HARNESS_NO_FORK>, C<YATH_FORK>, C<!YATH_NO_FORK> =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SysInfo.pm������������������������������������������������������������������������������������������100644��001750��001750�� 4612�15267772575� 22364� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Plugin�����������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::SysInfo; use strict; use warnings; our $VERSION = '1.000182'; use Sys::Hostname qw/hostname/; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; use Config qw/%Config/; use parent 'App::Yath::Plugin'; use Test2::Harness::Util::HashBase qw/-host_short_pattern/; sub inject_run_data { my $self = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my %data = ( env => { user => $ENV{USER}, shell => $ENV{SHELL}, term => $ENV{TERM}, }, ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_thread => CAN_THREAD(), can_sigsys => CAN_SIGSYS(), }, ); my ($short, $raw) = ('sys', 'system info'); if (my $hostname = hostname()) { $short = undef; $data{hostname} = $hostname; $raw = $hostname; if (my $pattern = $self->{+HOST_SHORT_PATTERN}) { if ($hostname =~ /($pattern)/) { $short = $1; } } unless ($short) { $short = $hostname; $short =~ s/\.[^\.]*$// while length($short) > 18 && $short =~ m/\./; } } my @fields = qw/uselongdouble use64bitall version use64bitint usemultiplicity osname useperlio useithreads archname/; @{$data{config}}{@fields} = @Config{@fields}; push @$fields => { name => 'sys', details => $short, raw => $raw, data => \%data, }; } sub TO_JSON { ref($_[0]) } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Plugin::SysInfo - Plugin to attach system information to a run. =head1 DESCRIPTION This plugin attaches a lot of system information to the yath log. This is mainly useful if you intend to view the log in L<Test2::Harness::UI>. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������Collector.pm����������������������������������������������������������������������������������������100644��001750��001750�� 37002�15267772575� 22460� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Collector; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Collector::JobDir; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::Queue; use Time::HiRes qw/sleep time/; use File::Spec; use MIME::Base64 qw/encode_base64/; use File::Path qw/remove_tree/; use Test2::Harness::Util::HashBase qw{ <run <workdir <run_id <show_runner_output <truncate_runner_output <truncated_runner_output <settings <run_dir <runner_pid +runner_exited <persistent_runner <backed_up +runner_stdout +runner_stderr +runner_aux_dir +runner_aux_handles +runner_attachments +task_file +task_queue +tasks_done +tasks +jobs_file +jobs_queue +jobs_done +jobs +pending <wait_time <idle_wait <action }; # Floor of the idle backoff. The ceiling is 'wait_time'. sub MIN_WAIT() { 0.001 } sub init { my $self = shift; croak "'run' is required" unless $self->{+RUN}; my $run_dir = File::Spec->catdir($self->{+WORKDIR}, $self->{+RUN_ID}); die "Could not find run dir" unless -d $run_dir; $self->{+RUN_DIR} = $run_dir; $self->{+WAIT_TIME} //= 0.02; $self->{+IDLE_WAIT} = MIN_WAIT; $self->{+ACTION}->($self->_harness_event(0, undef, time, harness_run => $self->{+RUN}, harness_settings => $self->settings, about => {no_display => 1})); } sub reset_idle_wait { my $self = shift; $self->{+IDLE_WAIT} = MIN_WAIT; return; } # Sleep for the current backoff, then double it up to the 'wait_time' ceiling. sub idle_sleep { my $self = shift; my $wait = $self->{+IDLE_WAIT}; sleep($wait); $wait *= 2; my $max = $self->{+WAIT_TIME}; $self->{+IDLE_WAIT} = $wait > $max ? $max : $wait; return; } sub process { my $self = shift; my %warning_seen; my $settings = $self->settings; while (1) { # $count is the liveness counter that guards loop exit: it also counts # jobs that exist but have produced nothing yet. $work counts events # actually processed, and is the only thing the sleep decision uses. my $count = 0; my $work = 0; $work += $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT}; $work += $self->process_tasks(); $count += $work; # jobs() emits harness_job_start events for any newly discovered jobs; # that counts as work. It cannot change $count: a new job means %$jobs # is not empty, so the loop below counts it. my $known = keys %{$self->{+JOBS} // {}}; my $jobs = $self->jobs; $work += (keys %$jobs) - $known; unless (keys %$jobs) { if ($count) { # Work was done, so do not sleep, but keep the backoff at its # floor for the next idle iteration. $self->reset_idle_wait; next; } if ($self->persistent_runner) { last if $self->{+JOBS_DONE}; last if $self->runner_done; } last if $self->runner_exited; } while(my ($job_try, $jdir) = each %$jobs) { $count++; my $e_count = 0; for my $event ($jdir->poll($self->settings->collector->max_poll_events // 1000)) { $self->{+ACTION}->($event); $e_count++; } $count += $e_count; $work += $e_count; next if $e_count; my $done = $jdir->done; unless ($done) { $count++; next; } delete $jobs->{$job_try}; unless ($settings->debug->keep_dirs) { my $job_path = $jdir->job_root; # Needed because we set the perms so that a tmpdir under it can be used. # This is the only remove_tree that needs it because it is the # only one in a process that did not initially create the dir. my $ok = eval { chmod(0700, $job_path); remove_tree($job_path, {safe => 1, keep_root => 0}); 1; }; my $err = $@; unless ($ok) { $count++; unless ($warning_seen{$job_path}++) { my $msg = "NON-FATAL Error deleting job dir ($job_path) will try again...: $err"; my $e = $self->_harness_event(0, undef, time, info => [{details => $msg, tag => "INTERNAL", debug => 1, important => 1}]); $self->{+ACTION}->($e); } next; } } delete $jobs->{$job_try}; delete $self->{+PENDING}->{$jdir->job_id} unless $done->{retry}; } last if !$count && $self->runner_exited; $work ? $self->reset_idle_wait : $self->idle_sleep; } # One last slurp $self->process_runner_output if $self->{+SHOW_RUNNER_OUTPUT}; $self->{+ACTION}->(undef) if $self->{+JOBS_DONE} && $self->{+TASKS_DONE}; remove_tree($self->{+RUN_DIR}, {safe => 1, keep_root => 0}) unless $settings->debug->keep_dirs; return; } sub runner_done { my $self = shift; return 0 if keys %{$self->{+PENDING}}; return 1; } sub runner_exited { my $self = shift; my $pid = $self->{+RUNNER_PID} or return undef; return $self->{+RUNNER_EXITED} if $self->{+RUNNER_EXITED}; return 0 if kill(0, $pid); return $self->{+RUNNER_EXITED} = 1; } sub process_runner_output { my $self = shift; my $out = 0; return $out unless $self->{+SHOW_RUNNER_OUTPUT}; my $action = $self->{+ACTION}; if ($self->{+TRUNCATE_RUNNER_OUTPUT} && !$self->{+TRUNCATED_RUNNER_OUTPUT}) { $action = sub {}; $self->{+TRUNCATED_RUNNER_OUTPUT} = 1; } my $stdout = $self->{+RUNNER_STDOUT} //= Test2::Harness::Util::File::Stream->new( name => File::Spec->catfile($self->{+WORKDIR}, 'output.log'), ); for my $line ($stdout->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => 'INTERNAL', important => 1}]); $action->($e); $out++; } my $stderr = $self->{+RUNNER_STDERR} //= Test2::Harness::Util::File::Stream->new( name => File::Spec->catfile($self->{+WORKDIR}, 'error.log'), ); for my $line ($stderr->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => 'INTERNAL', debug => 1, important => 1}]); $action->($e); $out++; } my $auxdir = $self->{+RUNNER_AUX_DIR} //= File::Spec->catdir($self->{+WORKDIR}, 'aux_logs'); return $out unless -d $auxdir; opendir(my $dh, $auxdir) or die "Could not open aux_logs dir: $!"; for my $path (readdir($dh)) { next if $path =~ m/^\.+$/; next if $self->{+RUNNER_AUX_HANDLES}->{$path}; my $tag = uc($path); next unless $tag =~ s/\.LOG$//; my $debug = 0; if ($tag =~ s/\W*(STDERR|STDOUT)\W*//g) { $debug = 1 if $1 && uc($1) eq 'STDERR'; } $self->{+RUNNER_AUX_HANDLES}->{$path} = { tag => $tag, debug => $debug, stream => Test2::Harness::Util::File::Stream->new(name => File::Spec->catfile($auxdir, $path)), }; } closedir($dh); $out += $self->process_runner_attachments($auxdir, $action); for my $file (sort keys %{$self->{+RUNNER_AUX_HANDLES}}) { my $data = $self->{+RUNNER_AUX_HANDLES}->{$file}; my $stream = $data->{stream}; for my $line ($stream->poll()) { chomp($line); my $e = $self->_harness_event(0, undef, time, info => [{details => $line, tag => $data->{tag}, debug => $data->{debug}, important => 1}]); $action->($e); $out++; } } return $out; } sub process_runner_attachments { my $self = shift; my ($auxdir, $action) = @_; my $dir = File::Spec->catdir($auxdir, 'attachments'); return 0 unless -d $dir; my $sent = $self->{+RUNNER_ATTACHMENTS} //= {}; opendir(my $dh, $dir) or die "Could not open aux_logs attachments dir: $!"; my @names = sort grep { !m/^\./ && !$sent->{$_} } readdir($dh); closedir($dh); my $out = 0; for my $name (@names) { my $path = File::Spec->catfile($dir, $name); next unless -f $path; # Marked before reading so an unreadable file warns once instead of every poll. $sent->{$name} = 1; my $fh; unless (open($fh, '<:raw', $path)) { warn "Could not attach '$path': $!"; next; } my $data = do { local $/; <$fh> }; unless (defined $data) { warn "Could not read '$path': $!"; next; } my $e = $self->_harness_event( 0, undef, time, info => [{details => "attached $name", tag => 'ARTIFACT', important => 1}], binary => [{ filename => $name, details => $name, data => encode_base64($data, ''), is_image => ($name =~ m/\.(a?png|gif|jpe?g|svg|bmp|ico)$/i ? 1 : 0), }], ); $action->($e); $out++; } return $out; } sub process_tasks { my $self = shift; return 0 if $self->{+TASKS_DONE}; my $queue = $self->tasks_queue or return 0; my $count = 0; for my $item ($queue->poll) { $count++; my ($spos, $epos, $task) = @$item; unless ($task) { $self->{+TASKS_DONE} = 1; last; } my $job_id = $task->{job_id} or die "No job id!"; $self->{+TASKS}->{$job_id} = $task; $self->{+PENDING}->{$job_id} = 1 + ($task->{retry} || $self->run->retry || 0); my $e = $self->_harness_event($job_id, $task->{is_try} // 0, $task->{stamp}, 'harness_job_queued' => $task); $self->{+ACTION}->($e); } return $count; } sub send_backed_up { my $self = shift; return if $self->{+BACKED_UP}++; # This is an unlikely code path. If we're here, it means the last loop couldn't process any results. my $e = $self->_harness_event(0, undef, time, info => [{details => <<" EOT", tag => "INTERNAL", debug => 1, important => 1}]); *** THIS IS NOT FATAL *** * The collector has reached the maximum number of concurrent jobs to process. * Testing will continue, but some tests may be running or even complete before they are rendered. * All tests and events will eventually be displayed, and your final results will not be effected. Set a higher --max-open-jobs collector setting to prevent this problem in the future, but be advised that could result in too many open filehandles on some systems. This message will only be shown once. EOT $self->{+ACTION}->($e); return; } sub jobs { my $self = shift; my $jobs = $self->{+JOBS} //= {}; return $jobs if $self->{+JOBS_DONE}; # Don't monitor more than 'max_open_jobs' or we might have too many open file handles and crash # Max open files handles on a process applies. Usually this is 1024 so we # can't have everything open at once when we're behind. my $max_open_jobs = $self->settings->collector->max_open_jobs // 1024; my $additional_jobs_to_parse = $max_open_jobs - keys %$jobs; if($additional_jobs_to_parse <= 0) { $self->send_backed_up; return $jobs; } my $queue = $self->jobs_queue or return $jobs; for my $item ($queue->poll($additional_jobs_to_parse)) { my ($spos, $epos, $job) = @$item; unless ($job) { $self->{+JOBS_DONE} = 1; last; } my $job_id = $job->{job_id} or die "No job id!"; die "Found job without a task!" unless $self->{+TASKS}->{$job_id}; $self->{+PENDING}->{$job_id}--; delete $self->{+PENDING}->{$job_id} if $self->{+PENDING}->{$job_id} < 1; my $file = $job->{file}; my $e = $self->_harness_event( $job_id, $job->{is_try}, $job->{stamp}, harness_job => $job, harness_job_start => { details => "Job $job_id started at $job->{stamp}", job_id => $job_id, stamp => $job->{stamp}, file => $file, rel_file => File::Spec->abs2rel($file), abs_file => File::Spec->rel2abs($file), }, harness_job_launch => { stamp => $job->{stamp}, retry => $job->{is_try}, }, ); $self->{+ACTION}->($e); my $job_try = $job_id . '+' . $job->{is_try}; $jobs->{$job_try} = Test2::Harness::Collector::JobDir->new( job_try => $job->{is_try} // 0, job_id => $job_id, run_id => $self->{+RUN_ID}, runner_pid => $self->{+RUNNER_PID}, job_root => File::Spec->catdir($self->{+RUN_DIR}, $job_try), ); } # The collector didn't read in all the jobs because it'd run out of file handles. We need to let the stream know we're behind. $self->send_backed_up if $max_open_jobs <= keys %$jobs; return $jobs; } sub _harness_event { my $self = shift; my ($job_id, $job_try, $stamp, %args) = @_; croak "Job id is required" unless defined $job_id; croak "Stamp is required" unless defined $stamp; return Test2::Harness::Event->new( stamp => $stamp, job_id => $job_id, job_try => $job_try, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => \%args, ); } sub jobs_queue { my $self = shift; return $self->{+JOBS_QUEUE} if $self->{+JOBS_QUEUE}; my $jobs_file = $self->{+JOBS_FILE} //= File::Spec->catfile($self->{+RUN_DIR}, 'jobs.jsonl'); return unless -f $jobs_file; return $self->{+JOBS_QUEUE} = Test2::Harness::Util::Queue->new(file => $jobs_file); } sub tasks_queue { my $self = shift; return $self->{+TASK_QUEUE} if $self->{+TASK_QUEUE}; my $tasks_file = $self->{+TASK_FILE} //= File::Spec->catfile($self->{+RUN_DIR}, 'queue.jsonl'); return unless -f $tasks_file; return $self->{+TASK_QUEUE} = Test2::Harness::Util::Queue->new(file => $tasks_file); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector - Module that collects test output and provides it as an event stream. =head1 DESCRIPTION This module is responsible for reading and parsing the output produced by multiple jobs running under yath. This module is not intended for external use, it is an implementation detail and can change at any time. Currently instances of this module are not passed to any plugins or callbacks. If you need a collector for a third-party command you should look at L<App::Yath::Command::collector>. When a command needs a collector (such as L<App::Yath::Command::test> does) it normally spawns a collector process by executing C<yath collector>. The C<start_collector()> subroutine in L<App::Yath::Command::test> is a good place to look for more details. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������File.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 13260�15267772575� 22326� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::File; use strict; use warnings; our $VERSION = '1.000182'; use IO::Handle; use Test2::Harness::Util(); use Carp qw/croak confess/; use Fcntl qw/SEEK_SET SEEK_CUR/; use Test2::Harness::Util::HashBase qw{ -name -_fh -_init_fh done -line_pos <skip_bad_decode }; sub exists { -e $_[0]->{+NAME} } sub decode { shift; $_[0] } sub encode { shift; $_[0] } sub init { my $self = shift; croak "'name' is a required attribute" unless $self->{+NAME}; $self->{+_INIT_FH} = delete $self->{fh}; } sub open_file { my $self = shift; return Test2::Harness::Util::open_file($self->{+NAME}, @_) } sub maybe_read { my $self = shift; return undef unless -e $self->{+NAME}; return $self->read; } sub read { my $self = shift; my $out = Test2::Harness::Util::read_file($self->{+NAME}); eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@"; return $out; } sub rewrite { my $self = shift; return Test2::Harness::Util::write_file($self->{+NAME}, $self->encode(@_)); } sub write { my $self = shift; return Test2::Harness::Util::write_file_atomic($self->{+NAME}, $self->encode(@_)); } sub reset { my $self = shift; delete $self->{+_FH}; delete $self->{+DONE}; delete $self->{+LINE_POS}; return; } sub fh { my $self = shift; return $self->{+_FH}->{$$} if $self->{+_FH}->{$$}; # Remove any other PID handles $self->{+_FH} = {}; if (my $fh = $self->{+_INIT_FH}) { $self->{+_FH}->{$$} = $fh; } else { $self->{+_FH}->{$$} = Test2::Harness::Util::maybe_open_file($self->{+NAME}) or return undef; } $self->{+_FH}->{$$}->blocking(0); return $self->{+_FH}->{$$}; } sub read_line { my $self = shift; my %params = @_; my $pos = $params{from}; $pos = $self->{+LINE_POS} ||= 0 unless defined $pos; my $fh = $self->{+_FH}->{$$} || $self->fh or return undef; seek($fh,$pos,SEEK_SET) or die "Could not seek: $!" if eof($fh) || tell($fh) != $pos; my $line = <$fh>; # No line, nothing to do return unless defined $line && length($line); # Partial line, hold off unless done return unless $self->{+DONE} || substr($line, -1, 1) eq "\n"; my $new_pos = tell($fh); die "Failed to 'tell': $!" if $new_pos == -1; my $err = 0; local $@; unless (eval { $line = $self->decode($line); 1 }) { $err = $@ // 'error'; confess "$self->{+NAME} ($pos -> $new_pos): $err" unless $self->{+SKIP_BAD_DECODE}; warn "Skipping line that failed to decode: $err\n" if $self->{+SKIP_BAD_DECODE} > 1; $line = undef; } $self->{+LINE_POS} = $new_pos unless defined $params{peek} || defined $params{from}; return $line unless wantarray; return ($pos, $new_pos, $line, $err); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File - Utility class for manipulating a file. =head1 DESCRIPTION This is a utility class for file operations. This also serves as a base class for several file helpers. =head1 SYNOPSIS use Test2::Harness::Util::File; my $f = Test2::Harness::Util::File->new(name => '/path/to/file'); $f->write($content); my $fh = $f->open_file('<'); # Read, throw exception if it cannot read my $content = $f->read(); # Try to read, but do not throw an exception if it cannot be read. my $content_or_undef = $f->maybe_read(); my $line1 = $f->read_line(); my $line2 = $f->read_line(); ... =head1 ATTRIBUTES =over 4 =item $filename = $f->name; Get the filename. Must also be provided during construction. =item $bool = $f->done; True if read_line() has read every line. =back =head1 METHODS =over 4 =item $decoded = $f->decode($encoded) This is a no-op, it returns the argument unchanged. This is called by C<read> and C<read_line>. Subclasses can override this if the file contains encoded data. =item $encoded = $f->encode($decoded) This is a no-op, it returns the argument unchanged. This is called by C<write>. Subclasses can override this if the file contains encoded data. =item $bool = $f->exists() Check if the file exists =item $content = $f->maybe_read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will return undef. =item $fh = $f->open_file() =item $fh = $f->open_file($mode) Open a handle to the file. If no $mode is provided C<< '<' >> is used. =item $content = $f->read() This will read the file if it can and return the content (all lines joined together as a single string). If the file cannot be read, or does not exist this will throw an exception. =item $line = $f->read_line() Read a single line from the file, subsequent calls will read the next line and so on until the end of the file is reached. Reset with the C<reset()> method. =item $f->reset() Reset the internal line iterator used by C<read_line()>. =item $f->write($content) This is an atomic-write. First $content will be written to a temporary file using C<< '>' >> mode. Then the temporary file will be renamed to the desired file name. Under the hood this uses C<write_file_atomic()> from L<Test2::Harness::Util>. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������JSON.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 14316�15267772575� 22223� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::JSON; use strict; use warnings; use Carp qw/croak/; our $VERSION = '1.000182'; BEGIN { local $@ = undef; my $ok = eval { require JSON::MaybeXS; JSON::MaybeXS->import('JSON'); 1; if (JSON() eq 'JSON::PP') { *JSON_IS_PP = sub() { 1 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 0 }; } elsif (JSON() eq 'JSON::XS') { *JSON_IS_PP = sub() { 0 }; *JSON_IS_XS = sub() { 1 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 1 }; } elsif (JSON() eq 'Cpanel::JSON::XS') { *JSON_IS_PP = sub() { 0 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 1 }; *JSON_IS_CPANEL_OR_XS = sub() { 1 }; } }; unless ($ok) { require JSON::PP; *JSON = sub() { 'JSON::PP' }; *JSON_IS_PP = sub() { 1 }; *JSON_IS_XS = sub() { 0 }; *JSON_IS_CPANEL = sub() { 0 }; *JSON_IS_CPANEL_OR_XS = sub() { 0 }; } } our @EXPORT = qw{JSON encode_json decode_json encode_pretty_json encode_canon_json stream_json_l stream_json_l_file stream_json_l_url}; our @EXPORT_OK = qw{JSON_IS_PP JSON_IS_XS JSON_IS_CPANEL JSON_IS_CPANEL_OR_XS}; BEGIN { require Exporter; our @ISA = qw(Exporter) } my $json = JSON->new->utf8(1)->convert_blessed(1)->allow_nonref(1); my $json_non_utf8 = JSON->new->utf8(0)->convert_blessed(1)->allow_nonref(1); my $canon = JSON->new->utf8(1)->canonical(1)->convert_blessed(1)->allow_nonref(1); my $pretty = JSON->new->utf8(1)->pretty(1)->canonical(1)->convert_blessed(1)->allow_nonref(1); sub encode_json { $json->encode(@_) } sub encode_canon_json { $canon->encode(@_) } sub encode_pretty_json { $pretty->encode(@_) } sub decode_json { my ($input) = @_; my $data; local $@; my $error; # Try to decode the JSON stream as utf8. In malformed tests or tests which are intentionally # testing bytes behavior we need to accept the bytes from the JSON file instead. my $ok = eval { $data = $json->decode($input); 1 } || do { $error = $@; eval { $data = $json_non_utf8->decode($input); 1 }; }; $error ||= $@; return $data if $ok; my $mess = Carp::longmess("JSON decode error: $error"); die "$mess\n=======\n$input\n=======\n"; } sub stream_json_l { my ($path, $handler, %params) = @_; croak "No path provided" unless $path; return stream_json_l_file($path, $handler) if -f $path; return stream_json_l_url($path, $handler, %params) if $path =~ m{^https?://}; croak "'$path' is not a valid path (file does not exist, or is not an http(s) url)"; } sub stream_json_l_file { my ($path, $handler) = @_; croak "Invalid file '$path'" unless -f $path; croak "Path must have a .json or .jsonl extension with optional .gz or .bz2 postfix." unless $path =~ m/\.(json(?:l)?)(?:.(?:bz2|gz))?$/; if ($1 eq 'json') { require Test2::Harness::Util::File::JSON; my $json = Test2::Harness::Util::File::JSON->new(name => $path); $handler->($json->read); } else { require Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => $path); while (my ($item) = $jsonl->poll(max => 1)) { $handler->($item); } } return 1; } sub stream_json_l_url { my ($path, $handler, %params) = @_; my $meth = $params{http_method} // 'get'; my $args = $params{http_args} // []; require HTTP::Tiny; my $ht = HTTP::Tiny->new(); my $buffer = ''; my $iterate = sub { my ($res) = @_; my @parts = split /(\n)/, $buffer; while (@parts > 1) { my $line = shift @parts; my $nl = shift @parts; my $data; unless (eval { $data = decode_json($line); 1 }) { warn "Unable to decode json for chunk when parsing json/l chunk:\n----\n$line\n----\n$@\n----\n"; next; } $handler->($data, $res); } $buffer = shift @parts // ''; }; my $res = $ht->$meth( $path, { @$args, data_callback => sub { my ($chunk, $res) = @_; $buffer .= $chunk; $iterate->($res); }, } ); if (length($buffer)) { $buffer .= "\n" unless $buffer =~ m/\n$/; $iterate->($res); } return $res; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::JSON - Utility class to help Test2::Harness pick the best JSON implementation. =head1 DESCRIPTION This package provides functions for encoding/decoding json, and uses the best json tools available. =head1 SYNOPSIS use Test2::Harness::Util::JSON qw/encode_json decode_json/; my $data = { foo => 1 }; my $json = encode_json($data); my $copy = decode_json($json); =head1 EXPORTS =over 4 =item $package = JSON() This returns the JSON package being used by yath. =item $bool = JSON_IS_PP() True if yath is using L<JSON::PP>. =item $bool = JSON_IS_XS() True if yath is using L<JSON::XS>. =item $bool = JSON_IS_CPANEL() True if yath is using L<Cpanel::JSON::XS>. =item $bool = JSON_IS_CPANEL_OR_XS() True if either L<JSON::XS> or L<Cpanel::JSON::XS> are being used. =item $string = encode_json($data) Encode data into json. String will be 1-line. =item $data = decode_json($string) Decode json data from the string. =item $string = encode_pretty_json($data) Encode into human-friendly json. =item $string = encode_canon_json($data) Encode into canon-json. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Term.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 3206�15267772575� 22335� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::Term; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Util qw/IS_WIN32/; use Importer Importer => 'import'; our @EXPORT_OK = qw/USE_ANSI_COLOR/; { my $use = 0; local ($@, $!); if (eval { require Term::ANSIColor; Term::ANSIColor->VERSION('4.03') }) { if (IS_WIN32) { if (eval { require Win32::Console::ANSI }) { Win32::Console::ANSI->import(); $use = 1; } } else { $use = 1; } } if ($use) { *USE_ANSI_COLOR = sub() { 1 }; } else { *USE_ANSI_COLOR = sub() { 0 }; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::Term - Terminal utilities for Test2::Harness =head1 DESCRIPTION This module provides information about the terminal in which the harness is running. =head1 SYNOPSIS use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/; if (USE_ANSI_COLOR) { ... } else { ... } =head1 EXPORTS =over 4 =item $bool = USE_ANSI_COLOR() True if L<Term::ANSIColor> is available and usable. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������UUID.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 2363�15267772575� 22177� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::UUID; use strict; use warnings; our $VERSION = '1.000182'; use Data::UUID; use Importer 'Importer' => 'import'; our @EXPORT = qw/gen_uuid/; our @EXPORT_OK = qw/UG gen_uuid/; my ($UG, $UG_PID); sub UG { return $UG if $UG && $UG_PID && $UG_PID == $$; $UG_PID = $$; return $UG = Data::UUID->new; } sub gen_uuid { UG()->create_str() } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::UUID - Utils for generating UUIDs. =head1 DESCRIPTION This module provides a consistent UUID source for all of Test2::Harness. =head1 SYNOPSIS use Test2::Harness::Util::UUID qw/gen_uuid/; my $uuid = gen_uuid; =head1 EXPORTS =over 4 =item $uuid = gen_uuid() Generate a UUID. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������concurrency�����������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21760� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 22701� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/concurrency�����������������������������������������������������������������������������������������������������������������������use Test2::V0; use TestBarrier qw/barrier_wait/; # Do not finish until the run has as many of these going at once as it was # told to allow, so the log has a real overlap to measure. barrier_wait(); ok(1, "pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 22702� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/concurrency�����������������������������������������������������������������������������������������������������������������������use Test2::V0; use TestBarrier qw/barrier_wait/; # Do not finish until the run has as many of these going at once as it was # told to allow, so the log has a real overlap to measure. barrier_wait(); ok(1, "pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 22703� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/concurrency�����������������������������������������������������������������������������������������������������������������������use Test2::V0; use TestBarrier qw/barrier_wait/; # Do not finish until the run has as many of these going at once as it was # told to allow, so the log has a real overlap to measure. barrier_wait(); ok(1, "pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 22704� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/concurrency�����������������������������������������������������������������������������������������������������������������������use Test2::V0; use TestBarrier qw/barrier_wait/; # Do not finish until the run has as many of these going at once as it was # told to allow, so the log has a real overlap to measure. barrier_wait(); ok(1, "pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������e.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 22705� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/concurrency�����������������������������������������������������������������������������������������������������������������������use Test2::V0; use TestBarrier qw/barrier_wait/; # Do not finish until the run has as many of these going at once as it was # told to allow, so the log has a real overlap to measure. barrier_wait(); ok(1, "pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������once.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 643�15267772575� 22645� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; ok(1); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); done_testing; ���������������������������������������������������������������������������������������������open.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 735�15267772575� 22664� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Plugin::Cover; use Path::Tiny; use Test2::Harness::Util::JSON qw/encode_json/; STDIN->blocking(0); Test2::Plugin::Cover->set_root(path('t/integration/coverage/lib')->realpath); print "INPUT ${ \__FILE__ }: " . encode_json({ env => {map { ($_ => $ENV{$_}) } grep { m/^COVER_TEST_/ } keys %ENV}, argv => [@ARGV], stdin => join('' => <STDIN>), }) . "\n"; open(my $fh, '<', "t/integration/coverage/lib/Bx.pm"); ok(1); done_testing; �����������������������������������fail.txx��������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22700� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/persist���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������retry.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 142�15267772575� 22713� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; #HARNESS-RETRY ok($ENV{T2_HARNESS_JOB_IS_TRY}, "This is a retry"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������slots_per_job2.t������������������������������������������������������������������������������������100644��001750��001750�� 737�15267772575� 22670� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use List::Util qw/min/; # HARNESS-JOB-SLOTS 1 3 skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); is($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, in_set(1, 2, 3), "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); done_testing; ���������������������������������slots_per_job3.t������������������������������������������������������������������������������������100644��001750��001750�� 625�15267772575� 22665� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-JOB-SLOTS 2 skip_all "This test only works under Test2::Harness" unless $ENV{TEST2_HARNESS_ACTIVE}; ok(!$ENV{T2_HARNESS_JOB_CONCURRENCY}, "T2_HARNESS_JOB_CONCURRENCY is not set"); ok($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, "Have job concurrency set ($ENV{T2_HARNESS_MY_JOB_CONCURRENCY})"); is($ENV{T2_HARNESS_MY_JOB_CONCURRENCY}, 2, "Have job concurrency set (2)"); done_testing; �����������������������������������������������������������������������������������������������������������speedtag��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21222� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22646� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/speedtag��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Command���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20654� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath����������������������������������������������������������������������������������������������������������������������������������fake.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 416�15267772575� 22241� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath/Command��������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::fake; use strict; use warnings; use parent 'App::Yath::Command'; use App::Yath::Options; option_group {prefix => 'fake'}, sub { option($_, short => $_) for qw/x y z/; post sub { print "\n\nAAAA\n\n"; $main::POST_HOOK++ }; }; 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Command���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21065� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������init.t����������������������������������������������������������������������������������������������100644��001750��001750�� 2131�15267772575� 22352� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Command�������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Command::init'; # HARNESS-DURATION-SHORT use ok $CLASS; use App::Yath::Tester qw/make_example_dir/; use Cwd qw/getcwd/; my $orig = getcwd(); subtest run => sub { my $dir = make_example_dir(); chdir($dir); unlink('test.pl') or die "Could not unlink test.pl" if -e 'test.pl'; my $stdout = ""; { local *STDOUT; open(STDOUT, '>', \$stdout); is($CLASS->run(), 0, "Exit of 0"); ok(-e 'test.pl', "Added test.pl"); is($CLASS->run(), 0, "Exit of 0 if we are updating a generated one"); unlink('test.pl') or die "Could not unlink test.pl"; open(my $fh, '>', 'test.pl') or die "Could not open test.pl"; print $fh "xx\n"; close($fh); } is( $stdout, "\nWriting test.pl...\n\n\nWriting test.pl...\n\n", "Saw write info both times" ); is( dies { $CLASS->run() }, "'test.pl' already exists, and does not appear to be a yath runner.\n", "Cannot override a non-generated test.pl" ); }; done_testing; chdir($orig); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test.t����������������������������������������������������������������������������������������������100644��001750��001750�� 13043�15267772575� 22412� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Command�������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Command::test'; # HARNESS-DURATION-SHORT use ok $CLASS; use Errno(); use Test2::Harness::Settings(); use Test2::Harness::Util::JSON qw/encode_json/; use constant SETTINGS => App::Yath::Command::test::SETTINGS(); use constant RENDERERS => App::Yath::Command::test::RENDERERS(); use constant RENDERER_READER => App::Yath::Command::test::RENDERER_READER(); use constant ASSERTS_SEEN => App::Yath::Command::test::ASSERTS_SEEN(); # render() reads a pipe and drives renderers; it needs no run behind it. Build # the object directly. Note ipc() is lazy and self-building, so render() always # gets a real Test2::Harness::IPC. That is harmless here: it installs no signal # handlers until start(), and wait() returns immediately with no processes. sub build_cmd { my ($reader, @renderers) = @_; my $settings = Test2::Harness::Settings->new( harness => {plugins => []}, logging => {log => 0}, ); return bless( { SETTINGS() => $settings, RENDERERS() => \@renderers, RENDERER_READER() => $reader, }, $CLASS, ); } sub event_line { my ($fd) = @_; return encode_json({facet_data => $fd}) . "\n"; } # Runs $cmd->render() under an alarm. Returns 1 if it returned on its own, # 0 if the alarm had to break it out. sub render_under_alarm { my ($cmd, $timeout) = @_; local $SIG{ALRM} = sub { die "render-still-running\n" }; alarm $timeout; my $ok = eval { $cmd->render(); 1 }; my $err = $@; alarm 0; return 1 if $ok; die $err unless $err eq "render-still-running\n"; return 0; } subtest eof_ends_the_loop => sub { pipe(my $r, my $w) or die "Could not create pipe: $!"; $w->autoflush(1); print $w event_line({assert => {pass => 1}}); close($w); my $cmd = build_cmd($r); ok(render_under_alarm($cmd, 10), "loop ended on EOF"); is($cmd->{+ASSERTS_SEEN}, 1, "processed the event before EOF"); }; subtest live_writer_does_not_end_the_loop => sub { pipe(my $r, my $w) or die "Could not create pipe: $!"; # Without autoflush nothing is ever readable and the test proves nothing. $w->autoflush(1); print $w event_line({assert => {pass => 1}}); my $cmd = build_cmd($r); # The writer stays open and the pipe goes empty. render() must still be # looping when the alarm fires; returning would mean it mistook "nothing # yet" for EOF and truncated a healthy run. ok(!render_under_alarm($cmd, 2), "render() did not return while the writer was alive"); is($cmd->{+ASSERTS_SEEN}, 1, "processed the event that was available"); close($w); }; subtest null_sentinel_ends_the_loop => sub { pipe(my $r, my $w) or die "Could not create pipe: $!"; $w->autoflush(1); # The collector and auditor end the stream with a literal JSON null. That # path must keep working, with the writer still open. print $w "null\n"; my $cmd = build_cmd($r); ok(render_under_alarm($cmd, 10), "render() returned on the null sentinel"); close($w); }; subtest partial_line_at_eof_is_reported => sub { pipe(my $r, my $w) or die "Could not create pipe: $!"; $w->autoflush(1); print $w event_line({assert => {pass => 1}}); print $w '{"facet_data":{"assert"'; # no newline, writer then goes away close($w); my $cmd = build_cmd($r); my $stderr = ""; my $returned; { local *STDERR; open(STDERR, '>', \$stderr) or die "Could not redirect STDERR: $!"; $returned = render_under_alarm($cmd, 10); } ok($returned, "render() returned instead of dying on the fragment"); like($stderr, qr/Incomplete event discarded/, "reported the incomplete event"); like($stderr, qr/\Q{"facet_data":{"assert"\E/, "included the fragment"); }; subtest oversized_fragment_is_truncated => sub { pipe(my $r, my $w) or die "Could not create pipe: $!"; $w->autoflush(1); print $w '{"facet_data":' . ('x' x 5000); # no newline close($w); my $cmd = build_cmd($r); my $stderr = ""; my $returned; { local *STDERR; open(STDERR, '>', \$stderr) or die "Could not redirect STDERR: $!"; $returned = render_under_alarm($cmd, 10); } ok($returned, "render() returned"); like($stderr, qr/\Q... (truncated)\E/, "bounded the reported fragment"); ok(length($stderr) < 500, "did not dump the whole fragment") or diag(length($stderr)); }; # A renderer that leaves a stale errno behind. { package Fake::Renderer::DirtyErrno; sub new { return bless({}, shift) } sub step { $! = Errno::EAGAIN(); return } sub render_event { return } } subtest renderer_in_the_loop_still_reaches_eof => sub { # The only coverage where render() actually drives a renderer. It also # exercises a renderer leaving a stale errno behind; on this perl that # cannot fail, because the value it leaves is the one PerlIO retries past. pipe(my $r, my $w) or die "Could not create pipe: $!"; $w->autoflush(1); print $w event_line({assert => {pass => 1}}); print $w '{"facet_data":{"assert"'; # partial, then EOF close($w); my $cmd = build_cmd($r, Fake::Renderer::DirtyErrno->new); my $stderr = ""; my $returned; { local *STDERR; open(STDERR, '>', \$stderr) or die "Could not redirect STDERR: $!"; $returned = render_under_alarm($cmd, 10); } ok($returned, "reached EOF despite a renderer leaving EAGAIN in errno"); is($cmd->{+ASSERTS_SEEN}, 1, "processed the complete event first"); }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������auditor.pm������������������������������������������������������������������������������������������100644��001750��001750�� 23312�15267772575� 22577� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::auditor; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use Scalar::Util qw/blessed/; use App::Yath::Util qw/isolate_stdout/; use Test2::Harness::Util::JSON qw/decode_json encode_json/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Run; use Test2::Harness::Stall::Trace qw/install_trace_handler/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'auditor' } sub run { my $self = shift; my ($auditor_class, $run_id, %args) = @{$self->{+ARGS}}; my $name = 'yath-auditor'; $name = "$args{procname_prefix}-${name}" if $args{procname_prefix}; $0 = $name; my $fh = isolate_stdout(); install_trace_handler($args{stall_dir}) if $args{stall_dir}; require(mod2file($auditor_class)); my $auditor = $auditor_class->new( %args, run_id => $run_id, action => sub { print $fh defined($_[0]) ? blessed($_[0]) ? $_[0]->as_json . "\n" : encode_json($_[0]) . "\n" : "null\n" }, ); local $SIG{PIPE} = 'IGNORE'; my $ok = eval { $auditor->process(); 1 }; my $err = $@; eval { $auditor->finish(); 1 } or warn $@; die $err unless $ok; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::auditor - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] auditor [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Display.pm������������������������������������������������������������������������������������������100644��001750��001750�� 22614�15267772575� 22616� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Display; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util qw/mod2file/; use App::Yath::Options; option_group {prefix => 'display', category => "Display Options"} => sub { option color => ( description => "Turn color on, default is true if STDOUT is a TTY.", default => sub { -t STDOUT ? 1 : 0 }, ); option quiet => ( short => 'q', type => 'c', description => "Be very quiet.", default => 0, ); option verbose => ( short => 'v', type => 'c', description => "Be more verbose", default => 0, ); option no_wrap => ( type => 'b', description => "Do not do fancy text-wrapping, let the terminal handle it", default => 0, ); option no_final_table => ( type => 'b', description => "When printing final results, don't use table-style display", default => 0, ); option show_times => ( short => 'T', description => 'Show the timing data for each job', ); option hide_runner_output => ( description => 'Hide output from the runner, showing only test output. (See Also truncate_runner_output)', default => 0, ); option truncate_runner_output => ( description => 'Only show runner output that was generated after the current command. This is only useful with a persistent runner.', default => 0, ); option term_width => ( type => 's', alt => ['term-size'], description => 'Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified.', long_examples => [' 80', ' 200'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; $ENV{TABLE_TERM_SIZE} = $norm; }, ); option 'progress' => ( default => sub { -t STDOUT ? 1 : 0 }, description => "Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display", ); option renderers => ( alt => ['renderer'], type => 'H', description => 'Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument.', long_examples => [' +My::Renderer', ' Renderer=arg1,arg2,...'], short_examples => [' +My::Renderer', ' Renderer=arg1,arg2,...'], action => sub { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler) = @_; my ($class, $args) = @$norm; $class = "Test2::Harness::Renderer::$class" unless $class =~ s/^\+//; my $file = mod2file($class); my $ok = eval { require $file; 1 }; warn "Failed to load renderer '$class': $@" unless $ok; $handler->($slot, [$class, $args]); }, ); post 100 => sub { my %params = @_; my $settings = $params{settings}; my $display = $settings->display; my $renderers = $display->renderers; my $quiet = $display->quiet; my $verbose = $display->verbose; die "The 'quiet' and 'verbose' options may not be used together.\n" if $verbose && $quiet; if ($quiet) { delete $renderers->{'Test2::Harness::Renderer::Formatter'}; @{$renderers->{'@'}} = grep { $_ ne 'Test2::Harness::Renderer::Formatter' } @{$renderers->{'@'}}; return; } my @args = map { $_ => $settings->formatter->$_ } qw{ formatter show_run_info show_job_info show_job_launch show_job_end }; push @args => map { $_ => $settings->display->$_ } qw{ progress color quiet verbose show_times }; if (my $formatter_args = $renderers->{'Test2::Harness::Renderer::Formatter'}) { @$formatter_args = @args unless @$formatter_args; return; } return if $renderers->{'@'} && @{$renderers->{'@'}}; push @{$renderers->{'@'}} => 'Test2::Harness::Renderer::Formatter'; $renderers->{'Test2::Harness::Renderer::Formatter'} = \@args; }; }; option_group {prefix => 'formatter', category => "Formatter Options"} => sub { option formatter => ( type => 's', ); option 'qvf' => ( description => '[Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output.', ); option show_job_end => ( description => 'Show output when a job ends. (Default: on)', default => 1, ); option show_job_info => ( description => 'Show the job configuration when a job starts. (Default: off, unless -vv)', default => 0, ); option show_job_launch => ( description => "Show output for the start of a job. (Default: off unless -v)", default => 0, ); option show_run_info => ( description => 'Show the run configuration when a run starts. (Default: off, unless -vv)', default => 0, ); post 90 => sub { my %params = @_; my $settings = $params{settings}; $settings->formatter->field(formatter => $settings->formatter->qvf ? 'QVF' : 'Test2') unless defined $settings->formatter->formatter; $settings->formatter->field(show_job_launch => 1) if $settings->display->verbose > 0; if ($settings->display->verbose > 1) { $settings->formatter->field(show_job_info => 1); $settings->formatter->field(show_run_info => 1); } }; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Display - Display options for Yath. =head1 DESCRIPTION This is where display options are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������Logging.pm������������������������������������������������������������������������������������������100644��001750��001750�� 14606�15267772575� 22601� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Logging; use strict; use warnings; our $VERSION = '1.000182'; use POSIX qw/strftime/; use Test2::Harness::Util qw/clean_path/; use File::Spec; use App::Yath::Options; option_group {prefix => 'logging', category => "Logging Options"} => sub { option log => ( short => 'L', description => 'Turn on logging', ); option log_file_format => ( alt => ['lff'], type => 's', env_vars => [qw/YATH_LOG_FILE_FORMAT TEST2_HARNESS_LOG_FORMAT/], default => sub { '%!P%Y-%m-%d_%H:%M:%S_%!U.jsonl' }, description => 'Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC)', ); option bzip2 => ( short => 'B', alt => ['bz2', 'bzip2_log'], description => 'Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you', ); option gzip => ( short => 'G', alt => ['gz', 'gzip_log'], description => 'Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you', ); option log_dir => ( type => 's', normalize => \&clean_path, description => 'Specify a log directory. Will fall back to the system temp dir.', ); option log_file => ( short => 'F', type => 's', normalize => \&clean_path, description => "Specify the name of the log file. This option implies -L.", ); post \&post_process; }; sub post_process { my %params = @_; my $settings = $params{settings}; my $logging = $settings->logging; die "You cannot specify both bzip2-log and gzip-log\n" if $logging->bzip2 && $logging->gzip; return unless $logging->log || $logging->bzip2 || $logging->gzip || $logging->log_file; # We want to keep the log and put it in a findable location $logging->field(log => 1); unless ($logging->log_file) { my $log_dir = $logging->log_dir // ($settings->check_prefix('workspace') ? $settings->workspace->tmp_dir : File::Spec->tmpdir); mkdir($log_dir) or die "Could not create dir '$log_dir': $!" unless -d $log_dir; my $format = $logging->log_file_format; my $filename = expand_log_file_format($format, $settings); $logging->field(log_file => clean_path(File::Spec->catfile($log_dir, $filename))); } my $log_file = $logging->log_file; $log_file =~ s{/+$}{}g; $log_file =~ s/\.(gz|bz2)$//; $log_file =~ s/\.jsonl?$//; $log_file .= "\.jsonl"; $log_file .= "\.bz2" if $logging->bzip2; $log_file .= "\.gz" if $logging->gzip; $logging->field(log_file => $log_file); } sub time_for_strftime { time() } sub expand_log_file_format { my ($pattern, $settings) = @_; my $before = $pattern; $pattern =~ s{%!(\w)}{expand($1, $settings)}ge; my $res = strftime($pattern, localtime(time_for_strftime())); return $res; } sub expand { my ($letter, $settings) = @_; # This could be driven by a hash, but for now if-else is easiest if ($letter eq "U") { return $settings->run->run_id } elsif ($letter eq "p") { return $$ } elsif ($letter eq "P") { my $project = $settings->harness->project // return ""; return $project . "~"; } elsif ($letter eq "S") { # Number of seconds since midnight my ($s, $m, $h) = (localtime(time_for_strftime()))[0, 1, 2]; return sprintf("%05d", $s + 60 * $m + 3600 * $h); } else { # unrecognized `%!x` expansion. Should we warn? Die? return "%!$letter"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Logging - Logging options for yath =head1 DESCRIPTION This is where the command line options for logging are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������Persist.pm������������������������������������������������������������������������������������������100644��001750��001750�� 2414�15267772575� 22616� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Persist; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Util qw/IS_WIN32/; use Test2::Harness::Util qw/clean_path/; use App::Yath::Options; option_group {prefix => 'runner', category => "Runner Options"} => sub { option daemon => ( description => 'Start the runner as a daemon (Default: True)', default => 1, ); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Persist - Persistent Runner options for Yath. =head1 DESCRIPTION This is where the command line options for the persistent runner are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Runner Options =over 4 =item --daemon =item --no-daemon Start the runner as a daemon (Default: True) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Runner����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21263� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Job.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 54011�15267772575� 22514� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Job; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/confess croak/; use Config qw/%Config/; use List::Util qw/min/; use Scalar::Util qw/weaken blessed/; use Test2::Util qw/CAN_REALLY_FORK/; use Time::HiRes qw/time/; use File::Spec(); use File::Temp(); use Test2::Harness::Util qw/fqmod clean_path write_file_atomic write_file mod2file open_file parse_exit process_includes chmod_tmp/; use Test2::Harness::IPC; use parent 'Test2::Harness::IPC::Process'; use Test2::Harness::Util::HashBase( qw{ <task <runner <run <settings }, # required qw{ <fork_callback <last_output_size +output_changed +verbose +via +run_dir +job_dir +tmp_dir +event_dir +ch_dir +unsafe_inc +use_fork +use_w_switch +includes +runner_includes +switches +use_stream +cli_includes +cli_options +smoke +retry +retry_isolated +is_try +args +file +run_file +out_file +err_file +in_file +bail_file +load +load_import +event_uuids +mem_usage +io_events +env_vars +event_timeout +post_exit_timeout +use_timeout +switches_from_env +et_file +pet_file +min_slots +max_slots } ); sub category { 'job' } sub init { my $self = shift; croak "'runner' is a required attribute" unless $self->{+RUNNER}; croak "'run' is a required attribute" unless $self->{+RUN}; croak "'settings' is a required attribute" unless $self->{+SETTINGS}; delete $self->{+JOB_DIR}; # Avoid a ref cycle #weaken($self->{+RUNNER}); my $task = $self->{+TASK} or croak "'task' is a required attribute"; delete $self->{+LAST_OUTPUT_SIZE}; confess "Task does not have a job ID" unless $task->{job_id}; confess "Task does not have a file" unless $task->{file}; } sub job_id { $_[0]->{+TASK}->{job_id} } sub prepare_dir { my $self = shift; $self->job_dir(); $self->tmp_dir(); $self->event_dir(); } sub via { my $self = shift; return undef if $self->{+SETTINGS}->debug->dummy; return undef if $self->{+TASK}->{resource_skip}; return $self->{+VIA} if exists $self->{+VIA}; my $task = $self->{+TASK}; return $self->{+VIA} = $task->{via} if $task->{via}; return $self->{+VIA} = $self->{+FORK_CALLBACK} if $self->{+FORK_CALLBACK} && $self->use_fork; return $self->{+VIA} = undef; } sub spawn_params { my $self = shift; my $task = $self->{+TASK}; my $skip; my $resource_skip_is_fail; $skip = 'dummy mode' if $self->{+SETTINGS}->debug->dummy; if ($self->{+TASK}->{resource_skip}) { my $msg = "Some resources are not available: " . join(', ' => @{$self->{+TASK}->{resource_skip}}); $skip = $msg; $resource_skip_is_fail = 1 if $self->{+SETTINGS}->runner->fail_on_resource_skip; } my $command; if (!$skip && $task->{binary} || $task->{non_perl}) { my $file = $self->ch_dir ? $self->file : $self->rel_file; $file = clean_path($file); $command = [$file, $self->args]; unshift @$command => $^X if $task->{non_perl} && !(-x $file) && !$task->{binary}; } else { my @skip_or_fail; if ($skip && $resource_skip_is_fail) { @skip_or_fail = ('-e', "print \"1..1\\nnot ok 1 - $skip\\n\""); } elsif ($skip) { @skip_or_fail = ('-e', "print \"1..0 # SKIP $skip\""); } $command = [ $^X, $self->cli_includes, $self->{+SETTINGS}->runner->nytprof ? ('-d:NYTProf') : (), $self->switches, $self->cli_options, @skip_or_fail ? @skip_or_fail : (sub { $self->run_file }), $self->args, ]; } my $out_fh = open_file($self->out_file, '>'); my $err_fh = open_file($self->err_file, '>'); my $in_fh = open_file($self->in_file, '<'); return { command => $command, stdin => $in_fh, stdout => $out_fh, stderr => $err_fh, chdir => $self->ch_dir(), env => $self->env_vars(), }; } sub switches_from_env { my $self = shift; return @{$self->{+SWITCHES_FROM_ENV}} if $self->{+SWITCHES_FROM_ENV}; return @{$self->{+SWITCHES_FROM_ENV} = []} unless $ENV{HARNESS_PERL_SWITCHES}; return @{$self->{+SWITCHES_FROM_ENV} = [split /\s+/, $ENV{HARNESS_PERL_SWITCHES}]}; } my %JSON_SKIP = ( SETTINGS() => 1, TASK() => 1, RUNNER() => 1, RUN() => 1, CLI_INCLUDES() => 1, CLI_OPTIONS() => 1, ERR_FILE() => 1, ET_FILE() => 1, EVENT_DIR() => 1, EXIT() => 1, EXIT_TIME() => 1, IN_FILE() => 1, JOB_DIR() => 1, LAST_OUTPUT_SIZE() => 1, OUT_FILE() => 1, BAIL_FILE() => 1, OUTPUT_CHANGED() => 1, PET_FILE() => 1, RUN_DIR() => 1, TMP_DIR() => 1, ); sub TO_JSON { my $self = shift; my $out = { %{$self->{+TASK}} }; for my $attr (Test2::Harness::Util::HashBase::attr_list(blessed($self))) { next if $JSON_SKIP{$attr}; $self->$attr unless defined $self->{$attr}; $out->{$attr} = $self->{$attr}; } delete $out->{+FORK_CALLBACK}; delete $out->{+VIA} if ref($out->{+VIA}) eq 'CODE'; $out->{job_name} //= $out->{job_id}; $out->{abs_file} = clean_path($self->file); return $out; } sub run_file { my $self = shift; return $self->{+RUN_FILE} //= $self->rel_file; } sub rel_file { File::Spec->abs2rel($_[0]->file) } sub file { $_[0]->{+FILE} //= clean_path($_[0]->{+TASK}->{file}, 0) } sub err_file { $_[0]->{+ERR_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'stderr')) } sub out_file { $_[0]->{+OUT_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'stdout')) } sub bail_file { $_[0]->{+BAIL_FILE} //= clean_path(File::Spec->catfile($_[0]->event_dir, 'bail')) } sub et_file { $_[0]->{+ET_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'event_timeout')) } sub pet_file { $_[0]->{+PET_FILE} //= clean_path(File::Spec->catfile($_[0]->job_dir, 'post_exit_timeout')) } sub run_dir { $_[0]->{+RUN_DIR} //= clean_path(File::Spec->catdir($_[0]->{+RUNNER}->dir, $_[0]->{+RUN}->run_id)) } sub bailed_out { my $self = shift; if(-f $self->bail_file) { my $fh = open_file($self->bail_file, '<'); my $reason = <$fh> || 1; return $reason; } my $fh = open_file($self->out_file, '<'); while (my $line = <$fh>) { next unless $line =~ m/^Bail out!\s*(.*)$/; return $1 || 1; } return ""; } sub output_size { my $self = shift; my $size = 0; $size += -s $self->err_file || 0; $size += -s $self->out_file || 0; return $self->{+LAST_OUTPUT_SIZE} = $size; } sub output_changed { my $self = shift; my $last = $self->{+LAST_OUTPUT_SIZE}; my $size = $self->output_size(); # Output changed, update time return $self->{+OUTPUT_CHANGED} = time() if $last && $size != $last; # Return the last recorded time, if there is no previously recorded time then the record starts now return $self->{+OUTPUT_CHANGED} //= time(); } sub verbose { $_[0]->{+VERBOSE} //= $_[0]->{+TASK}->{verbose} // 0 } sub is_try { $_[0]->{+IS_TRY} //= $_[0]->{+TASK}->{is_try} // 0 } sub ch_dir { $_[0]->{+CH_DIR} //= $_[0]->{+TASK}->{ch_dir} // '' } sub unsafe_inc { $_[0]->{+UNSAFE_INC} //= $_[0]->{+RUNNER}->unsafe_inc } sub event_uuids { $_[0]->{+EVENT_UUIDS} //= $_[0]->run->event_uuids } sub mem_usage { $_[0]->{+MEM_USAGE} //= $_[0]->run->mem_usage } sub io_events { $_[0]->{+IO_EVENTS} //= $_[0]->_fallback(io_events => 1, qw/task run/) } sub smoke { $_[0]->{+SMOKE} //= $_[0]->_fallback(smoke => 0, qw/task/) } sub retry_isolated { $_[0]->{+RETRY_ISOLATED} //= $_[0]->_fallback(retry_isolated => 0, qw/task run/) } sub use_stream { $_[0]->{+USE_STREAM} //= $_[0]->_fallback(use_stream => 1, qw/task run/) } sub use_timeout { $_[0]->{+USE_TIMEOUT} //= $_[0]->_fallback(use_timeout => 1, qw/task/) } sub retry { $_[0]->{+RETRY} //= $_[0]->_fallback(retry => undef, qw/task run/) } sub event_timeout { $_[0]->{+EVENT_TIMEOUT} //= $_[0]->_fallback(event_timeout => undef, qw/task runner/) } sub post_exit_timeout { $_[0]->{+POST_EXIT_TIMEOUT} //= $_[0]->_fallback(post_exit_timeout => undef, qw/task runner/) } sub min_slots { $_[0]->{+MIN_SLOTS} //= $_[0]->_fallback_non_bool(min_slots => 1, qw/task/) } sub max_slots { $_[0]->{+MAX_SLOTS} //= $_[0]->_fallback_non_bool(max_slots => 1, qw/task/) } sub args { @{$_[0]->{+ARGS} //= $_[0]->_merge_sources(test_args => qw/task run/)} } sub load { @{$_[0]->{+LOAD} //= [@{$_[0]->run->load // []}]} } sub cli_includes { my $self = shift; # '.' is handled via the PERL_USE_UNSAFE_INC env var set later $self->{+CLI_INCLUDES} //= [map { "-I$_" } grep { $_ ne '.' } $self->includes]; return @{$self->{+CLI_INCLUDES}}; } sub runner_includes { @{$_[0]->{+RUNNER_INCLUDES} //= [$_[0]->{+RUNNER}->all_libs]} } sub _merge_sources { my $self = shift; my ($name, @from) = @_; my @vals; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; next unless defined $val; next unless @$val; push @vals => @$val; } return \@vals; } sub _fallback_non_bool { my $self = shift; my ($name, $default, @from) = @_; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; return $val if defined $val; } return $default; } sub _fallback { my $self = shift; my ($name, $default, @from) = @_; my @vals; for my $from (@from) { my $source = $self->$from; my $val = blessed($source) ? $source->$name : $source->{$name}; push @vals => $val if defined $val; } return $default unless @vals; # If the default is a ref we will just return the first value we found, truthiness check is useless return shift @vals if ref $default || !defined($default) || $default !~ m/^(0|1)$/; # If the default is true, then we only return true if none of the vals are false return !grep { !$_ } @vals if $default; # If the default is false, then we return true if any of the valse are true return grep { $_ } @vals; } sub job_dir { my $self = shift; return $self->{+JOB_DIR} if $self->{+JOB_DIR}; my $job_dir = File::Spec->catdir($self->run_dir, $self->{+TASK}->{job_id} . '+' . $self->is_try); mkdir($job_dir) or die "$$ $0 Could not create job directory '$job_dir': $!"; chmod_tmp($job_dir); $self->{+JOB_DIR} = $job_dir; } sub tmp_dir { my $self = shift; return $self->{+TMP_DIR} if $self->{+TMP_DIR}; my $tmp_dir = File::Temp::tempdir("XXXXXX", DIR => $self->runner->tmp_dir); chmod_tmp($tmp_dir); $self->{+TMP_DIR} = clean_path($tmp_dir); } sub make_event_dir { $_[0]->event_dir } sub event_dir { my $self = shift; return $self->{+EVENT_DIR} if $self->{+EVENT_DIR}; my $events_dir = File::Spec->catdir($self->job_dir, 'events'); unless (-d $events_dir) { mkdir($events_dir) or die "$$ $0 Could not create events directory '$events_dir': $!"; } $self->{+EVENT_DIR} = $events_dir; } sub in_file { my $self = shift; return $self->{+IN_FILE} if $self->{+IN_FILE}; my $task = $self->{+TASK}; unless ($task->{input}) { my $from_run = $self->run->input_file; return $self->{+IN_FILE} = $from_run if $from_run; } my $stdin = File::Spec->catfile($self->job_dir, 'stdin'); my $content = $task->{input} // $self->run->input // ''; write_file($stdin, $content); return $self->{+IN_FILE} = $stdin; } sub use_fork { my $self = shift; return $self->{+USE_FORK} if defined $self->{+USE_FORK}; my $task = $self->{+TASK}; return $self->{+USE_FORK} = 0 unless CAN_REALLY_FORK; return $self->{+USE_FORK} = 0 if $task->{binary}; return $self->{+USE_FORK} = 0 if $task->{non_perl}; return $self->{+USE_FORK} = 0 if defined($task->{use_fork}) && !$task->{use_fork}; return $self->{+USE_FORK} = 0 if defined($task->{use_preload}) && !$task->{use_preload}; # -w switch is ok, otherwise it is a no-go return $self->{+USE_FORK} = 0 if grep { !m/\s*-w\s*/ } $self->switches; my $runner = $self->{+RUNNER}; return $self->{+USE_FORK} = 0 unless $runner->use_fork; return $self->{+USE_FORK} = 1; } sub includes { my $self = shift; return @{$self->{+INCLUDES}} if $self->{+INCLUDES}; $self->{+INCLUDES} = [ process_includes( list => [$self->runner_includes, @{$self->{+SETTINGS}->harness->orig_inc}], include_dot => $self->unsafe_inc, include_current => 1, clean => 1, $self->ch_dir ? (ch_dir => $self->ch_dir) : (), ) ]; return @{$self->{+INCLUDES}}; } sub cli_options { my $self = shift; my $event_dir = $self->event_dir; my $job_id = $self->job_id; return ( $self->use_stream ? ("-MTest2::Formatter::Stream=dir,$event_dir,job_id,$job_id") : (), $self->event_uuids ? ('-MTest2::Plugin::UUID') : (), $self->mem_usage ? ('-MTest2::Plugin::MemUsage') : (), $self->io_events ? ('-MTest2::Plugin::IOEvents') : (), (map { @{$_->[1]} ? "-M$_->[0]=" . join(',' => @{$_->[1]}) : "-M$_->[0]" } $self->load_import), (map { "-m$_" } $self->load), ); } sub switches { my $self = shift; return @{$self->{+SWITCHES}} if $self->{+SWITCHES}; my @switches; my %seen; for my $s (@{$self->{+TASK}->{switches} // []}) { $seen{$s}++; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } my %seen2; for my $s (@{$self->{+RUNNER}->switches // []}) { next if $seen{$s}; $seen2{$s}++; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } for my $s ($self->switches_from_env) { next if $seen{$s}; next if $seen2{$s}; $self->{+USE_W_SWITCH} = 1 if $s =~ m/\s*-w\s*/; push @switches => $s; } return @{$self->{+SWITCHES} = \@switches}; } sub prof_file { my $self = shift; my $file =$self->rel_file; $file =~ s{/}{-}g; $file =~ s{\.[^\.]+$}{.nytprof}g; return $file; } sub env_vars { my $self = shift; return $self->{+ENV_VARS} if $self->{+ENV_VARS}; my $from_run = $self->run->env_vars; my $from_task = $self->{+TASK}->{env_vars}; my @p5l = ($from_task->{PERL5LIB}, $from_run->{PERL5LIB}); push @p5l => $self->includes if $self->{+TASK}->{binary} || $self->{+TASK}->{non_perl}; push @p5l => $ENV{PERL5LIB} if $ENV{PERL5LIB}; my $p5l = join $Config{path_sep} => grep { defined $_ && $_ ne '.' } @p5l; my $verbose = $self->verbose; return $self->{+ENV_VARS} = { $from_run ? (%$from_run) : (), $from_task ? (%$from_task) : (), $self->use_stream ? (T2_FORMATTER => 'Stream', T2_STREAM_DIR => $self->event_dir, T2_STREAM_JOB_ID => $self->job_id) : (), $self->{+SETTINGS}->runner->nytprof ? (NYTPROF => "addpid=1:start=begin") : (), PERL5LIB => $p5l, PERL_USE_UNSAFE_INC => $self->unsafe_inc, TEST2_JOB_DIR => $self->job_dir, TEST2_RUN_DIR => $self->run_dir, TMPDIR => $self->tmp_dir, TEMPDIR => $self->tmp_dir, SYSTEM_TMPDIR => $self->{+SETTINGS}->harness->orig_tmp, SYSTEM_TMPDIR_PERMS => $self->{+SETTINGS}->harness->orig_tmp_perms, HARNESS_IS_VERBOSE => $verbose, T2_HARNESS_IS_VERBOSE => $verbose, HARNESS_ACTIVE => 1, TEST2_HARNESS_ACTIVE => 1, T2_HARNESS_JOB_FILE => $self->rel_file, T2_HARNESS_JOB_NAME => $self->{+TASK}->{job_name}, T2_HARNESS_JOB_IS_TRY => $self->{+IS_TRY} // 0, T2_HARNESS_JOB_DURATION => $self->{+TASK}->{duration} // '', }; } sub load_import { my $self = shift; return @{$self->{+LOAD_IMPORT}} if $self->{+LOAD_IMPORT}; my $from_run = $self->run->load_import; my @out; for my $mod (@{$from_run->{'@'} // []}) { push @out => [$mod, $from_run->{$mod} // []]; } return @{$self->{+LOAD_IMPORT} = \@out}; } sub use_w_switch { my $self = shift; return $self->{+USE_W_SWITCH} if defined $self->{+USE_W_SWITCH}; $self->switches; return $self->{+USE_W_SWITCH}; } sub set_exit { my $self = shift; my ($runner, $exit, $time, @args) = @_; $self->SUPER::set_exit(@_); my $file = File::Spec->catfile($self->job_dir, 'exit'); my $e = parse_exit($exit); write_file_atomic($file, join(" " => $exit, $e->{err}, $e->{sig}, $e->{dmp}, $time, @args)); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Job - Representation of a test job. =head1 DESCRIPTION This module takes all the data from a test file queue item, a run, and runner settings, and mashes them together to figure out what is actually needed to run a job. =head1 METHODS Note, this object subclasses L<Test2::Harness::IPC::Process>. =over 4 =item $arrayref = $job->args Get the arguments for the test either from the queue item, or from the run. =item $path = $job->bail_file Path to the events-file used in case of a bail-out =item $bool = $job->bailed_out True if the test job bailed out. =item $cat $job->category Process category, always 'job' unless overridden in a subclass. =item $path = $job->ch_dir If this job first requires a change in directory before running, this will return the path. =item @list = $job->cli_includes List of includes for a command line launch of this job. =item @list = $job->cli_options List of options for a command line launch of this job. =item $hashref = $job->env_vars Get environment variables to set when launching this job. =item $path = $job->out_file File to which all STDOUT for the job will be written. =item $path = $job->err_file File to which all STDERR for the job will be written. =item $path = $job->et_file File to which event timeout notifications will be written. =item $path = $job->pet_file File to which post exit timeout events will be written. =item $path = $job->event_dir Directory to which L<Test2::Formatter::Stream> events will be written. =item $time = $job->event_timeout Event timeout specification, if any, first from test queue item, then from runner. =item $time = $job->post_exit_timeout Post exit timeout specification, if any, first from test queue item, then from runner. =item $bool = $job->event_uuids Use L<Test2::Plugin::UUID> inside the test. =item $path = $job->file Test file the job will be running. =item $coderef = $job->fork_callback If the job is to be launched via fork, use this callback. =item $path = $job->in_file File containing STDIN to be provided to the test. =item @list = $job->includes Paths to add to @INC for the test. =item $bool = $job->io_events True if L<Test2::Plugin::IOEvents> should be used. =item $int = $job->is_try This starts at 0 and will be incremented for every retry of the job. =item $path = $job->job_dir Temporary directory housing all files related to this job when it runs. =item $uuid = $job->job_id UUID for this job. =item @list = $job->load Modules to load when starting this job. =item @list = $job->load_import Modules to load and import when starting this job. =item $bool = $job->mem_usage True if the L<Test2::Plugin::MemUsage> plugin should be used. =item $path = $job->run_file Usually the same as rel_file, but you can specify an alternative file to actually run. =item $path = $job->rel_file Relative path to the file. =item $int = $job->retry How many times the test should be retried if it fails. =item $bool = $job->retry_isolated True if the test should be retried in isolation if it fails. =item $run = $job->run The L<Test2::Harness::Runner::Run> instance. =item $path = $job->run_dir Path to the temporary directory housing all the data about the run. =item $runner = $job->runner The L<Test2::Harness::Runner> instance. =item @list = $job->runner_includes Search path includes provided directly by the runner. =item $settings = $job->settings The L<Test2::Harness::Settings> instance. =item $bool = $job->smoke True if the test is a priority smoke test. =item $hashref = $job->spawn_params Parameters for C<run_cmd()> in L<Test2::Harness::Util::IPC> when launching this job. If the task has a C<resource_skip> set (indicating permanently unavailable resources), the command will emit TAP to skip the test. When the C<--fail-on-resource-skip> runner option is enabled, the command will instead emit a TAP test failure. =item @list = $job->switches Command line switches for perl when running this test. =item $hashref = $job->task Task data from the queue. =item $path = $job->tmp_dir Temp dir created specifically for this job. =item $bool = $job->unsafe_inc True if '.' should be added to C<@INC>. =item $bool = $job->use_fork True if this job should be launched via fork. =item $bool = $job->use_stream True if this job should use L<Test2::Formatter::Stream>. =item $bool = $job->use_timeout True if this job should timeout due to lack of activity. =item $bool = $job->use_w_switch True if the C<-w> switch should be used for this test. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Run.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 3422�15267772575� 22526� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Run; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use File::Spec(); use Test2::Harness::Util::File::JSONL; use parent 'Test2::Harness::Run'; use Test2::Harness::Util::HashBase qw{ <workdir +run_dir +jobs_file +jobs }; sub init { my $self = shift; $self->SUPER::init(); croak "'workdir' is a required attribute" unless $self->{+WORKDIR}; } sub run_dir { $_[0]->{+RUN_DIR} //= $_[0]->SUPER::run_dir($_[0]->{+WORKDIR}) } sub jobs_file { $_[0]->{+JOBS_FILE} //= File::Spec->catfile($_[0]->run_dir, 'jobs.jsonl') } sub jobs { $_[0]->{+JOBS} //= Test2::Harness::Util::File::JSONL->new(name => $_[0]->jobs_file, use_write_lock => 1) } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Run - Runner specific subclass of a test run. =head1 DESCRIPTION Runner subclass of L<Test2::Harness::Run> for use inside the runner. =head1 METHODS In addition to the methods provided by L<Test2::Harness::Run>, these are provided. =over 4 =item $dir = $run->workdir Runner directory. =item $dir = $run->run_dir Directory specific to this run. =item $path = $run->jobs_file Path to the C<jobs.jsonl> file. =item $fh = $run->jobs Filehandle to C<jobs.jsonl>. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Queue.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 7113�15267772575� 22513� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::Queue; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Time::HiRes qw/time/; use Test2::Harness::Util qw/write_file_atomic/; use Test2::Harness::Util::File::JSONL(); use Test2::Harness::Util::HashBase qw{ -file -qh -ended }; sub init { my $self = shift; croak "'file' is a required attribute" unless $self->{+FILE}; } sub start { my $self = shift; write_file_atomic($self->{+FILE}, ""); } sub seek { my $self = shift; my ($pos) = @_; $self->{+QH} ||= Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}); $self->{+QH}->seek($pos); return $pos; } sub reset { my $self = shift; delete $self->{+QH}; } sub poll { my $self = shift; my $max = shift; return $self->{+ENDED} if $self->{+ENDED}; $self->{+QH} ||= Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}); my @out = $self->{+QH}->poll_with_index( $max ? (max => $max) : () ); $self->{+ENDED} = $out[-1] if @out && !defined($out[-1]->[-1]); return @out; } sub end { my $self = shift; $self->_enqueue(undef); } sub enqueue { my $self = shift; my ($task) = @_; croak "Invalid task" unless $task && ref($task) eq 'HASH' && values %$task; $task->{stamp} ||= time; $self->_enqueue($task); } sub _enqueue { my $self = shift; my ($task) = @_; my $fh = Test2::Harness::Util::File::JSONL->new(name => $self->{+FILE}, use_write_lock => 1); $fh->write($task); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::Queue - Representation of a queue. =head1 DESCRIPTION This module represents a queue, stored as a jsonl file. =head1 SYNOPSIS use Test2::Harness::Util::Queue; my $queue = Test2::Harness::Util::Queue->new(file => '/path/to/queue.jsonl'); $queue->start(); # Create the queue $queue->enqueue({foo => 'bar', baz => 'bat'}); $queue->enqueue({foo => 'bar2', baz => 'bat2'}); ... $queue->end(); Then in another process: use Test2::Harness::Util::Queue; my $queue = Test2::Harness::Util::Queue->new(file => '/path/to/queue.jsonl'); my @items; while (1) { @items = $queue->poll(); while (@items) { my $item = shift @items or last; ... process $item } # Queue ends with an 'undef' entry last if @items && !defined($items[0]); } =head1 METHODS =over 4 =item $path = $queue->file The filename used for the queue =back =head2 READING =over 4 =item $queue->reset() Restart reading the queue. =item @items = $queue->poll() Get more items from the queue. May need to call it multiple times, specially if another process is still writing to the queue. Returns an empty list if no items are available yet. Returns 'undef' to terminate the list. =item $bool = $queue->ended() Check if the queue has ended. =back =head1 WRITING =over 4 =item $queue->start() Open the queue file for writing. =item $queue->enqueue(\%HASHREF) Add an item to the queue. =item $queue->end() Terminate the queue. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������includes��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21234� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������.yath.rc��������������������������������������������������������������������������������������������100644��001750��001750�� 7�15267772575� 22662� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������[test] �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������scheduler_death.t�����������������������������������������������������������������������������������100644��001750��001750�� 4243�15267772575� 23101� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Test 1: Scheduler crashes (repeated non-zero exit) # SchedulerKillerResource dies in tick() on every iteration after the first # task is dispatched. The scheduler retries up to 5 times, then aborts. # The parent runner detects the non-zero exit. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+SchedulerKillerResource'], env => {SCHEDULER_DEATH_MODE => 'crash'}, exit => T(), test => sub { my $out = shift; like($out->{output}, qr/Scheduler error.*Intentional scheduler crash/, "Scheduler printed error on crash"); like($out->{output}, qr/Scheduler aborting after .* consecutive errors/, "Scheduler aborted after reaching error limit"); like($out->{output}, qr/Scheduler process.*exited unexpectedly/, "Runner detected scheduler crash"); }, ); # Test 2: Scheduler exits 0 prematurely (with pending work) # SchedulerKillerResource calls POSIX::_exit(0) after the first task is # dispatched, bypassing all Perl cleanup. The parent runner detects that # the scheduler exited cleanly but work remains. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+SchedulerKillerResource'], env => {SCHEDULER_DEATH_MODE => 'exit'}, exit => T(), test => sub { my $out = shift; like($out->{output}, qr/Scheduler process.*exited prematurely.*pending work/, "Runner detected premature scheduler exit"); }, ); # Test 3: Scheduler recovers from transient errors # SchedulerKillerResource throws 2 times then stops. The scheduler catches # the errors, retries, and successfully completes the test run. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+SchedulerKillerResource'], env => {SCHEDULER_DEATH_MODE => 'recover'}, exit => 0, test => sub { my $out = shift; like($out->{output}, qr/Scheduler error.*Transient scheduler error/, "Scheduler logged transient error"); unlike($out->{output}, qr/Scheduler aborting/, "Scheduler did not abort"); }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass2.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 22730� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/speedtag��������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������stall_report����������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22140� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 54�15267772575� 23034� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stall_report����������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 54�15267772575� 23035� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stall_report����������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 54�15267772575� 23036� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stall_report����������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Settings.t������������������������������������������������������������������������������������������100644��001750��001750�� 3660�15267772575� 22620� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Settings'; use File::Temp qw/tempfile/; use Test2::Harness::Util::JSON qw/encode_json/; my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); ok(!$one->check_prefix('foo'), "foo is not defined"); like(dies { $one->foo }, qr/The 'foo' prefix is not defined/, "Cannot call foo if it is not defined"); like(dies { $one->prefix('foo') }, qr/The 'foo' prefix is not defined/, "Cannot call prefix(foo) if it is not defined"); $one->define_prefix('foo'); isa_ok($one->foo, ['Test2::Harness::Settings::Prefix'], "Defined the prefix"); ok($one->check_prefix('foo'), "foo is now defined"); ok($one->foo, "Can call foo if it is defined"); ok($one->prefix('foo'), "Can call prefix(foo) if it is defined"); is($one->TO_JSON, {foo => exact_ref($one->foo)}, "TO_JSON"); like(dies { $CLASS->foo }, qr/Method foo\(\) must be called on a blessed instance/, "Need a blessed instance"); like(dies { $one->foo(1) }, qr/Too many arguments for foo\(\)/, "No args"); { $INC{'XXX.pm'} = __FILE__; package XXX; sub new { shift; bless {@_}, 'XXX' }; } $one->foo->vivify_field('xxx'); $one->foo->field(xxx => 'yyy'); my $thing = $one->build('foo', 'XXX', a => 'b'); isa_ok($thing, ['XXX'], "Got a blessed instance of XXX"); is( $thing, { a => 'b', xxx => 'yyy', }, "Instance is composed as expected" ); my ($fh, $name) = tempfile(UNLINK => 1); print $fh encode_json($one); close($fh); my $two = $CLASS->new($name); isa_ok($two, [$CLASS], "Correct class"); is($two, $one, "Serialized and deserialized round trip"); ref_is_not($two, $one, "2 different refs"); like( dies { $CLASS->new(foo => []) }, qr/All prefixes must be defined as hashes/, "Prefixes must be hashes" ); like( dies { $CLASS->new(foo => bless({}, 'XXX')) }, qr/All prefixes must contain instances of Test2::Harness::Settings::Prefix/, "Blessed Prefixes must be prefixes" ); done_testing; ��������������������������������������������������������������������������������TestFile.t������������������������������������������������������������������������������������������100644��001750��001750�� 61617�15267772575� 22565� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::TestFile'; # HARNESS-DURATION-SHORT use ok $CLASS; use Test2::Tools::GenTemp qw/gen_temp/; my $tmp = gen_temp( long => "#!/usr/bin/perl\n\nuse strict;\n use warnings\n\n# HARNESS-CAT-LONG\n# HARNESS-NO-TIMEOUT\n# HARNESS-USE-ISOLATION\nfoo\n# HARNESS-NO-SEE\n", med1 => "# HARNESS-NO-PRELOAD\n", med2 => "#HARNESS-NO-FORK\n", all => "#HARNESS-NO-TIMEOUT\n# HARNESS-NO-STREAM\n# HARNESS-NO-FORK\n# HARNESS-NO-PRELOAD\n# HARNESS-USE-ISOLATION\n", notime => "#HARNESS-NO-TIMEOUT\n", warn => "#!/usr/bin/perl -w\n", taint => "#!/usr/bin/env perl -t -w\n", foo => "#HARNESS-CATEGORY-FOO\n#HARNESS-STAGE-FoO", meta => "#HARNESS-META-mykey-myval\n# HARNESS-META-otherkey-otherval\n# HARNESS-META mykey my-val2\n# HARNESS-META slack #my-val # comment after harness statement\n", package => "package Foo::Bar::Baz;\n# HARNESS-NO-PRELOAD\n", timeout => "# HARNESS-TIMEOUT-EVENT 90\n# HARNESS-TIMEOUT-POSTEXIT 85\n", timeout2 => "# HARNESS-TIMEOUT-EVENT-90\n# HARNESS-TIMEOUT-POST-EXIT 85\n", badtimeout => "# HARNESS-TIMEOUT-EVENTX 90\n# HARNESS-TIMEOUT-POSTEXITX 85\n", conflicts1 => "# HARNESS-CONFLICTS PASSWD\n", conflicts2 => "# HARNESS-CONFLICTS PASSWD DAEMON\n", conflicts3 => "# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS DAEMON # Nothing to see here\n", conflicts4 => "# HARNESS-CONFLICTS PASSWD DAEMON\n# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS PASSWD\n# HARNESS-CONFLICTS PASSWD DAEMON\n", shares1 => "# HARNESS-SHARES PASSWD\n", shares2 => "# HARNESS-SHARES-PASSWD\n", shares3 => "# HARNESS-SHARES PASSWD DAEMON\n", shares4 => "# HARNESS-SHARES PASSWD\n# HARNESS-SHARES-DAEMON # Nothing to see here\n", shares5 => "# HARNESS-SHARES PASSWD DAEMON\n# HARNESS-SHARES PASSWD\n# HARNESS-SHARES-PASSWD\n", both => "# HARNESS-CONFLICTS DAEMON\n# HARNESS-SHARES PASSWD DAEMON\n", extra_comments => "#!/usr/bin/perl\n\nuse strict;\n# comment here\n use warnings\n\n# copyright Dewey Cheatem and Howe\n# HARNESS-CAT-LONG\n# HARNESS-NO-TIMEOUT\n# HARNESS-USE-ISOLATION\n", smoke1 => "#HARNESS-SMOKE\n", smoke2 => "#HARNESS-YES-SMOKE\n", retry => "#HARNESS-RETRY\n", # mean retry once => --retry similar to --retry=1 retry5 => "#HARNESS-RETRY 5\n", retry_iso => "#HARNESS-RETRY-ISO\n", retry_iso3 => "#HARNESS-RETRY-ISO 3\n", no_retry => "#HARNESS-NO-RETRY\n", not_perl => "#!/usr/bin/bash\n", not_env_perl => "#!/usr/bin/env bash\n", binary => "\0\a\cX\e\n\cR", ); subtest timeouts => sub { my $one = $CLASS->new(file => File::Spec->catfile($tmp, 'timeout')); is($one->event_timeout, 90, "set event timeout"); is($one->post_exit_timeout, 85, "set event timeout"); my $task = $one->queue_item(42); is($task->{event_timeout}, 90, "event timeout made it to task"); is($task->{post_exit_timeout}, 85, "post-exit timeout made it to task"); my $two = $CLASS->new(file => File::Spec->catfile($tmp, 'timeout2')); is($two->event_timeout, 90, "set event timeout"); is($two->post_exit_timeout, 85, "set event timeout"); my $bad = $CLASS->new(file => File::Spec->catfile($tmp, 'badtimeout')); is( warnings { $bad->headers }, [ "'EVENTX' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at " . $bad->file . " line 1.\n", "'POSTEXITX' is not a valid timeout type, use 'EVENT' or 'POSTEXIT' at " . $bad->file . " line 2.\n", ], "Got warnings" ); }; subtest invalid => sub { like( dies { $CLASS->new(file => File::Spec->catfile($tmp, 'invalid')) }, qr/^Invalid test file/, "Need a valid test file" ); }; subtest meta => sub { my $foo = $CLASS->new(file => File::Spec->catfile($tmp, 'meta')); is([$foo->meta], [], "No key returns empty list"); is([$foo->meta('foo')], [], "Empty key returns empty list"); is([$foo->meta('mykey')], [qw/myval my-val2/], "Got both values for the 'mykey' key"); is([$foo->meta('otherkey')], ['otherval'], "Got other key"); is([$foo->meta('slack')], ['#my-val'], "Got hyphenated key"); }; subtest foo => sub { my $foo = $CLASS->new(file => File::Spec->catfile($tmp, 'foo')); is($foo->check_category, 'foo', "Category is foo"); is($foo->check_stage, 'FoO', "Stage is FoO, case-sensitive"); }; subtest package => sub { my $one = $CLASS->new(file => File::Spec->catfile($tmp, 'package')); is($one->queue_item(42)->{use_preload}, 0, "No preload"); }; subtest taint => sub { my $taint = $CLASS->new(file => File::Spec->catfile($tmp, 'taint'), queue_args => [via => ['xxx']]); is($taint->switches, ['-t', '-w'], "No SHBANG switches"); is($taint->shbang, {switches => ['-t', '-w'], line => "#!/usr/bin/env perl -t -w"}, "Parsed shbang"); is( $taint->queue_item(42), { category => 'general', duration => 'medium', stage => undef, file => $taint->file, rel_file => $taint->relative, job_name => 42, job_id => T(), stamp => T(), switches => ['-t', '-w'], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], via => ['xxx'], rank => T(), run_id => FDNE(), }, "Got queue item data", ); }; subtest warn => sub { my $warn = $CLASS->new(file => File::Spec->catfile($tmp, 'warn')); is($warn->switches, ['-w'], "got SHBANG switches"); is($warn->shbang, {switches => ['-w'], line => "#!/usr/bin/perl -w"}, "Parsed shbang"); is( $warn->queue_item(42), { category => 'general', duration => 'medium', stage => undef, file => $warn->file, rel_file => $warn->relative, job_name => 42, job_id => T(), stamp => T(), rank => T(), switches => ['-w'], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], run_id => FDNE(), }, "Got queue item data", ); }; subtest notime => sub { my $notime = $CLASS->new(file => File::Spec->catfile($tmp, 'notime')); is($notime->check_feature('timeout'), 0, "Timeouts turned off"); is($notime->check_feature('timeout', 1), 0, "Timeouts turned off with default 1"); is($notime->check_category, 'general', "Category is general"); is($notime->check_duration, 'long', "Duration is long"); is($notime->switches, [], "No SHBANG switches"); is($notime->shbang, {}, "No shbang"); is( $notime->queue_item(42), { category => 'general', duration => 'long', stage => undef, file => $notime->file, rel_file => $notime->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], run_id => FDNE(), }, "Got queue item data", ); }; subtest all => sub { my $all = $CLASS->new(file => File::Spec->catfile($tmp, 'all')); is($all->check_feature('timeout'), 0, "Timeouts turned off"); is($all->check_feature('timeout', 1), 0, "Timeouts turned off with default 1"); is($all->check_feature('fork'), 0, "Forking is off"); is($all->check_feature('fork', 1), 0, "Checking fork with different default"); is($all->check_feature('preload'), 0, "Preload is off"); is($all->check_feature('preload', 1), 0, "Checking preload with different default"); is($all->check_feature('isolation'), 1, "No isolation"); is($all->check_feature('isolation', 0), 1, "Use isolation with a default of false"); is($all->check_feature('stream'), 0, "Use stream"); is($all->check_feature('stream', 1), 0, "no stream with a default of true"); is($all->check_category, 'isolation', "Category is isolation"); is($all->switches, [], "No SHBANG switches"); is($all->shbang, {}, "No shbang"); is( $all->queue_item(42), { category => 'isolation', duration => 'long', stage => undef, file => $all->file, rel_file => $all->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 0, use_preload => 0, use_stream => 0, io_events => 1, use_timeout => 0, smoke => 0, conflicts => [], shares => [], binary => 0, non_perl => 0, run_id => FDNE(), }, "Got queue item data", ); }; subtest med2 => sub { my $med2 = $CLASS->new(file => File::Spec->catfile($tmp, 'med2')); is($med2->check_feature('timeout'), 1, "Timeouts turned on"); is($med2->check_feature('timeout', 0), 0, "Timeouts turned off with default 0"); is($med2->check_feature('fork'), 0, "Forking is off"); is($med2->check_feature('fork', 1), 0, "Checking fork with different default"); is($med2->check_feature('preload'), 1, "Preload is on"); is($med2->check_feature('preload', 0), 0, "Checking preload with different default"); is($med2->check_feature('isolation'), 0, "No isolation"); is($med2->check_feature('isolation', 1), 1, "Use isolation with a default of true"); is($med2->check_feature('stream'), 1, "Use stream"); is($med2->check_feature('stream', 0), 0, "no stream with a default of false"); is($med2->check_category, 'general', "Category is general"); is($med2->check_duration, 'medium', "duration is medium"); is($med2->switches, [], "No SHBANG switches"); is($med2->shbang, {}, "No shbang"); is( $med2->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => $med2->file, rel_file => $med2->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 0, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], }, "Got queue item data", ); }; subtest med1 => sub { my $med1 = $CLASS->new(file => File::Spec->catfile($tmp, 'med1')); is($med1->check_feature('timeout'), 1, "Timeouts turned on"); is($med1->check_feature('timeout', 0), 0, "Timeouts turned off with default 0"); is($med1->check_feature('fork'), 1, "Forking is ok"); is($med1->check_feature('fork', 0), 0, "Checking fork with different default"); is($med1->check_feature('preload'), 0, "Preload is off"); is($med1->check_feature('preload', 1), 0, "Checking preload with different default"); is($med1->check_feature('isolation'), 0, "No isolation"); is($med1->check_feature('isolation', 1), 1, "Use isolation with a default of true"); is($med1->check_feature('stream'), 1, "Use stream"); is($med1->check_feature('stream', 0), 0, "no stream with a default of false"); is($med1->check_category, 'general', "Category is general"); is($med1->check_duration, 'medium', "duration is medium"); is($med1->switches, [], "No SHBANG switches"); is($med1->shbang, {}, "No shbang"); is( $med1->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => $med1->file, rel_file => $med1->relative, job_name => 42, stamp => T(), rank => T(), job_id => T(), switches => [], use_fork => 1, use_preload => 0, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], }, "Got queue item data", ); }; subtest long => sub { my $long = $CLASS->new(file => File::Spec->catfile($tmp, 'long')); is($long->check_feature('timeout'), 0, "Timeouts turned off"); is($long->check_feature('timeout', 1), 0, "Timeouts turned off even with default 1"); is($long->check_feature('fork'), 1, "Forking is ok"); is($long->check_feature('fork', 0), 0, "Checking fork with different default"); is($long->check_feature('preload'), 1, "Preload is ok"); is($long->check_feature('preload', 0), 0, "Checking preload with different default"); is($long->check_feature('isolation'), 1, "Use isolation"); is($long->check_feature('isolation', 0), 1, "Use isolation even with a default of false"); is($long->check_feature('stream'), 1, "Use stream"); is($long->check_feature('stream', 0), 0, "no stream with a default of false"); is($long->check_category, 'isolation', "Category is isolation"); is($long->check_duration, 'long', "duration is long"); ok(!exists $long->headers->{SEE}, "Did not see directive after code line"); is($long->switches, [], "No SHBANG switches"); is($long->shbang, {switches => [], line => "#!/usr/bin/perl"}, "got shbang"); is( $long->queue_item(42), { run_id => FDNE(), category => 'isolation', duration => 'long', stage => undef, file => $long->file, rel_file => $long->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], }, "Got queue item data", ); }; subtest extra_comments => sub { my $long = $CLASS->new(file => File::Spec->catfile($tmp, 'extra_comments')); is($long->check_feature('timeout'), 0, "Timeouts turned off"); is($long->check_feature('timeout', 1), 0, "Timeouts turned off even with default 1"); is($long->check_feature('fork'), 1, "Forking is ok"); is($long->check_feature('fork', 0), 0, "Checking fork with different default"); is($long->check_feature('preload'), 1, "Preload is ok"); is($long->check_feature('preload', 0), 0, "Checking preload with different default"); is($long->check_feature('isolation'), 1, "Use isolation"); is($long->check_feature('isolation', 0), 1, "Use isolation even with a default of false"); is($long->check_feature('stream'), 1, "Use stream"); is($long->check_feature('stream', 0), 0, "no stream with a default of false"); is($long->check_category, 'isolation', "Category is isolation"); is($long->check_duration, 'long', "Duration is long"); is($long->switches, [], "No SHBANG switches"); is($long->shbang, {switches => [], line => "#!/usr/bin/perl"}, "got shbang"); is( $long->queue_item(42), { run_id => FDNE(), category => 'isolation', duration => 'long', stage => undef, file => $long->file, rel_file => $long->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 0, binary => 0, non_perl => 0, smoke => 0, conflicts => [], shares => [], }, "Got queue item data", ); }; subtest conflicts => sub { my $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts1')); is($parsed_file->conflicts_list, ['passwd'], "1 conflict line is reflected as an array"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts2')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "1 conflict line with 2 conflict categories"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts3')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "2 conflict lines with some comments on one of them"); $parsed_file = $CLASS->new(file => File::Spec->catfile($tmp, 'conflicts4')); is([sort @{$parsed_file->conflicts_list}], ['daemon', 'passwd'], "Duplicate conflict lines only lead to 2 conflict items."); }; sub shares_in { my ($name) = @_; my $file = $CLASS->new(file => File::Spec->catfile($tmp, $name)); return [sort @{$file->shares_list}]; } subtest shares => sub { is(shares_in('shares1'), ['passwd'], "1 share on 1 line is reflected as an array"); is(shares_in('shares2'), ['passwd'], "dashes and spaces delimit the same way"); is(shares_in('shares3'), ['daemon', 'passwd'], "1 share line with 2 share categories"); is(shares_in('shares4'), ['daemon', 'passwd'], "2 share lines with a comment on one of them"); is(shares_in('shares5'), ['daemon', 'passwd'], "Duplicate share lines only lead to 2 share items"); }; subtest shares_and_conflicts => sub { my $file = $CLASS->new(file => File::Spec->catfile($tmp, 'both')); is( warnings { $file->headers }, ["'daemon' is listed as both a conflict and a share in " . $file->file . ", treating it as a conflict.\n"], "Warned about the name claimed both exclusively and shared", ); is([sort @{$file->conflicts_list}], ['daemon'], "Exclusive claim was kept"); is([sort @{$file->shares_list}], ['passwd'], "Shared claim on the same name was dropped"); }; subtest binary => sub { my $path = File::Spec->catfile($tmp, 'binary'); ok(-B $path, "File is binary"); like( dies { my $binary = $CLASS->new(file => $path); $binary->shbang }, qr{Cannot run binary test file '[^']*\Q$path\E': file is not executable\.}, "File must be executable", ); my $control = mock $CLASS => ( override => [ is_executable => sub { 1 }, ], ); my $binary = $CLASS->new(file => $path); is($binary->switches, [], "No SHBANG switches"); is($binary->shbang, {}, "No shbang"); is( $binary->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $binary->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], shares => [], binary => 1, non_perl => 1, smoke => 0, }, "Got queue item data", ); }; subtest not_perl => sub { my $path = File::Spec->catfile($tmp, 'not_perl'); my $not_perl = $CLASS->new(file => File::Spec->catfile($tmp, 'not_perl')); is($not_perl->switches, [], "No SHBANG switches"); is($not_perl->shbang, {line => "#!/usr/bin/bash", non_perl => 1}, "Non-perl shbang"); is( $not_perl->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $not_perl->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], shares => [], binary => 0, non_perl => 1, smoke => 0, }, "Got queue item data", ); }; subtest not_env_perl => sub { my $path = File::Spec->catfile($tmp, 'not_env_perl'); my $not_env_perl = $CLASS->new(file => File::Spec->catfile($tmp, 'not_env_perl')); is($not_env_perl->switches, [], "No SHBANG switches"); is($not_env_perl->shbang, {line => "#!/usr/bin/env bash", non_perl => 1}, "Non-perl shbang"); is( $not_env_perl->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $not_env_perl->relative, job_name => 42, job_id => T(), rank => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, conflicts => [], shares => [], smoke => 0, binary => 0, non_perl => 1, }, "Got queue item data", ); }; subtest smoke => sub { my $path = File::Spec->catfile($tmp, 'smoke1'); my $smoke1 = $CLASS->new(file => $path); is($smoke1->check_feature(smoke => 0), 1, "Turned smoke on"); is( $smoke1->queue_item(42), { run_id => FDNE(), category => 'general', duration => 'medium', stage => undef, file => match qr{\Q$path\E$}, rel_file => $smoke1->relative, job_name => 42, rank => T(), job_id => T(), stamp => T(), switches => [], use_fork => 1, use_preload => 1, use_stream => 1, io_events => 1, use_timeout => 1, binary => 0, non_perl => 0, smoke => 1, conflicts => [], shares => [], }, "Got queue item data", ); my $smoke2 = $CLASS->new(file => File::Spec->catfile($tmp, 'smoke2')); is($smoke2->check_feature(smoke => 0), 1, "Turned smoke on"); }; subtest smoke => sub { my $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry')); my $task = $retry->queue_item(42); is($task->{retry}, 1, "Enabled retry"); ok(!exists($task->{retry_isolated}), "not isolated"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry5')); $task = $retry->queue_item(42); is($task->{retry}, 5, "Enabled retry, value of 5 results in '6' because of initial try"); ok(!exists($task->{retry_isolated}), "not isolated"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry_iso')); $task = $retry->queue_item(42); is($task->{retry}, 1, "Enabled retry"); is($task->{retry_isolated}, T(), "isolated retry"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'retry_iso3')); $task = $retry->queue_item(42); is($task->{retry}, 3, "Enabled retry, 1 initital + 3 retries"); is($task->{retry_isolated}, T(), "isolated retry"); $retry = $CLASS->new(file => File::Spec->catfile($tmp, 'no_retry')); $task = $retry->queue_item(42); is($task->{retry}, 0, "Retry set to 0"); ok(!exists($task->{retry_isolated}), "not isolated"); }; done_testing; �����������������������������������������������������������������������������������������������������������������projects.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 100442�15267772575� 23001� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::projects; use strict; use warnings; our $VERSION = '1.000182'; use parent 'App::Yath::Command::test'; use Test2::Harness::Util::HashBase; sub summary { "Run tests for multiple projects" } sub cli_args { "[--] projects_dir [::] [arguments to test scripts]" } sub description { return <<" EOT"; This command will run all the tests for each project within a parent directory. EOT } sub finder_args {(multi_project => 1)} 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::projects - Run tests for multiple projects =head1 DESCRIPTION This command will run all the tests for each project within a parent directory. =head1 USAGE $ yath [YATH OPTIONS] projects [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Finder Options =over 4 =item --finder MyFinder =item --finder +Test2::Harness::Finder::MyFinder =item --no-finder Specify what Finder subclass to use when searching for files/processing the file list. Use the "+" prefix to specify a fully qualified namespace, otherwise Test2::Harness::Finder::XXX namespace is assumed. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Display Options =over 4 =item --color =item --no-color Turn color on, default is true if STDOUT is a TTY. =item --hide-runner-output =item --no-hide-runner-output Hide output from the runner, showing only test output. (See Also truncate_runner_output) =item --no-final-table =item --no-no-final-table When printing final results, don't use table-style display =item --no-wrap =item --no-no-wrap Do not do fancy text-wrapping, let the terminal handle it =item --progress =item --no-progress Toggle progress indicators. On by default if STDOUT is a TTY. You can use --no-progress to disable the 'events seen' counter and buffered event pre-display =item --quiet =item -q =item --no-quiet Be very quiet. Can be specified multiple times =item --renderers +My::Renderer =item --renderers Renderer=arg1,arg2,... =item --renderer +My::Renderer =item --renderer Renderer=arg1,arg2,... =item --no-renderers Specify renderers, (Default: "Formatter=Test2"). Use "+" to give a fully qualified module name. Without "+" "Test2::Harness::Renderer::" will be prepended to your argument. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --show-times =item -T =item --no-show-times Show the timing data for each job =item --term-width 80 =item --term-width 200 =item --term-size 80 =item --term-size 200 =item --no-term-width Alternative to setting $TABLE_TERM_SIZE. Setting this will override the terminal width detection to the number of characters specified. =item --truncate-runner-output =item --no-truncate-runner-output Only show runner output that was generated after the current command. This is only useful with a persistent runner. =item --verbose =item -v =item --no-verbose Be more verbose Can be specified multiple times =back =head3 Finder Options =over 4 =item --default-at-search ARG =item --default-at-search=ARG =item --no-default-at-search Specify the default file/dir search when 'AUTHOR_TESTING' is set. Defaults to './xt'. The default AT search is only used if no files were specified at the command line Can be specified multiple times =item --default-search ARG =item --default-search=ARG =item --no-default-search Specify the default file/dir search. defaults to './t', './t2', and 'test.pl'. The default search is only used if no files were specified at the command line Can be specified multiple times =item --durations file.json =item --durations http://example.com/durations.json =item --no-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --durations-threshold ARG =item --durations-threshold=ARG =item --Dt ARG =item --Dt=ARG =item --no-durations-threshold Only fetch duration data if running at least this number of tests. Default (-j value + 1) =item --exclude-file t/nope.t =item --no-exclude-file Exclude a file from testing Can be specified multiple times =item --exclude-list file.txt =item --exclude-list http://example.com/exclusions.txt =item --no-exclude-list Point at a file or url which has a new line separated list of test file names to exclude from testing. Starting a line with a '#' will comment it out (for compatibility with Test2::Aggregate list files). Can be specified multiple times =item --exclude-pattern t/nope.t =item --no-exclude-pattern Exclude a pattern from testing, matched using m/$PATTERN/ Can be specified multiple times =item --extension ARG =item --extension=ARG =item --ext ARG =item --ext=ARG =item --no-extension Specify valid test filename extensions, default: t and t2 Can be specified multiple times =item --maybe-durations file.json =item --maybe-durations http://example.com/durations.json =item --no-maybe-durations Point at a json file or url which has a hash of relative test filenames as keys, and 'SHORT', 'MEDIUM', or 'LONG' as values. This will override durations listed in the file headers. An exception will be thrown if the durations file or url does not work. =item --no-long =item --no-no-long Do not run tests that have their duration flag set to 'LONG' =item --only-long =item --no-only-long Only run tests that have their duration flag set to 'LONG' =item --rerun =item --rerun=path/to/log.jsonl =item --rerun=plugin_specific_string =item --no-rerun Re-Run tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-all =item --rerun-all=path/to/log.jsonl =item --rerun-all=plugin_specific_string =item --no-rerun-all Re-Run all tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-failed =item --rerun-failed=path/to/log.jsonl =item --rerun-failed=plugin_specific_string =item --no-rerun-failed Re-Run failed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-missed =item --rerun-missed=path/to/log.jsonl =item --rerun-missed=plugin_specific_string =item --no-rerun-missed Run missed tests from a previously aborted/stopped run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-modes failed,missed,... =item --rerun-modes all =item --rerun-modes failed =item --rerun-modes missed =item --rerun-modes passed =item --rerun-modes retried =item --rerun-mode failed,missed,... =item --rerun-mode all =item --rerun-mode failed =item --rerun-mode missed =item --rerun-mode passed =item --rerun-mode retried =item --no-rerun-modes Pick which test categories to run Can be specified multiple times =item --rerun-passed =item --rerun-passed=path/to/log.jsonl =item --rerun-passed=plugin_specific_string =item --no-rerun-passed Re-Run passed tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --rerun-plugin Foo =item --rerun-plugin +App::Yath::Plugin::Foo =item --no-rerun-plugin What plugin(s) should be used for rerun (will fallback to other plugins if the listed ones decline the value, this is just used to set an order of priority) Can be specified multiple times =item --rerun-retried =item --rerun-retried=path/to/log.jsonl =item --rerun-retried=plugin_specific_string =item --no-rerun-retried Re-Run retried tests from a previous run from a log file (or last log file). Plugins can intercept this, such as YathUIDB which will grab a run UUID and derive tests to re-run from that. =item --search ARG =item --search=ARG =item --no-search List of tests and test directories to use instead of the default search paths. Typically these can simply be listed as command line arguments without the --search prefix. Can be specified multiple times =back =head3 Formatter Options =over 4 =item --formatter ARG =item --formatter=ARG =item --no-formatter NO DESCRIPTION - FIX ME =item --qvf =item --no-qvf [Q]uiet, but [V]erbose on [F]ailure. Hide all output from tests when they pass, except to say they passed. If a test fails then ALL output from the test is verbosely output. =item --show-job-end =item --no-show-job-end Show output when a job ends. (Default: on) =item --show-job-info =item --no-show-job-info Show the job configuration when a job starts. (Default: off, unless -vv) =item --show-job-launch =item --no-show-job-launch Show output for the start of a job. (Default: off unless -v) =item --show-run-info =item --no-show-run-info Show the run configuration when a run starts. (Default: off, unless -vv) =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =item --summary =item --summary=/path/to/summary.json =item --no-summary Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted. =back =head3 Logging Options =over 4 =item --bzip2 =item --bz2 =item --bzip2_log =item -B =item --no-bzip2 Use bzip2 compression when writing the log. This option implies -L. The .bz2 prefix is added to log file name for you =item --gzip =item --gz =item --gzip_log =item -G =item --no-gzip Use gzip compression when writing the log. This option implies -L. The .gz prefix is added to log file name for you =item --log =item -L =item --no-log Turn on logging =item --log-dir ARG =item --log-dir=ARG =item --no-log-dir Specify a log directory. Will fall back to the system temp dir. =item --log-file ARG =item --log-file=ARG =item -F ARG =item -F=ARG =item --no-log-file Specify the name of the log file. This option implies -L. =item --log-file-format ARG =item --log-file-format=ARG =item --lff ARG =item --lff=ARG =item --no-log-file-format Specify the format for automatically-generated log files. Overridden by --log-file, if given. This option implies -L (Default: \$YATH_LOG_FILE_FORMAT, if that is set, or else "%!P%Y-%m-%d~%H:%M:%S~%!U~%!p.jsonl"). This is a string in which percent-escape sequences will be replaced as per POSIX::strftime. The following special escape sequences are also replaced: (%!P : Project name followed by a ~, if a project is defined, otherwise empty string) (%!U : the unique test run ID) (%!p : the process ID) (%!S : the number of seconds since local midnight UTC) Can also be set with the following environment variables: C<YATH_LOG_FILE_FORMAT>, C<TEST2_HARNESS_LOG_FORMAT> =back =head3 Notification Options =over 4 =item --notify-email foo@example.com =item --no-notify-email Email the test results to the specified email address(es) Can be specified multiple times =item --notify-email-fail foo@example.com =item --no-notify-email-fail Email failing results to the specified email address(es) Can be specified multiple times =item --notify-email-from foo@example.com =item --no-notify-email-from If any email is sent, this is who it will be from =item --notify-email-owner =item --no-notify-email-owner Email the owner of broken tests files upon failure. Add `# HARNESS-META-OWNER foo@example.com` to the top of a test file to give it an owner =item --notify-no-batch-email =item --no-notify-no-batch-email Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-no-batch-slack =item --no-notify-no-batch-slack Usually owner failures are sent as a single batch at the end of testing. Toggle this to send failures as they happen. =item --notify-slack '#foo' =item --notify-slack '@bar' =item --no-notify-slack Send results to a slack channel and/or user Can be specified multiple times =item --notify-slack-fail '#foo' =item --notify-slack-fail '@bar' =item --no-notify-slack-fail Send failing results to a slack channel and/or user Can be specified multiple times =item --notify-slack-owner =item --no-notify-slack-owner Send slack notifications to the slack channels/users listed in test meta-data when tests fail. =item --notify-slack-url https://hooks.slack.com/... =item --no-notify-slack-url Specify an API endpoint for slack webhook integrations =item --notify-text ARG =item --notify-text=ARG =item --message ARG =item --message=ARG =item --msg ARG =item --msg=ARG =item --no-notify-text Add a custom text snippet to email/slack notifications =item --notify-text-module ARG =item --notify-text-module=ARG =item --message_module ARG =item --message_module=ARG =item --no-notify-text-module Use the specified module to generate messages for emails and/or slack. =back =head3 Run Options =over 4 =item --author-testing =item -A =item --no-author-testing This will set the AUTHOR_TESTING environment to true =item --dbi-profiling =item --no-dbi-profiling Use Test2::Plugin::DBIProfile to collect database profiling data =item --env-var VAR=VAL =item -EVAR=VAL =item -E VAR=VAL =item --no-env-var Set environment variables to set when each test is run. Can be specified multiple times =item --event-uuids =item --uuids =item --no-event-uuids Use Test2::Plugin::UUID inside tests (default: on) =item --fields name:details =item --fields JSON_STRING =item -f name:details =item -f JSON_STRING =item --no-fields Add custom data to the harness run Can be specified multiple times =item --input ARG =item --input=ARG =item --no-input Input string to be used as standard input for ALL tests. See also: --input-file =item --input-file ARG =item --input-file=ARG =item --no-input-file Use the specified file as standard input to ALL tests =item --io-events =item --no-io-events Use Test2::Plugin::IOEvents inside tests to turn all prints into test2 events (default: off) =item --link 'https://travis.work/builds/42' =item --link 'https://jenkins.work/job/42' =item --link 'https://buildbot.work/builders/foo/builds/42' =item --no-link Provide one or more links people can follow to see more about this run. Can be specified multiple times =item --load ARG =item --load=ARG =item --load-module ARG =item --load-module=ARG =item -m ARG =item -m=ARG =item --no-load Load a module in each test (after fork). The "import" method is not called. Can be specified multiple times =item --load-import Module =item --load-import Module=import_arg1,arg2,... =item --loadim Module =item --loadim Module=import_arg1,arg2,... =item -M Module =item -M Module=import_arg1,arg2,... =item --no-load-import Load a module in each test (after fork). Import is called. Can be specified multiple times. If the same key is listed multiple times the value lists will be appended together. =item --mem-usage =item --no-mem-usage Use Test2::Plugin::MemUsage inside tests (default: on) =item --retry ARG =item --retry=ARG =item -r ARG =item -r=ARG =item --no-retry Run any jobs that failed a second time. NOTE: --retry=1 means failing tests will be attempted twice! =item --retry-isolated =item --retry-iso =item --no-retry-isolated If true then any job retries will be done in isolation (as though -j1 was set) =item --run-id =item --id =item --no-run-id Set a specific run-id. (Default: a UUID) =item --test-args ARG =item --test-args=ARG =item --no-test-args Arguments to pass in as @ARGV for all tests that are run. These can be provided easier using the '::' argument separator. Can be specified multiple times =item --stream =item --no-stream Use the stream formatter (default is on) =item --tap =item --TAP =item ----no-stream =item --no-tap The TAP format is lossy and clunky. Test2::Harness normally uses a newer streaming format to receive test results. There are old/legacy tests where this causes problems, in which case setting --TAP or --no-stream can help. =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --fail-on-resource-skip =item --no-fail-on-resource-skip Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C<YATH_JOB_COUNT>, C<T2_HARNESS_JOB_COUNT>, C<HARNESS_JOB_COUNT> =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource-timeout SECONDS =item --rt SECONDS =item --no-resource-timeout Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout) =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C<T2_HARNESS_JOB_CONCURRENCY> =item --stall-report =item --stall-report=STRONG:LOOSE =item --stall-report=SECONDS =item --no-stall-report Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath's own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200) =item --stall-report-dir path/to/dir =item --no-stall-report-dir Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable. =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C<PERL_USE_UNSAFE_INC> =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C<!T2_NO_FORK>, C<T2_HARNESS_FORK>, C<!T2_HARNESS_NO_FORK>, C<YATH_FORK>, C<!YATH_NO_FORK> =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C<T2_HARNESS_TEMP_DIR>, C<YATH_TEMP_DIR>, C<TMPDIR>, C<TEMPDIR>, C<TMP_DIR>, C<TEMP_DIR> =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C<T2_WORKDIR>, C<YATH_WORKDIR> =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-coverage =item --no-yathui-coverage Poll coverage data from Yath-UI to determine what tests should be run for changed files =item --yathui-durations =item --no-yathui-durations Poll duration data from Yath-UI to help order tests efficiently =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-upload =item --no-yathui-upload Upload the log to Yath-UI =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������speedtag.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 35160�15267772575� 22730� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::speedtag; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::File::JSONL; use App::Yath::Options; use Cwd qw/getcwd/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/-log_file -max_short -max_medium/; use Test2::Harness::Util qw/clean_path/; include_options( 'App::Yath::Options::Debug', ); option_group {prefix => 'speedtag', category => 'speedtag options'} => sub { option generate_durations_file => ( type => 'd', alt => ['durations', 'duration'], description => "Write out a duration json file, if no path is provided 'duration.json' will be used. The .json extension is added automatically if omitted.", long_examples => ['', '=/path/to/durations.json'], normalize => \&normalize_duration, action => \&duration_action, ); option pretty => ( description => "Generate a pretty 'durations.json' file when combined with --generate-durations-file. (sorted and multilines)", default => 0, ); }; sub group { 'log' } sub summary { "Tag tests with duration (short medium long) using a source log" } sub cli_args { "[--] event_log.jsonl[.gz|.bz2] max_short_duration_seconds max_medium_duration_seconds" } sub description { return <<" EOT"; This command will read the test durations from a log and tag/retag all tests from the log based on the max durations for each type. EOT } sub init { my $self = shift; $self->{+MAX_SHORT} //= 15; $self->{+MAX_MEDIUM} //= 30; } sub normalize_duration { my $val = shift; return $val if $val eq '1'; $val =~ s/\.json$//g; $val .= '.json'; return clean_path($val); } sub duration_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; return $$slot = clean_path($norm) unless $norm eq '1'; return if $$slot; return $$slot = clean_path('durations.json'); } sub run { my $self = shift; my $settings = $self->settings; my $args = $self->args; shift @$args if @$args && $args->[0] eq '--'; my $initial_dir = clean_path(getcwd()); $self->{+LOG_FILE} = shift @$args or die "You must specify a log file"; die "'$self->{+LOG_FILE}' is not a valid log file" unless -f $self->{+LOG_FILE}; die "'$self->{+LOG_FILE}' does not look like a log file" unless $self->{+LOG_FILE} =~ m/\.jsonl(\.(gz|bz2))?$/; $self->{+MAX_SHORT} = shift @$args if @$args; $self->{+MAX_MEDIUM} = shift @$args if @$args; die "max short duration must be an integer, got '$self->{+MAX_SHORT}'" unless $self->{+MAX_SHORT} && $self->{+MAX_SHORT} =~ m/^\d+$/; die "max short duration must be an integer, got '$self->{+MAX_MEDIUM}'" unless $self->{+MAX_MEDIUM} && $self->{+MAX_MEDIUM} =~ m/^\d+$/; my $stream = Test2::Harness::Util::File::JSONL->new(name => $self->{+LOG_FILE}); my $durations_file = $self->settings->speedtag->generate_durations_file; my %durations; while(1) { my @events = $stream->poll(max => 1000) or last; for my $event (@events) { my $stamp = $event->{stamp} or next; my $job_id = $event->{job_id} or next; my $f = $event->{facet_data} or next; next unless $f->{harness_job_end}; my $job = {}; $job->{file} = clean_path( $f->{harness_job_end}->{file} ) if $f->{harness_job_end} && $f->{harness_job_end}->{file}; $job->{time} = $f->{harness_job_end}->{times}->{totals}->{total} if $f->{harness_job_end} && $f->{harness_job_end}->{times}; next unless $job->{file} && $job->{time}; my $dur; if ($job->{time} < $self->{+MAX_SHORT}) { $dur = 'short'; } elsif ($job->{time} < $self->{+MAX_MEDIUM}) { $dur = 'medium'; } else { $dur = 'long'; } my $fh; unless (open($fh, '<', $job->{file})) { warn "Could not open file $job->{file} for reading\n"; next; } my @lines; my $injected; for my $line (<$fh>) { if ($line =~ m/^(\s*)#(\s*)HARNESS-(CAT(EGORY)?|DUR(ATION))-(LONG|MEDIUM|SHORT)$/i) { next if $injected++; $line = "${1}#${2}HARNESS-DURATION-" . uc($dur) . "\n"; } push @lines => $line; } unless ($injected) { my $new_line = "# HARNESS-DURATION-" . uc($dur) . "\n"; my @header; while (@lines && $lines[0] =~ m/^(#|use\s|package\s)/) { push @header => shift @lines; } unshift @lines => (@header, $new_line); } close($fh); unless (open($fh, '>', $job->{file})) { warn "Could not open file $job->{file} for writing\n"; next; } print $fh @lines; close($fh); if ( $durations_file ) { my $tfile = $job->{file}; $tfile =~ s{^\Q$initial_dir\E/+}{}; $durations{ $tfile } = uc( $dur ); } print "Tagged '$dur': $job->{file}\n"; } } if ( $durations_file ) { my $jfile = Test2::Harness::Util::File::JSON->new(name => $durations_file, pretty => $self->settings->speedtag->pretty ); $jfile->write( \%durations ); } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::speedtag - Tag tests with duration (short medium long) using a source log =head1 DESCRIPTION This command will read the test durations from a log and tag/retag all tests from the log based on the max durations for each type. =head1 USAGE $ yath [YATH OPTIONS] speedtag [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head3 speedtag options =over 4 =item --generate-durations-file =item --generate-durations-file=/path/to/durations.json =item --durations =item --durations=/path/to/durations.json =item --duration =item --duration=/path/to/durations.json =item --no-generate-durations-file Write out a duration json file, if no path is provided 'duration.json' will be used. The .json extension is added automatically if omitted. =item --pretty =item --no-pretty Generate a pretty 'durations.json' file when combined with --generate-durations-file. (sorted and multilines) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������IPC�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20425� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Process.pm������������������������������������������������������������������������������������������100644��001750��001750�� 4417�15267772575� 22547� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/IPC���������������������������������������������������������������������������������������������������������������������������package Test2::Harness::IPC::Process; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Util::HashBase qw{ <exit <exit_time <pid +category }; sub category { $_[0]->{+CATEGORY} //= 'default' } sub set_pid { my $self = shift; my ($pid) = @_; croak "pid has already been set" if defined $self->{+PID}; $self->{+PID} = $pid; } sub set_exit { my $self = shift; my ($ipc, $exit, $time) = @_; croak "exit has already been set" if defined $self->{+EXIT}; $self->{+EXIT} = $exit; $self->{+EXIT_TIME} = $time; } sub spawn_params { my $self = shift; my $class = ref($self) || $self; croak "Process class '$class' does not implement 'spawn_params()'"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::IPC::Process - Base class for processes controlled by Test2::Harness::IPC. =head1 DESCRIPTION All processes controlled by L<Test2::Harness::IPC> should subclass this one. =head1 ATTRIBUTES =over 4 =item $int = $proc->exit Exit value, if set. Otherwise C<undef>. =item $stamp = $proc->exit_time Timestamp of the process exit, if set, otherwise C<undef>. =item $pid = $proc->pid Pid of the process, if it has been started. =item $cat = $proc->category Set at construction, C<'default'> if not provided. =back =head1 METHODS =over 4 =item $opt->set_pid($pid) Set the process id. =item $opt->set_exit($ipc, $exit, $time) Set the process as complete. $exit should be the exit value. $time should be a timestamp. $ipc is an instance of L<Test2::Harness::IPC>. =item $hashref = $opt->spawn_params() Used when spawning the process, args go to C<run_cmd()> from L<Test2::Harness::Util::IPC>. The base class throws an exception if this method is called. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Stall�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21071� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Trace.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 11650�15267772575� 22650� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Stall�������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Stall::Trace; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use Importer Importer => 'import'; our @EXPORT_OK = qw/install_trace_handler stack_trace/; # Deliberately small. Everything a watcher can see from outside -- /proc, open # files, the run state -- is collected by whoever sends the signal, because a # process wedged in an uninterruptible syscall never runs this at all. The Perl # call stack is the one thing only the process itself can produce, so it is the # only thing gathered here. Nothing in this file may walk harness objects or # take a lock; the process is already believed stuck. sub stack_trace { my @frames; my $i = 0; while (my @caller = caller($i++)) { my ($pkg, $file, $line, $sub) = @caller; # Plain caller(), never Carp::longmess: longmess formats each frame's # arguments, and those hold the resource objects and task hashrefs # belonging to the code we suspect of being stuck. push @frames => { package => $pkg, file => $file, line => $line, sub => $sub, }; last if $i > 200; } return \@frames; } sub _render { my ($frames) = @_; my $out = "$$ $0 stack trace:\n"; my $i = 0; for my $frame (@$frames) { $out .= sprintf(" [%d] %s at %s line %s\n", $i++, $frame->{sub}, $frame->{file}, $frame->{line}); } return $out; } sub _write_trace { my ($dir, $round) = @_; my $frames = stack_trace(); my $text = _render($frames); # Its own STDERR first, so the trace survives even if whoever asked for it # dies before collecting the files. For the runner and its children that is # error.log, which the collector already forwards. print STDERR "\n$text"; return unless $dir && -d $dir; my $file = File::Spec->catfile($dir, "stack-$$-$round.txt"); open(my $fh, '>', $file) or return; print $fh $text; return; } # Installed in every harness process, never in a test job. A job process sheds # this handler when the runner's Scope::Guard restores the original %SIG, so # SIGUSR1 there takes its default action and kills the test. Whoever signals # must use a whitelist of known harness pids and must never signal a process # group. sub install_trace_handler { my ($dir) = @_; my $round = 0; $SIG{USR1} = sub { local ($!, $@, $_); $round++; eval { _write_trace($dir, $round); 1 }; }; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Stall::Trace - Report a process's own Perl call stack on demand. =head1 DESCRIPTION Deliberately small. Everything a watcher can see from outside a stuck process -- C</proc> state, wait channels, open files, the run state -- is collected by whoever sends the signal, because a process wedged in an uninterruptible syscall never runs a handler at all, and that is the case most in need of description. The Perl call stack is the one thing only the process itself can produce, so it is the only thing gathered here. Nothing in this module may walk harness objects or take a lock; by the time it runs, the process is already believed stuck. It uses a plain C<caller> loop rather than C<Carp::longmess>, which formats each frame's arguments -- and those hold the resource objects and task hashrefs belonging to the code under suspicion. =head2 NEVER SIGNAL A TEST JOB The handler is installed in harness processes only: the runner, the scheduler, the stages, the collector and the auditor. A test job process sheds it when the runner's C<Scope::Guard> restores the original C<%SIG>, so C<SIGUSR1> there takes its default action and B<terminates the test>. Whoever sends the signal must therefore use a whitelist of known harness pids, and must never signal a process group. =head1 SYNOPSIS use Test2::Harness::Stall::Trace qw/install_trace_handler/; install_trace_handler(File::Spec->catdir($workdir, 'stall')); =head1 EXPORTS =over 4 =item install_trace_handler($dir) Installs the C<SIGUSR1> handler. Each signal writes the frames to the process's own STDERR, and to C<$dir/stack-$$-N.txt> where N counts up per process. Install it after any snapshot of C<%SIG> the process intends to restore, so a forked test job sheds it. =item $arrayref = stack_trace() The current call stack as a list of hashrefs with C<package>, C<file>, C<line> and C<sub>. Frame arguments are never touched. =back =head1 SOURCE The source code repository for Test2-Harness can be found at L<https://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<https://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������Tools�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 17507� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2���������������������������������������������������������������������������������������������������������������������������������������HarnessTester.pm������������������������������������������������������������������������������������100644��001750��001750�� 7614�15267772575� 23007� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Tools���������������������������������������������������������������������������������������������������������������������������������package Test2::Tools::HarnessTester; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::UUID qw/gen_uuid/; use App::Yath::Tester qw/make_example_dir/; use Importer Importer => qw/import/; our @EXPORT_OK = qw/make_example_dir summarize_events/; my $HARNESS_ID = 1; sub summarize_events { my ($events) = @_; my @caller = caller(0); my $id = $HARNESS_ID++; my $run_id = "run-$id"; my $job_id = "job-$id"; require Test2::Harness::Auditor::Watcher; my $watcher = Test2::Harness::Auditor::Watcher->new(job => 1, try => 0); require Test2::Harness::Event; for my $e (@$events) { my $fd = $e->facet_data; my $he = Test2::Harness::Event->new( facet_data => $fd, event_id => gen_uuid(), run_id => $run_id, job_id => $job_id, stamp => time, job_try => 0, ); $watcher->process($he); } return { plan => $watcher->plan, pass => $watcher->pass ? 1 : 0, fail => $watcher->fail ? 1 : 0, errors => $watcher->_errors, failures => $watcher->_failures, assertions => $watcher->assertion_count, }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Tools::HarnessTester - Run events through a harness for a summary =head1 DESCRIPTION This tool allows you to process events through the L<Test2::Harness> auditor. The main benefit here is to get a pass/fail result, as well as counts for assertions, failures, and errors. =head1 SYNOPSIS use Test2::V0; use Test2::API qw/intercept/; use Test2::Tools::HarnessTester qw/summarize_events/; my $events = intercept { ok(1, "pass"); ok(2, "pass gain"); done_testing; }; is( summarize_events($events), { # Each of these is the negation of the other, no need to check both pass => 1, fail => 0, # The plan facet, see Test2::EventFacet::Plan plan => {count => 2}, # Statistics assertions => 2, errors => 0, failures => 0, } ); =head1 EXPORTS =head2 $summary = summarize_events($events) This takes an arrayref of events, such as that produced by C<intercept {...}> from L<Test2::API>. The result is a hashref that summarizes the results of the events as processed by L<Test2::Harness>, specifically the L<Test2::Harness::Auditor::Watcher> module. Fields in the summary hash: =over 4 =item pass => $BOOL =item fail => $BOOL These are negatives of each other. These represent the pass/fail state after processing the events. When one is true the other should be false. These are normalized to C<1> and C<0>. =item plan => $HASHREF If a plan was provided this will have the L<Test2::EventFacet::Plan> facet, but as a hashref, not a blessed instance. B<Note:> This is reference to the original data, not a copy, if you modify it you will modify the event as well. =item assertions => $INT Count of assertions made. =item errors => $INT Count of errors seen. =item failures => $INT Count of failures seen. =back =head2 $path = make_example_dir() This will create a temporary directory with 't', 't2', and 'xt' subdirectories each of which will contain a single passing test. This is re-exported from L<App::Yath::Tester>. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������cover_exclude���������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22255� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 707�15267772575� 23176� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude���������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Basename qw/dirname/; BEGIN { my $dir = dirname(__FILE__); unshift @INC => "$dir/deps/lib", "$dir/deps2", "$dir/vendor"; } use Keep; use Dep; use Dep2; use Vendor; print "PRELOAD: " . ($INC{'CoverExcludePreload.pm'} ? 1 : 0) . "\n"; is(Keep->keep, 'keep', "Got keep"); is(Dep->dep, 'dep', "Got dep"); is(Dep2->dep2, 'dep2', "Got dep2"); is(Vendor->vendor, 'vendor', "Got vendor"); done_testing; ���������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21767� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage��������������������������������������������������������������������������������������������������������������������������Ax.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 206�15267772575� 23013� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage/lib����������������������������������������������������������������������������������������������������������������������package Ax; use strict; use warnings; # This is here for simulating a non-sub change my $A = 'a'; sub a { 'a' } sub aa { 'aa' } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Bx.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 71�15267772575� 22774� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage/lib����������������������������������������������������������������������������������������������������������������������package Bx; use strict; use warnings; sub b { 'b' } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Cx.pm�����������������������������������������������������������������������������������������������100644��001750��001750�� 71�15267772575� 22775� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage/lib����������������������������������������������������������������������������������������������������������������������package Cx; use strict; use warnings; sub c { 'c' } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������encoding��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21214� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������plugin.tx�������������������������������������������������������������������������������������������100644��001750��001750�� 1142�15267772575� 23225� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/encoding��������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; use Test2::Plugin::UTF8; note "valid note [“”\xff\xff]"; note "valid note [“”]"; diag "valid diag [“”\xff\xff]"; diag "valid diag [“”]"; print "valid stdout [“”\xff\xff]\n"; print "valid stdout [“”]\n"; print STDERR "valid stderr [“”\xff\xff]\n"; print STDERR "valid stderr [“”]\n"; ok 1, "valid ok [“”\xff\xff]"; ok 1, "valid ok [“”]"; print STDOUT "STDOUT: Mākaha\n"; print STDERR "STDERR: Mākaha\n"; diag "DIAG: Mākaha"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); ok(1, "І ще трохи"); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������inc_hook��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21217� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������simple.tx�������������������������������������������������������������������������������������������100644��001750��001750�� 575�15267772575� 23214� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/inc_hook��������������������������������������������������������������������������������������������������������������������������use Test2::V0; # Reported so the parent can see whether a stringified hook reached this # process as an -I path. Live hooks are skipped: this process keeps its own # when it is exec'd rather than forked, and printing one would look exactly # like the leak being watched for. note("INC: $_") for grep { !ref($_) } @INC; ok(1, 'basic test runs under an @INC hook'); done_testing; �����������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21622� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������AAA.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 20�15267772575� 22632� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package AAA; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������BBB.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 20�15267772575� 22635� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package BBB; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CCC.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 20�15267772575� 22640� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package CCC; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������resource_timeout.t����������������������������������������������������������������������������������100644��001750��001750�� 2117�15267772575� 23351� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Test 1: resource-timeout fires when a resource stalls # StalledResource lets the first test run, then blocks all subsequent tests. # With --resource-timeout=2, yath should abort after 2 seconds of being unable # to start any new tests. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', "-D$dir", '-R+StalledResource', '--resource-timeout=2'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/Resource timeout after/, "Got resource timeout message"); }, ); # Test 2: no timeout when --resource-timeout is 0 (disabled) and tests complete normally # Without the stalled resource, both tests should pass fine and no timeout message appears. yath( command => 'test', args => [$dir, '--ext=tx', '-j2', '--resource-timeout=0'], exit => 0, test => sub { my $out = shift; unlike($out->{output}, qr/Resource timeout after/, "No resource timeout when disabled"); }, ); done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������shares����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20713� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������shared_a.tx�����������������������������������������������������������������������������������������100644��001750��001750�� 407�15267772575� 23157� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/shares����������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-SHARES-DB use TestBarrier qw/barrier_wait/; # Neither of the two shared tests finishes until both are live, so the log is # guaranteed to show them overlapping rather than merely likely to. barrier_wait(); ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������shared_b.tx�����������������������������������������������������������������������������������������100644��001750��001750�� 407�15267772575� 23160� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/shares����������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-SHARES-DB use TestBarrier qw/barrier_wait/; # Neither of the two shared tests finishes until both are live, so the log is # guaranteed to show them overlapping rather than merely likely to. barrier_wait(); ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������tapsubtest������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21624� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������test.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 243�15267772575� 23277� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/tapsubtest������������������������������������������������������������������������������������������������������������������������# HARNESS-NO-STREAM use Test2::V0; use Test2::Tools::Subtest qw/subtest_buffered/; subtest_buffered buffered => sub { ok(1, "buffered ok"); }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������broken.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 104�15267772575� 22605� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath/Command��������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::Broken; die "This command is broken!"; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Options.pm������������������������������������������������������������������������������������������100644��001750��001750�� 237�15267772575� 22647� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/lib/App/Yath/Plugin���������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::Options; use strict; use warnings; use App::Yath::Options; option foobar => ( prefix => 'testplugin', type => 'b', ); 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Options���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21142� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath���������������������������������������������������������������������������������������������������������������������������������Runner.t��������������������������������������������������������������������������������������������100644��001750��001750�� 2355�15267772575� 22745� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Options�������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-DURATION-SHORT # HARNESS-NO-PRELOAD use App::Yath::Options::Runner; my $opts = App::Yath::Options::Runner->options; subtest 'fail_on_resource_skip option is defined' => sub { my @all = @{$opts->all}; my ($opt) = grep { $_->field eq 'fail_on_resource_skip' } @all; ok($opt, "fail_on_resource_skip option exists"); is($opt->type, 'b', "Option is a boolean type"); is($opt->default, 0, "Default is 0 (off)"); like($opt->description, qr/resource-skipped tests as failures/, "Description mentions resource-skipped tests"); is($opt->prefix, 'runner', "Option is in the runner prefix"); is($opt->field, 'fail_on_resource_skip', "Field name is fail_on_resource_skip"); }; subtest 'fail_on_resource_skip default in settings' => sub { my ($opt) = grep { $_->field eq 'fail_on_resource_skip' } @{$opts->all}; my $settings = $opts->settings; # option_slot defines the prefix and vivifies the field my $slot = $opt->option_slot($settings); my $default = $opt->get_default($settings); $$slot //= $default; ok($settings->check_prefix('runner'), "runner prefix is defined"); is($settings->runner->fail_on_resource_skip, 0, "Default value is 0 (skip, not fail)"); }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SysInfo.t�������������������������������������������������������������������������������������������100644��001750��001750�� 7107�15267772575� 22671� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Plugin��������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'App::Yath::Plugin::SysInfo'; use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/; # HARNESS-DURATION-SHORT my $control = mock $CLASS => ( override => [ hostname => sub { 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net' }, ], ); local *App::Yath::Plugin::SysInfo::Config = { 'useperlio' => 'define', 'use64bitint' => 'define', 'use64bitall' => 'define', 'useithreads' => 'define', 'osname' => 'linux', 'archname' => 'x86_64-linux', 'usemultiplicity' => undef, 'version' => '1.2.3', 'uselongdouble' => undef, }; local $ENV{USER} = 'bob'; local $ENV{SHELL} = '/bin/shell'; local $ENV{TERM} = 'myterm'; my $meta = {}; my $fields = []; my $one = $CLASS->new(); $one->inject_run_data(meta => $meta, fields => $fields); is( $fields, [ { name => 'sys', details => 'foo.bar.baz-22', raw => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', data => { hostname => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_sigsys => CAN_SIGSYS(), can_thread => CAN_THREAD(), }, env => { shell => '/bin/shell', term => 'myterm', user => 'bob', }, config => { archname => 'x86_64-linux', osname => 'linux', use64bitall => 'define', use64bitint => 'define', useithreads => 'define', uselongdouble => undef, usemultiplicity => undef, useperlio => 'define', version => '1.2.3', } }, } ], "Got expected fields" ); $meta = {}; $fields = []; $one = $CLASS->new(host_short_pattern => "bar\\.baz-\\d+"); $one->inject_run_data(meta => $meta, fields => $fields); is( $fields, [ { name => 'sys', details => 'bar.baz-22', raw => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', data => { hostname => 'foo.bar.baz-22.superlongnamewedonotwantseen.evenlonger.holycow.net', ipc => { can_fork => CAN_FORK(), can_really_fork => CAN_REALLY_FORK(), can_sigsys => CAN_SIGSYS(), can_thread => CAN_THREAD(), }, env => { shell => '/bin/shell', term => 'myterm', user => 'bob', }, config => { archname => 'x86_64-linux', osname => 'linux', use64bitall => 'define', use64bitint => 'define', useithreads => 'define', uselongdouble => undef, usemultiplicity => undef, useperlio => 'define', version => '1.2.3', } }, } ], "Got expected fields, including custom hostname short filter" ); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Collector.t�����������������������������������������������������������������������������������������100644��001750��001750�� 10304�15267772575� 22757� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Collector'; use File::Spec; use File::Temp qw/tempdir/; use Time::HiRes qw/time/; use MIME::Base64 qw/decode_base64/; use Test2::Harness::Run; my $tmp = tempdir(CLEANUP => 1); my $run_id = 'test-run'; mkdir(File::Spec->catdir($tmp, $run_id)) or die "Could not create run dir: $!"; sub new_collector { return $CLASS->new( run => Test2::Harness::Run->new(run_id => $run_id), workdir => $tmp, run_id => $run_id, action => sub { }, @_, ); } subtest defaults => sub { my $one = new_collector(); is($one->wait_time, 0.02, "wait_time defaults to 0.02"); is($one->idle_wait, $CLASS->MIN_WAIT, "backoff starts at the floor"); }; subtest wait_time_is_settable => sub { my $one = new_collector(wait_time => 0.5); is($one->wait_time, 0.5, "wait_time can be set by the constructor"); }; subtest backoff_doubles_and_caps => sub { my $one = new_collector(wait_time => 0.008); my @seen; for (1 .. 5) { push @seen => $one->idle_wait; $one->idle_sleep; } is( \@seen, [0.001, 0.002, 0.004, 0.008, 0.008], "each sleep doubles the wait until it reaches the wait_time ceiling, then holds" ); is($one->idle_wait, 0.008, "wait stays at the ceiling"); }; subtest reset_returns_to_the_floor => sub { my $one = new_collector(wait_time => 0.008); $one->idle_sleep for 1 .. 4; is($one->idle_wait, 0.008, "backed off to the ceiling"); $one->reset_idle_wait; is($one->idle_wait, $CLASS->MIN_WAIT, "reset returns to the floor"); }; subtest ceiling_below_the_floor_is_honored => sub { my $one = new_collector(wait_time => 0.0005); $one->idle_sleep; is($one->idle_wait, 0.0005, "a wait_time under the floor caps the very first backoff"); }; subtest idle_sleep_actually_sleeps => sub { my $one = new_collector(); my $start = time; $one->idle_sleep; my $slept = time - $start; # Deliberately loose: this asserts that a sleep happens at all, not how # precisely the scheduler honors the requested duration. ok($slept >= 0.0005, "idle_sleep waited", "slept ${slept}s"); }; subtest aux_attachments => sub { my @events; my $one = new_collector(show_runner_output => 1, action => sub { push @events => $_[0] }); @events = (); # Drop the harness_run event the constructor sends. my $dir = File::Spec->catdir($tmp, 'aux_logs', 'attachments'); mkdir(File::Spec->catdir($tmp, 'aux_logs')) or die "Could not create aux_logs: $!"; mkdir($dir) or die "Could not create attachments dir: $!"; my $bytes = join '' => map { chr } 0 .. 255; for my $file (['bundle.tar.gz', $bytes], ['.shot.png.tmp', 'partial']) { open(my $fh, '>:raw', File::Spec->catfile($dir, $file->[0])) or die "Could not write $file->[0]: $!"; print $fh $file->[1]; close($fh) or die "Could not close $file->[0]: $!"; } is($one->process_runner_output, 1, "one event, the dotfile is ignored"); is( $events[0]->facet_data, hash { field harness => T(); field info => [{tag => 'ARTIFACT', details => 'attached bundle.tar.gz', important => 1}]; field binary => [{filename => 'bundle.tar.gz', details => 'bundle.tar.gz', data => T(), is_image => 0}]; etc; }, "attachment event has the info and binary facets" ); is($events[0]->job_id, 0, "attached to the harness job"); is(decode_base64($events[0]->facet_data->{binary}->[0]->{data}), $bytes, "data decodes to the original bytes, not decompressed"); @events = (); is($one->process_runner_output, 0, "nothing is attached twice"); rename(File::Spec->catfile($dir, '.shot.png.tmp'), File::Spec->catfile($dir, 'shot.png')) or die "Could not rename: $!"; is($one->process_runner_output, 1, "the renamed file is attached on the next poll"); is($events[0]->facet_data->{binary}->[0]->{filename}, 'shot.png', "under its final name"); is($events[0]->facet_data->{binary}->[0]->{is_image}, 1, "image extension sets is_image"); }; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Util������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21403� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������File.t����������������������������������������������������������������������������������������������100644��001750��001750�� 4720�15267772575� 22612� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util�����������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File'; # HARNESS-DURATION-SHORT use ok $CLASS; can_ok($CLASS, qw/name done set_done/); like( dies { $CLASS->new }, qr/'name' is a required attribute/, "Must provide the 'name' attribute" ); open(my $tmpfh, '<', __FILE__) or die "Could not open file: $!"; my $zed = $CLASS->new(name => __FILE__, fh => $tmpfh); is($zed->_init_fh, $tmpfh, "saved fh"); is($zed->fh->blocking, 0, "fh was set to non-blocking"); $zed = undef; my $one = $CLASS->new(name => __FILE__); my $two = $CLASS->new(name => '/some/super/fake/file/that must not exist'); ok($one->exists, "This file exists"); ok(!$two->exists, "The file does not exist"); is($one->decode('xxx'), 'xxx', "base class decode does nothing"); is($one->encode('xxx'), 'xxx', "base class encode does nothing"); ok(my $fh = $one->open_file, "opened file (for reading)"); ok(dies { $two->open_file }, "Cannot open file (for reading)"); my ($line) = split /\n/, $one->maybe_read, 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';}, "Can read file (using maybe_read)" ); is( $two->maybe_read, undef, "maybe_read returns undef for non-existant file" ); ($line) = split /\n/, $one->read, 2; like( $line, q{use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';}, "Can read file" ); ok(dies { $two->read }, "read() dies on missing file"); close($fh); ok($fh = $one->fh, "Can generate an FH"); is($one->fh, $fh, "FH is remembered"); is($fh->blocking, 0, "FH is non-blocking"); close($fh); is($two->fh, undef, "return undef for missing file"); $one->set_done(1); is($one->done, 1, "can set done"); $one->reset; ok(!$one->{_fh}, "removed fh"); ok(!$one->done, "cleared done flag"); $two->reset; is($two->read_line, undef, "cannot read lines from missing file"); is( $one->read_line, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';\n", "Got first line" ); while(my $l = $one->read_line) { 1 } is($one->read_line, undef, "no line to read yet"); $one->set_done(1); is( $one->read_line, "This line MUST be here, and MUST not end with a newline.", "Got final line with no terminator" ); $one->reset; is( $one->read_line, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File';\n", "Got first line again after reset" ); #TODO: write (it is atomic) done_testing; __END__ This line MUST be here, and MUST not end with a newline.������������������������������������������������JSON.t����������������������������������������������������������������������������������������������100644��001750��001750�� 1321�15267772575� 22476� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util�����������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::JSON'; # HARNESS-DURATION-SHORT use ok $CLASS; imported_ok(qw{ JSON encode_json decode_json encode_pretty_json encode_canon_json }); ok(JSON(), "Have JSON constant"); can_ok(JSON(), ['new'], "JSON returns a class (" . JSON() . ")"); my $struct = { a => 1, b => 2 }; for my $encode_name (qw/encode_json encode_pretty_json encode_canon_json/) { is( decode_json(__PACKAGE__->can($encode_name)->($struct)), $struct, "Round Trip $encode_name+decode" ); is( decode_json(__PACKAGE__->can($encode_name)->(undef)), undef, "undef/null round-trip $encode_name+decode" ); } done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Term.t����������������������������������������������������������������������������������������������100644��001750��001750�� 364�15267772575� 22622� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util�����������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Util::Term'; # HARNESS-DURATION-SHORT use ok $CLASS => qw/USE_ANSI_COLOR/; imported_ok(qw/USE_ANSI_COLOR/); is(USE_ANSI_COLOR(), in_set(0, 1), "USE_ANSI_COLOR returns true or false"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������resources.pm����������������������������������������������������������������������������������������100644��001750��001750�� 45446�15267772575� 23156� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::resources; use strict; use warnings; our $VERSION = '1.000182'; use Term::Table(); use File::Spec(); use Time::HiRes qw/sleep/; use App::Yath::Util qw/find_pfile/; use App::Yath::Options; use Test2::Harness::Runner::State; use Test2::Harness::Util::File::JSON(); use Test2::Harness::Util::Queue(); use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase qw/+state/; include_options( 'App::Yath::Options::Debug', 'App::Yath::Options::Runner', ); sub group { 'state' } sub summary { "View the state info for a test runner" } sub cli_args { "" } sub description { return <<" EOT"; A look at the state and resources used by a runner. EOT } sub pfile_params { (no_fatal => 1) } sub newest { my ($a, $b) = @_; return $a unless $b; return $b unless $a; my @as = stat($a); my @bs = stat($b); return $a if $as[9] > $bs[9]; return $b; } sub state { my $self = shift; return $self->{+STATE} if $self->{+STATE}; my $info_file; opendir(my $dh, "./") or die "Could not open current dir: $!"; for my $file (readdir($dh)) { next unless $file =~ m{^\.test_info\.\S+\.json$}; $info_file = newest($info_file, "./$file"); } my $pfile = find_pfile($self->settings, no_fatal => 1); if (my $use = newest($info_file, $pfile)) { if ($info_file) { my $data = Test2::Harness::Util::File::JSON->new(name => $info_file)->read; return $self->{+STATE} = Test2::Harness::Runner::State->new(%$data, observe => 1); } if (my $pfile = find_pfile($self->settings, no_fatal => 1)) { my $data = Test2::Harness::Util::File::JSON->new(name => $pfile)->read(); my $workdir = $data->{dir}; my $settings = Test2::Harness::Util::File::JSON->new(name => "$workdir/settings.json")->read(); return $self->{+STATE} = Test2::Harness::Runner::State->new( observe => 1, job_count => $settings->{runner}->{job_count} // 1, workdir => $data->{dir}, ); } } return; } sub shared { my $self = shift; my $shared; eval { require Test2::Harness::Runner::Resource::SharedJobSlots; $shared = Test2::Harness::Runner::Resource::SharedJobSlots->new( settings => $self->settings, ); 1; }; return $shared; } sub run { my $self = shift; my $res; if(my $state = $self->state) { my @list; $res = sub { unless (@list) { $state->poll; @list = (@{$state->resources}, undef); } return shift @list; }; } elsif (my $shared = $self->shared) { my $alt = 0; $res = sub { if ($alt) { $alt = 0; return undef; } $alt = 1; return $shared; }; } die "No persistent runner, no running test, and no shared resources found\n" unless $res; while (1) { my @out = ( "\r\e[2J\r\e[1;1H", "\n==== Resource state ====\n", ); while (my $resource = $res->()) { my @lines = $resource->status_lines; next unless @lines; push @out => ( "\nResource: " . ref($resource) . "\n", join "\n" => @lines, ); } push @out => "\n\n"; print @out; sleep 0.2; } return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::resources - View the state info for a test runner =head1 DESCRIPTION A look at the state and resources used by a runner. =head1 USAGE $ yath [YATH OPTIONS] resources [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 Runner Options =over 4 =item --abort-on-bail =item --no-abort-on-bail Abort all testing if a bail-out is encountered (default: on) =item --blib =item -b =item --no-blib (Default: include if it exists) Include 'blib/lib' and 'blib/arch' in your module path =item --cover =item --cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --no-cover Use Devel::Cover to calculate test coverage. This disables forking. If no args are specified the following are used: -silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl =item --dump-depmap =item --no-dump-depmap When using staged preload, dump the depmap for each stage as json files =item --event-timeout SECONDS =item --et SECONDS =item --no-event-timeout Kill test if no output is received within timeout period. (Default: 60 seconds). Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. This prevents a hung test from running forever. =item --fail-on-resource-skip =item --no-fail-on-resource-skip Treat resource-skipped tests as failures instead of skips. When enabled, tests that would be skipped due to unavailable resources will be marked as failing. =item --include ARG =item --include=ARG =item -I ARG =item -I=ARG =item --no-include Add a directory to your include paths Can be specified multiple times =item --job-count 4 =item --job-count 8:2 =item --jobs 4 =item --jobs 8:2 =item -j4 =item -j8:2 =item --no-job-count Set the number of concurrent jobs to run. Add a :# if you also wish to designate multiple slots per test. 8:2 means 8 slots, but each test gets 2 slots, so 4 tests run concurrently. Tests can find their concurrency assignment in the "T2_HARNESS_MY_JOB_CONCURRENCY" environment variable. Can also be set with the following environment variables: C<YATH_JOB_COUNT>, C<T2_HARNESS_JOB_COUNT>, C<HARNESS_JOB_COUNT> =item --lib =item -l =item --no-lib (Default: include if it exists) Include 'lib' in your module path =item --nytprof =item --no-nytprof Use Devel::NYTProf on tests. This will set addpid=1 for you. This works with or without fork. =item --post-exit-timeout SECONDS =item --pet SECONDS =item --no-post-exit-timeout Stop waiting post-exit after the timeout period. (Default: 15 seconds) Some tests fork and allow the parent to exit before writing all their output. If Test2::Harness detects an incomplete plan after the test exits it will monitor for more events until the timeout period. Add the "# HARNESS-NO-TIMEOUT" comment to the top of a test file to disable timeouts on a per-test basis. =item --preload-threshold ARG =item --preload-threshold=ARG =item --Pt ARG =item --Pt=ARG =item -W ARG =item -W=ARG =item --no-preload-threshold Only do preload if at least N tests are going to be run. In some cases a full preload takes longer than simply running the tests, this lets you specify a minimum number of test jobs that will be run for preload to happen. This has no effect for a persistent runner. The default is 0, and it means always preload. =item --preloads ARG =item --preloads=ARG =item --preload ARG =item --preload=ARG =item -P ARG =item -P=ARG =item --no-preloads Preload a module before running tests Can be specified multiple times =item --resource-timeout SECONDS =item --rt SECONDS =item --no-resource-timeout Abort the test run if no tests have been able to start for SECONDS seconds while there are pending tests and none running. This is useful when a resource class is broken and always claims a resource will become available, preventing yath from ever finishing. (Default: 0, meaning no timeout) =item --resource Port =item --resource +Test2::Harness::Runner::Resource::Port =item -R Port =item --no-resource Use a resource module to assign resource assignments to individual tests Can be specified multiple times =item --runner-id ARG =item --runner-id=ARG =item --no-runner-id Runner ID (usually a generated uuid) =item --shared-jobs-config .sharedjobslots.yml =item --shared-jobs-config relative/path/.sharedjobslots.yml =item --shared-jobs-config /absolute/path/.sharedjobslots.yml =item --no-shared-jobs-config Where to look for a shared slot config file. If a filename with no path is provided yath will search the current and all parent directories for the name. =item --slots-per-job 2 =item -x2 =item --no-slots-per-job This sets the number of slots each job will use (default 1). This is normally set by the ':#' in '-j#:#'. Can also be set with the following environment variables: C<T2_HARNESS_JOB_CONCURRENCY> =item --stall-report =item --stall-report=STRONG:LOOSE =item --stall-report=SECONDS =item --no-stall-report Print diagnostics when the scheduler appears to have stopped starting tests. Give it alone for sensible waits, or set them: STRONG is the wait, in seconds, before reporting when tests are pending and none are running; LOOSE is the wait when tests are pending and others are still running. A single number sets both, and a zero in either field turns off that tier alone, so 600:0 reports only when nothing is running. This only prints a report, it never ends the run, and a report may be benign. Enabling it sends SIGUSR1 to yath's own processes to collect stack traces, pauses output for a few seconds per report, stops after 5 reports, and writes a yath-stall-report-*.json bundle both into the run log and to a file (see --stall-report-dir). (Default: off; --stall-report alone means 600:1200) =item --stall-report-dir path/to/dir =item --no-stall-report-dir Directory for the JSON bundle --stall-report writes. Defaults to the directory yath was run from. Use this when that directory is not writable, or to collect bundles somewhere durable. =item --switch ARG =item --switch=ARG =item -S ARG =item -S=ARG =item --no-switch Pass the specified switch to perl for each test. This is not compatible with preload. Can be specified multiple times =item --tlib =item --no-tlib (Default: off) Include 't/lib' in your module path =item --unsafe-inc =item --no-unsafe-inc perl is removing '.' from @INC as a security concern. This option keeps things from breaking for now. Can also be set with the following environment variables: C<PERL_USE_UNSAFE_INC> =item --use-fork =item --fork =item --no-use-fork (default: on, except on windows) Normally tests are run by forking, which allows for features like preloading. This will turn off the behavior globally (which is not compatible with preloading). This is slower, it is better to tag misbehaving tests with the '# HARNESS-NO-PRELOAD' comment in their header to disable forking only for those tests. Can also be set with the following environment variables: C<!T2_NO_FORK>, C<T2_HARNESS_FORK>, C<!T2_HARNESS_NO_FORK>, C<YATH_FORK>, C<!YATH_NO_FORK> =item --use-timeout =item --timeout =item --no-use-timeout (default: on) Enable/disable timeouts =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������collector.pm����������������������������������������������������������������������������������������100644��001750��001750�� 24623�15267772575� 23124� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Command����������������������������������������������������������������������������������������������������������������������������package App::Yath::Command::collector; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec; use App::Yath::Util qw/isolate_stdout/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Run; use Test2::Harness::Stall::Detector(); use Test2::Harness::Stall::Trace qw/install_trace_handler/; use parent 'App::Yath::Command'; use Test2::Harness::Util::HashBase; sub internal_only { 1 } sub summary { "For internal use only" } sub name { 'collector' } sub run { my $self = shift; my ($collector_class, $dir, $run_id, $runner_pid, %args) = @{$self->{+ARGS}}; my $name = 'yath-collector'; $name = "$args{procname_prefix}-${name}" if $args{procname_prefix}; $0 = $name; my $fh = isolate_stdout(); my $settings = Test2::Harness::Settings->new(File::Spec->catfile($dir, 'settings.json')); # List context on purpose: parse_spec returns a list, so a boolean test # would see only its last value and miss STRONG:0. my %stall = $settings->check_prefix('runner') ? Test2::Harness::Stall::Detector->parse_spec($settings->runner->stall_report) : (); install_trace_handler(File::Spec->catdir($dir, 'stall')) if %stall; require(mod2file($collector_class)); my $run = Test2::Harness::Run->new(%{decode_json(<STDIN>)}); my $collector = $collector_class->new( %args, settings => $settings, workdir => $dir, run_id => $run_id, runner_pid => $runner_pid, run => $run, # as_json may already have the json form of the event cached, if so # we can avoid doing an extra call to encode_json action => sub { print $fh defined($_[0]) ? ($_[0]->as_json, "\n") : "null\n"; }, ); local $SIG{PIPE} = 'IGNORE'; my $ok = eval { $collector->process(); 1 }; my $err = $@; eval { print $fh "null\n"; 1 } or warn $@; die $err unless $ok; return 0; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Command::collector - For internal use only =head1 DESCRIPTION No Description =head1 USAGE $ yath [YATH OPTIONS] collector [COMMAND OPTIONS] =head2 YATH OPTIONS =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Help and Debugging =over 4 =item --show-opts =item --no-show-opts Exit after showing what yath thinks your options mean =item --version =item -V =item --no-version Exit after showing a helpful usage message =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head2 COMMAND OPTIONS =head3 Cover Options =over 4 =item --cover-aggregator ByTest =item --cover-aggregator ByRun =item --cover-aggregator +Custom::Aggregator =item --cover-agg ByTest =item --cover-agg ByRun =item --cover-agg +Custom::Aggregator =item --no-cover-aggregator Choose a custom aggregator subclass =item --cover-class ARG =item --cover-class=ARG =item --no-cover-class Choose a Test2::Plugin::Cover subclass =item --cover-dirs ARG =item --cover-dirs=ARG =item --cover-dir ARG =item --cover-dir=ARG =item --no-cover-dirs NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-exclude-dirs ARG =item --cover-exclude-dirs=ARG =item --cover-exclude-dir ARG =item --cover-exclude-dir=ARG =item --no-cover-exclude-dirs Directory to leave out of file coverage and coverage metrics, along with everything under it at any depth. May be specified multiple times. Wildcards are expanded when the option is parsed, so a pattern matching nothing excludes nothing. Values are word-split first, so a path containing whitespace must be quoted or backslash-escaped. A resolved path may not contain a comma. Can be specified multiple times =item --cover-exclude-private =item --no-cover-exclude-private =item --cover-files =item --no-cover-files Use Test2::Plugin::Cover to collect coverage data for what files are touched by what tests. Unlike Devel::Cover this has very little performance impact (About 4% difference) =item --cover-from path/to/log.jsonl =item --cover-from http://example.com/coverage =item --cover-from path/to/coverage.jsonl =item --no-cover-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will not be run if the file/url is invalid. =item --cover-from-type json =item --cover-from-type jsonl =item --cover-from-type log =item --no-cover-from-type File type for coverage source. Usually it can be detected, but when it cannot be you should specify. "json" is old style single-blob coverage data, "jsonl" is the new by-test style, "log" is a logfile from a previous run. =item --cover-manager My::Coverage::Manager =item --no-cover-manager Coverage 'from' manager to use when coverage data does not provide one =item --cover-maybe-from path/to/log.jsonl =item --cover-maybe-from http://example.com/coverage =item --cover-maybe-from path/to/coverage.jsonl =item --no-cover-maybe-from This can be a test log, a coverage dump (old style json or new jsonl format), or a url to any of the previous. Tests will continue even if the coverage file/url is invalid. =item --cover-maybe-from-type json =item --cover-maybe-from-type jsonl =item --cover-maybe-from-type log =item --no-cover-maybe-from-type Same as "from_type" but for "maybe_from". Defaults to "from_type" if that is specified, otherwise auto-detect =item --cover-metrics =item --no-cover-metrics =item --cover-types ARG =item --cover-types=ARG =item --cover-type ARG =item --cover-type=ARG =item --no-cover-types NO DESCRIPTION - FIX ME Can be specified multiple times =item --cover-write =item --cover-write=coverage.jsonl =item --cover-write=coverage.json =item --no-cover-write Create a json or jsonl file of all coverage data seen during the run (This implies --cover-files). =back =head3 Git Options =over 4 =item --git-change-base master =item --git-change-base HEAD^ =item --git-change-base df22abe4 =item --no-git-change-base Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base. =back =head3 Help and Debugging =over 4 =item --dummy =item -d =item --no-dummy Dummy run, do not actually execute anything Can also be set with the following environment variables: C<T2_HARNESS_DUMMY> =item --help =item -h =item --no-help exit after showing help information =item --interactive =item -i =item --no-interactive Use interactive mode, 1 test at a time, stdin forwarded to it =item --keep-dirs =item --keep_dir =item -k =item --no-keep-dirs Do not delete directories when done. This is useful if you want to inspect the directories used for various commands. =item --procname-prefix ARG =item --procname-prefix=ARG =item --no-procname-prefix Add a prefix to all proc names (as seen by ps). =back =head3 YathUI Options =over 4 =item --yathui-api-key ARG =item --yathui-api-key=ARG =item --no-yathui-api-key Yath-UI API key. This is not necessary if your Yath-UI instance is set to single-user =item --yathui-grace =item --no-yathui-grace If yath cannot connect to yath-ui it normally throws an error, use this to make it fail gracefully. You get a warning, but things keep going. =item --yathui-long-duration 10 =item --no-yathui-long-duration Minimum duration length (seconds) before a test goes from MEDIUM to LONG =item --yathui-medium-duration 5 =item --no-yathui-medium-duration Minimum duration length (seconds) before a test goes from SHORT to MEDIUM =item --yathui-mode summary =item --yathui-mode qvf =item --yathui-mode qvfd =item --yathui-mode complete =item --no-yathui-mode Set the upload mode (default 'qvfd') =item --yathui-project ARG =item --yathui-project=ARG =item --no-yathui-project The Yath-UI project for your test results =item --yathui-retry =item --no-yathui-retry How many times to try an operation before giving up Can be specified multiple times =item --yathui-url http://my-yath-ui.com/... =item --uri http://my-yath-ui.com/... =item --no-yathui-url Yath-UI url =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2026 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������Collector.pm����������������������������������������������������������������������������������������100644��001750��001750�� 4447�15267772575� 23123� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Collector; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Options; option_group {prefix => 'collector', category => "Collector Options"} => sub { option max_open_jobs => ( type => 's', description => 'Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value)', long_examples => [' 18'], short_examples => [' 18'], ); option max_poll_events => ( type => 's', description => 'Maximum number of events to poll from a job before jumping to the next job. (Default: 1000)', default => 1000, long_examples => [' 1000'], short_examples => [' 1000'], ); post \&collector_post; }; sub collector_post { my %params = @_; my $settings = $params{settings}; unless ($settings->collector->max_open_jobs) { my $j = $settings->runner->job_count // 1; my $max_open = 2 * $j; $settings->collector->field(max_open_jobs => $max_open); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Collector - collector options for Yath. =head1 DESCRIPTION This is where the command line options for the collector are defined. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Collector Options =over 4 =item --max-open-jobs 18 =item --no-max-open-jobs Maximum number of jobs a collector can process at a time, if more jobs are pending their output will be delayed until the earlier jobs have been processed. (Default: double the -j value) =item --max-poll-events 1000 =item --no-max-poll-events Maximum number of events to poll from a job before jumping to the next job. (Default: 1000) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Workspace.pm����������������������������������������������������������������������������������������100644��001750��001750�� 6572�15267772575� 23134� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::Workspace; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use File::Path qw/remove_tree/; use File::Temp qw/tempdir/; use Test2::Harness::Util qw/clean_path chmod_tmp/; use App::Yath::Options; option_group {prefix => 'workspace', category => "Workspace Options"} => sub { option tmp_dir => ( type => 's', short => 't', alt => ['tmpdir'], description => 'Use a specific temp directory (Default: use system temp dir)', env_vars => [qw/T2_HARNESS_TEMP_DIR YATH_TEMP_DIR TMPDIR TEMPDIR TMP_DIR TEMP_DIR/], default => sub { File::Spec->tmpdir }, ); option workdir => ( type => 's', short => 'w', description => 'Set the work directory (Default: new temp directory)', env_vars => [qw/T2_WORKDIR YATH_WORKDIR/], clear_env_vars => 1, normalize => \&clean_path, ); option clear => ( short => 'C', description => 'Clear the work directory if it is not already empty', ); post sub { my %params = @_; my $settings = $params{settings}; if (my $workdir = $settings->workspace->workdir) { if (-d $workdir) { remove_tree($workdir, {safe => 1, keep_root => 1}) if $settings->workspace->clear; } else { mkdir($workdir) or die "Could not create workdir: $!"; chmod_tmp($workdir); } return; } my $project = $settings->harness->project; my $template = join '-' => ( "yath", $$, "XXXXXX"); my $tmpdir = tempdir( $template, DIR => $settings->workspace->tmp_dir, CLEANUP => !($settings->debug->keep_dirs || $params{command}->always_keep_dir), ); chmod_tmp($tmpdir); $settings->workspace->field(workdir => $tmpdir); }; }; 1; =pod =encoding UTF-8 =head1 NAME App::Yath::Options::Workspace - Options for specifying the yath work dir. =head1 DESCRIPTION Options regarding the yath working directory. =head1 PROVIDED OPTIONS =head2 COMMAND OPTIONS =head3 Workspace Options =over 4 =item --clear =item -C =item --no-clear Clear the work directory if it is not already empty =item --tmp-dir ARG =item --tmp-dir=ARG =item --tmpdir ARG =item --tmpdir=ARG =item -t ARG =item -t=ARG =item --no-tmp-dir Use a specific temp directory (Default: use system temp dir) Can also be set with the following environment variables: C<T2_HARNESS_TEMP_DIR>, C<YATH_TEMP_DIR>, C<TMPDIR>, C<TEMPDIR>, C<TMP_DIR>, C<TEMP_DIR> =item --workdir ARG =item --workdir=ARG =item -w ARG =item -w=ARG =item --no-workdir Set the work directory (Default: new temp directory) Can also be set with the following environment variables: C<T2_WORKDIR>, C<YATH_WORKDIR> =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������Spawn.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 2713�15267772575� 23054� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Spawn; use strict; use warnings; our $VERSION = '1.000182'; use parent 'Test2::Harness::Runner::Job'; use Test2::Harness::Util::HashBase; sub init { my $self = shift; $self->{+RUN} //= Test2::Harness::Runner::Spawn::Run->new(); } sub out_file { sprintf('/proc/%i/fd/1', $_[0]->{+TASK}->{owner}) } sub err_file { sprintf('/proc/%i/fd/2', $_[0]->{+TASK}->{owner}) } sub in_file { undef } sub args { @{$_[0]->{+TASK}->{args} //= []} } sub job_dir { "" } sub run_dir { "" } sub use_stream { 0 } sub event_uuids { 0 } sub mem_usage { 0 } sub io_events { 0 } # These return lists sub load_import { } sub load { } package Test2::Harness::Runner::Spawn::Run; sub new { bless {}, shift }; sub env_vars { {} } sub AUTOLOAD { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Spawn - Minimal job class used for spawning processes =head1 DESCRIPTION Do not use this directly... =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������State.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 57343�15267772575� 23075� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::State; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use File::Spec; use Time::HiRes qw/time/; use List::Util qw/first/; use Test2::Harness::Util qw/mod2file/; use Test2::Harness::Settings; use Test2::Harness::Runner::Constants; use Test2::Harness::Runner::Run; use Test2::Harness::Util::Queue; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::HashBase( # These are construction arguments qw{ <eager_stages <workdir <preloader <no_poll <resources job_count +settings }, qw{ <dispatch_file <queue_ended <pending_tasks <task_lookup <pending_runs +run <stopped_runs <pending_spawns <running <running_categories <running_durations <running_conflicts <running_shares <running_tasks <stage_readiness <task_list <halted_runs <reload_state <observe <last_job_activity <total_started }, ); sub init { my $self = shift; croak "You must specify a workdir" unless defined $self->{+WORKDIR}; $self->{+JOB_COUNT} //= $self->settings->runner->job_count // 1; if (!$self->{+RESOURCES} || !@{$self->{+RESOURCES}}) { my $settings = $self->settings; my $resources = $self->{+RESOURCES} //= []; for my $res (@{$self->settings->runner->resources}) { require(mod2file($res)); push @$resources => $res->new(settings => $self->settings, observe => $self->{+OBSERVE}); } } unless (grep { $_->job_limiter } @{$self->{+RESOURCES}}) { require Test2::Harness::Runner::Resource::JobCount; push @{$self->{+RESOURCES}} => Test2::Harness::Runner::Resource::JobCount->new(job_count => $self->{+JOB_COUNT}, settings => $self->settings); } @{$self->{+RESOURCES}} = sort { $a->sort_weight <=> $b->sort_weight } @{$self->{+RESOURCES}}; $self->{+DISPATCH_FILE} = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($self->{+WORKDIR}, 'dispatch.jsonl')); $self->{+RELOAD_STATE} //= {}; $self->poll; } sub settings { my $self = shift; return $self->{+SETTINGS} //= Test2::Harness::Settings->new(File::Spec->catfile($self->{+WORKDIR}, 'settings.json')); } sub run { my $self = shift; return $self->{+RUN} if $self->{+RUN}; $self->poll(); return $self->{+RUN}; } sub done { my $self = shift; $self->poll(); return 0 if $self->{+RUNNING}; return 0 if keys %{$self->{+PENDING_TASKS} //= {}}; return 0 if $self->{+RUN}; return 0 if @{$self->{+PENDING_RUNS} //= []}; return 0 unless $self->{+QUEUE_ENDED}; return 1; } sub resource_timeout { my $self = shift; my ($timeout) = @_; return 0 unless $timeout; # Must have started at least one test already return 0 unless $self->{+TOTAL_STARTED}; # Must have no tests currently running return 0 if $self->{+RUNNING}; # Must still have pending tasks return 0 unless keys %{$self->{+PENDING_TASKS} //= {}}; my $idle = time - ($self->{+LAST_JOB_ACTIVITY} // time); return 0 unless $idle >= $timeout; return $idle; } sub next_task { my $self = shift; my ($stage) = @_; $self->poll(); $self->clear_finished_run(); while(1) { if (@{$self->{+PENDING_SPAWNS} //= []}) { my $spawn = shift @{$self->{+PENDING_SPAWNS}}; next unless $spawn->{stage} eq $stage; $self->start_spawn($spawn); return $spawn; } my $task = shift @{$self->{+TASK_LIST}} or return undef; # If we are replaying a state then the task may have already completed, # so skip it if it is not in the running lookup. next unless $self->{+RUNNING_TASKS}->{$task->{job_id}}; next unless $task->{stage} eq $stage; return $task; } } sub advance { my $self = shift; $self->poll(); $_->tick() for @{$self->{+RESOURCES} //= []}; $self->advance_run(); return 0 unless $self->{+RUN}; return 1 if $self->advance_tasks(); return $self->clear_finished_run(); } my %ACTIONS = ( queue_run => '_queue_run', queue_task => '_queue_task', queue_spawn => '_queue_spawn', start_spawn => '_start_spawn', start_run => '_start_run', start_task => '_start_task', stop_run => '_stop_run', stop_task => '_stop_task', retry_task => '_retry_task', stage_ready => '_stage_ready', stage_down => '_stage_down', end_queue => '_end_queue', halt_run => '_halt_run', truncate => '_truncate', reload => '_reload', ); sub poll { my $self = shift; return if $self->{+NO_POLL}; my $queue = $self->dispatch_file; for my $item ($queue->poll) { my $data = $item->[-1]; my $item = $data->{item}; my $action = $data->{action}; my $pid = $data->{pid}; my $sub = $ACTIONS{$action} or die "Invalid action '$action'"; $self->$sub($item, $pid); } } sub _enqueue { my $self = shift; my ($action, $item) = @_; $self->{+DISPATCH_FILE}->enqueue({action => $action, item => $item, stamp => time, pid => $$}); $self->poll; } sub truncate { my $self = shift; $self->halt_run($_) for keys %{$self->{+PENDING_TASKS} // {}}; $self->_enqueue(truncate => $$); $self->poll; } sub _truncate { } sub end_queue { $_[0]->_enqueue('end_queue' => 1) } sub _end_queue { $_[0]->{+QUEUE_ENDED} = 1 } sub halt_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(halt_run => $run_id); my $dir = File::Spec->catdir($self->{+WORKDIR}, $run_id); my $file = File::Spec->catfile($dir, 'jobs.jsonl'); if (-f $file) { my $queue = Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'jobs.jsonl')); $queue->end; } } sub _halt_run { my $self = shift; my ($run_id) = @_; delete $self->{+PENDING_TASKS}->{$run_id}; $self->{+HALTED_RUNS}->{$run_id}++; } sub queue_run { my $self = shift; my ($run) = @_; $self->_enqueue(queue_run => $run); } sub _queue_run { my $self = shift; my ($run) = @_; push @{$self->{+PENDING_RUNS}} => Test2::Harness::Runner::Run->new( %$run, workdir => $self->{+WORKDIR}, ); return; } sub start_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(start_run => $run_id); } sub _start_run { my $self = shift; my ($run_id) = @_; my $run = shift @{$self->{+PENDING_RUNS}}; die "$0 - Run stack mismatch, run start requested, but no pending runs to start" unless $run; die "$0 - Run stack mismatch, run-id does not match next pending run" unless $run->run_id eq $run_id; $self->{+RUN} = $run; return; } sub stop_run { my $self = shift; my ($run_id) = @_; $self->_enqueue(stop_run => $run_id); } sub _stop_run { my $self = shift; my ($run_id) = @_; $self->{+STOPPED_RUNS}->{$run_id} = 1; return; } sub queue_spawn { my $self = shift; my ($spawn) = @_; $spawn->{spawn} //= 1; $spawn->{id} //= gen_uuid(); $self->_enqueue(queue_spawn => $spawn); } sub _queue_spawn { my $self = shift; my ($spawn) = @_; $spawn->{id} //= gen_uuid(); $spawn->{spawn} //= 1; $spawn->{use_preload} //= 1; $spawn->{stage} //= 'default'; $spawn->{stage} = $self->task_stage($spawn); push @{$self->{+PENDING_SPAWNS}} => $spawn; return; } sub start_spawn { my $self = shift; my ($spec) = @_; $self->_enqueue(start_spawn => $spec); } sub _start_spawn { my $self = shift; my ($spec) = @_; my $uuid = $spec->{id} or die "Could not find UUID for spawn"; @{$self->{+PENDING_SPAWNS}} = grep { $_->{id} ne $uuid } @{$self->{+PENDING_SPAWNS}}; return; } sub queue_task { my $self = shift; my ($task) = @_; $self->_enqueue(queue_task => $task); } sub _queue_task { my $self = shift; my ($task) = @_; my $job_id = $task->{job_id} or die "Task missing job_id"; my $run_id = $task->{run_id} or die "Task missing run_id"; die "Task already in queue" if $self->{+TASK_LOOKUP}->{$job_id}; return if $self->{+HALTED_RUNS}->{$run_id}; $self->{+TASK_LOOKUP}->{$job_id} = $task; my $pending = $self->task_pending_lookup($task); push @{$pending} => $task; return; } sub start_task { my $self = shift; my ($spec) = @_; $self->_enqueue(start_task => $spec); } sub _start_task { my $self = shift; my ($spec) = @_; my $job_id = $spec->{job_id} or die "No job_id provided"; my $run_stage = $spec->{stage} or die "No stage provided"; my $res = $spec->{res} or die "No res provided"; my $res_skip = $spec->{resource_skip}; my $task = $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to start"; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); my $set = $self->{+PENDING_TASKS}->{$run_id}->{$smoke}->{$stage}->{$cat}->{$dur}; my $count = @$set; @$set = grep { $_->{job_id} ne $job_id } @$set; die "Task $job_id was not pending ($count -> " . scalar(@$set) . ")" unless $count > @$set; $self->prune_hash($self->{+PENDING_TASKS}, $run_id, $smoke, $stage, $cat, $dur); # Set the stage, new task hashref $task = {%$task, stage => $run_stage} unless $task->{stage} && $task->{stage} eq $run_stage; $task->{env_vars}->{$_} = $res->{env_vars}->{$_} for keys %{$res->{env_vars}}; push @{$task->{test_args}} => @{$res->{args}}; for my $resource (@{$self->{+RESOURCES}}) { my $class = ref($resource); my $val = $res->{record}->{$class} // next; $resource->record($task->{job_id}, $val); } die "Already running task $job_id" if $self->{+RUNNING_TASKS}->{$job_id}; $self->{+RUNNING_TASKS}->{$job_id} = $task; $task->{resource_skip} = $res_skip if $res_skip; push @{$self->{+TASK_LIST}} => $task; $self->{+LAST_JOB_ACTIVITY} = time; $self->{+TOTAL_STARTED}++; $self->{+RUNNING}++; $self->{+RUNNING_CATEGORIES}->{$cat}++; $self->{+RUNNING_DURATIONS}->{$dur}++; my ($cfls, $shrs) = $self->task_locks($task); for my $cfl (@$cfls) { die "Unexpected shared use of '$cfl' ($self->{+RUNNING_SHARES}->{$cfl}) running at this time!" if $self->{+RUNNING_SHARES}->{$cfl}; die "Unexpected parallel conflict '$cfl' ($self->{+RUNNING_CONFLICTS}->{$cfl}) running at this time!" if $self->{+RUNNING_CONFLICTS}->{$cfl}++; } for my $shr (@$shrs) { die "Unexpected exclusive conflict '$shr' running at this time!" if $self->{+RUNNING_CONFLICTS}->{$shr}; $self->{+RUNNING_SHARES}->{$shr}++; } return; } sub stop_task { my $self = shift; my ($job_id) = @_; $self->_enqueue(stop_task => $job_id); } sub _stop_task { my $self = shift; my ($job_id) = @_; my $task = delete $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to stop ($job_id)"; delete $self->{+RUNNING_TASKS}->{$job_id} or die "Task is not running, cannot stop it ($job_id)"; $_->release($job_id) for @{$self->{+RESOURCES}}; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); $self->{+LAST_JOB_ACTIVITY} = time; $self->{+RUNNING}--; $self->{+RUNNING_CATEGORIES}->{$cat}--; $self->{+RUNNING_DURATIONS}->{$dur}--; my ($cfls, $shrs) = $self->task_locks($task); $self->{+RUNNING_CONFLICTS}->{$_}-- for @$cfls; $self->{+RUNNING_SHARES}->{$_}-- for @$shrs; return; } sub retry_task { my $self = shift; my ($job_id) = @_; $self->_enqueue(retry_task => $job_id); } sub _retry_task { my $self = shift; my ($job_id) = @_; my $task = $self->{+TASK_LOOKUP}->{$job_id} or die "Could not find task to retry"; $self->_stop_task($job_id); return if $self->{+HALTED_RUNS}->{$task->{run_id}}; $task = {is_try => 0, %$task}; $task->{is_try}++; $task->{category} = 'isolation' if $self->{+RUN}->retry_isolated; $self->_queue_task($task); return; } sub stage_ready { my $self = shift; my ($stage) = @_; $self->_enqueue(stage_ready => $stage); } sub _stage_ready { my $self = shift; my ($stage, $pid) = @_; $self->{+STAGE_READINESS}->{$stage} = $pid // 1; return; } sub stage_down { my $self = shift; my ($stage) = @_; $self->_enqueue(stage_down => $stage); } sub _stage_down { my $self = shift; my ($stage) = @_; $self->{+STAGE_READINESS}->{$stage} = 0; return; } sub reload { my $self = shift; my ($stage, $data) = @_; $stage //= 'default'; $self->_enqueue(reload => {%$data, stage => $stage}); return; } sub _reload { my $self = shift; my ($data) = @_; my $stage = $data->{stage}; my $file = $data->{file}; my $success = $data->{reloaded}; my $error = $data->{error}; my $warnings = $data->{warnings}; my $reload_state = $self->{+RELOAD_STATE} //= {}; my $stage_state = $reload_state->{$stage} //= {}; # It either succeeded, or the stage will be reloaded, no need to track brokenness if (defined $success) { delete $stage_state->{$file}; } else { my $fields = {}; $fields->{error} = $error if defined($error) && length($error); $fields->{warnings} = $warnings if $warnings && @{$warnings}; if (keys %$fields) { $stage_state->{$file} = $fields; } else { delete $stage_state->{$file}; } } return; } sub task_stage { my $self = shift; my ($task) = @_; my $wants = $task->{stage}; $wants //= 'NOPRELOAD' unless $task->{use_preload}; return $wants if $self->{+NO_POLL}; return $wants // 'DEFAULT' unless $self->preloader; return $self->preloader->task_stage($task->{file}, $wants); } sub task_locks { my $self = shift; my ($task) = @_; my $conflicts = $task->{conflicts} //= []; my $shares = $task->{shares} //= []; # An exclusive claim on a name gazumps a shared one, so a task holding both # must not be counted as waiting on itself. The scanner already drops # these, but tasks can also be queued by hand, where the scanner will not # have been able to fix it up. my %exclusive = map { ($_ => 1) } @$conflicts; return ($conflicts, [grep { !$exclusive{$_} } @$shares]); } sub task_pending_lookup { my $self = shift; my ($task) = @_; my ($run_id, $smoke, $stage, $cat, $dur) = $self->task_fields($task); return $self->{+PENDING_TASKS}->{$run_id}->{$smoke}->{$stage}->{$cat}->{$dur} //= []; } sub task_fields { my $self = shift; my ($task) = @_; my $run_id = $task->{run_id} or die "No run id provided by task"; my $smoke = $task->{smoke} ? 'smoke' : 'main'; my $stage = $self->task_stage($task); my $cat = $task->{category}; my $dur = $task->{duration}; die "Invalid category: $cat" unless CATEGORIES->{$cat}; die "Invalid duration: $dur" unless DURATIONS->{$dur}; $cat = 'conflicts' if $cat eq 'general' && $task->{conflicts} && @{$task->{conflicts}}; # Note that "shares" deliberately does NOT promote a task into the # "conflicts" bucket. That bucket is searched ahead of "general", which is # what lets an exclusive task claim a name before a shared one takes it, # which would makes the exclusive task wait. return ($run_id, $smoke, $stage, $cat, $dur); } sub prune_hash { my $self = shift; my ($hash, @path) = @_; die "No path!" unless @path; my $key = shift @path; if (@path) { my $empty = $self->prune_hash($hash->{$key}, @path); return 0 unless $empty; } return 1 unless exists $hash->{$key}; my $ref = ref($hash->{$key}); if ($ref eq 'HASH') { return 0 if keys %{$hash->{$key}}; } elsif ($ref eq 'ARRAY') { return 0 if @{$hash->{$key}}; } delete $hash->{$key}; return 1; } sub advance_run { my $self = shift; return 0 if $self->{+RUN}; return 0 unless @{$self->{+PENDING_RUNS} //= []}; $self->start_run($self->{+PENDING_RUNS}->[0]->run_id); return 1; } sub clear_finished_run { my $self = shift; my $run = $self->{+RUN} or return 0; return 0 unless $self->{+STOPPED_RUNS}->{$run->run_id}; return 0 if $self->{+PENDING_TASKS}->{$run->run_id}; return 0 if $self->{+RUNNING}; delete $self->{+RUN}; return 1; } sub advance_tasks { my $self = shift; for my $resource (@{$self->{+RESOURCES}}) { $resource->refresh(); next unless $resource->job_limiter; return 0 if $resource->job_limiter_at_max(); } my ($run_stage, $task, $res, %params) = $self->_next(); my $out = 0; if ($task) { $out = 1; $self->start_task({job_id => $task->{job_id}, stage => $run_stage, res => $res, %params}); } $_->discharge() for @{$self->{+RESOURCES}}; return $out; } sub _cat_order { my $self = shift; my @cat_order = ('conflicts', 'general'); # Only search immiscible if we have no immiscible running # put them first if no others are running so we can churn through them # early instead of waiting for them to run 1 at a time at the end. unshift @cat_order => 'immiscible' unless $self->{+RUNNING_CATEGORIES}->{immiscible}; # Only search isolation if nothing is running. push @cat_order => 'isolation' unless $self->{+RUNNING}; return \@cat_order; } sub _dur_order { my $self = shift; my $max = 0; for my $resource (@{$self->resources}) { next unless $resource->job_limiter; my $val = $resource->job_limiter_max; $max = $val if !$max || $val < $max; } $max //= 1; my $maxm1 = $max - 1; my $durs = $self->{+RUNNING_DURATIONS}; # 'short' is always ok. my @dur_order = ('short'); # long and medium should be on the front of the search unless we are # already running (max - 1) tests of the duration We want long first if # we are not saturation on them, followed by medium, whcih is why they # are listed in this order. for my $c (qw/medium long/) { if ($durs->{$c} && $durs->{$c} >= $maxm1) { push @dur_order => $c; # Back of the list } else { unshift @dur_order => $c; # Front of the list } } return \@dur_order; } # This returns a list of [STAGE => RUN_STAGE] pairs. 'STAGE' is the stage in # which we search for tasks, 'RUN_STAGE' is the stage that actually does the # work. This is what allows us to find tasks for 'eager' stages that are bored. sub _stage_order { my $self = shift; my $stage_check = $self->{+STAGE_READINESS} //= {}; my @stage_list = sort grep { $stage_check->{$_} } keys %$stage_check; # Populate list with all ready stages my %seen; my @stages = map {[$_ => $_]} grep { !$seen{$_}++ } @stage_list; # Add in any eager stages, but make sure they are last. for my $rstage (@stage_list) { next unless exists $self->{+EAGER_STAGES}->{$rstage}; push @stages => map {[$_ => $rstage]} grep { !$seen{$_}++ } @{$self->{+EAGER_STAGES}->{$rstage}}; } return \@stages; } my %SORTED; sub _next { my $self = shift; my $run = $self->{+RUN} or return; my $run_id = $run->run_id; my $pending = $self->{+PENDING_TASKS}->{$run_id} or return; my $conflicts = $self->{+RUNNING_CONFLICTS}; my $shares = $self->{+RUNNING_SHARES}; my $cat_order = $self->_cat_order; my $dur_order = $self->_dur_order; my $stages = $self->_stage_order(); my $resources = $self->{+RESOURCES}; # Ugly.... my $search = $pending; for my $smoke (qw/smoke main/) { my $search = $search->{$smoke} or next; for my $stage_set (@$stages) { my ($lstage, $run_by_stage) = @$stage_set; my $search = $search->{$lstage} or next; for my $lcat (@$cat_order) { my $search = $search->{$lcat} or next; for my $ldur (@$dur_order) { my $search = $search->{$ldur} or next; # Make sure anything with conflicts runs early, then # anything with shares, which an exclusive task may be # waiting on. unless ($SORTED{$search}++) { @$search = sort { scalar(@{$b->{conflicts} // []}) <=> scalar(@{$a->{conflicts} // []}) || scalar(@{$b->{shares} // []}) <=> scalar(@{$a->{shares} // []}) } @$search; } for my $task (@$search) { # An exclusive claim on a name cannot be made while any # other job holds that name, exclusively or shared. next if first { $conflicts->{$_} || $shares->{$_} } @{$task->{conflicts} // []}; # A shared claim only has to wait out an exclusive holder. next if first { $conflicts->{$_} } @{$task->{shares} // []}; my $ok = 1; my @resource_skip; for my $resource (@$resources) { my $out = $resource->available($task) || 0; # normalize false to 0 push @resource_skip => ref($resource) || $resource if $out < 0; $ok &&= $out; # If we have a temporarily unavailable resource we # skip, but if any resource is never avilable # (skip) we want to finish the loop to add them all # for the skip message. last if !$ok && !@resource_skip; } # Some resource is temporarily not available next unless $ok; my $outres = {args => [], env_vars => {}, record => {}}; my @out = ($run_by_stage => $task, $outres); my @record = @$resources; if (@resource_skip) { push @out => (resource_skip => \@resource_skip); # Only the job limiter resources need to be recorded. @record = grep { $_->job_limiter } @record; } for my $resource (@record) { my $res = {args => [], env_vars => {}}; $resource->assign($task, $res); push @{$outres->{args}} => @{$res->{args}}; $outres->{env_vars}->{$_} = $res->{env_vars}->{$_} for keys %{$res->{env_vars}}; $outres->{record}->{ref($resource)} = $res->{record}; } return @out; } } } } } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::State - State tracking for the runner. =head1 DESCRIPTION This module tracks the state for all running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Report.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 24275�15267772575� 23074� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Stall�������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Stall::Report; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use File::Spec(); use Test2::Harness::Util qw/clean_path write_file_atomic/; use Test2::Harness::Util::JSON qw/encode_json/; use Test2::Harness::Util::HashBase qw{ <workdir <run_id <report_dir }; use constant BEGIN_MARKER => '--- YATH STALL REPORT BEGIN ---'; use constant END_MARKER => '--- YATH STALL REPORT END ---'; sub init { my $self = shift; croak "You must specify a workdir" unless defined $self->{+WORKDIR}; # Where yath was run from. Not the workdir: for a plain 'yath test' that is # a File::Temp directory removed when the run ends, and this bundle is the # artifact the whole feature exists to produce. $self->{+REPORT_DIR} //= File::Spec->curdir; return; } # What the run state looked like, taken from the replay rather than from any # live harness object. sub state_summary { my $self = shift; my ($state, $tasks) = @_; my %out = ( running => $state->running // 0, total_started => $state->total_started // 0, queue_ended => $state->queue_ended ? 1 : 0, halted_runs => [sort keys %{$state->halted_runs // {}}], stages => $state->stage_readiness // {}, ); $out{running_tasks} = [map { {job_id => $_->{job_id}, file => $_->{rel_file} // $_->{file}} } values %{$state->running_tasks // {}}]; $out{pending_tasks} = [ map { { job_id => $_->{job_id}, file => $_->{rel_file} // $_->{file}, category => $_->{category}, duration => $_->{duration}, stage => $_->{stage}, conflicts => $_->{conflicts} // [], shares => $_->{shares} // [], } } @$tasks ]; return \%out; } sub headline { my $self = shift; my ($bundle) = @_; return sprintf( "yath: no test has started in %.0f seconds (%s threshold %s), with %d pending and %d running.", $bundle->{idle}, $bundle->{tier}, $bundle->{threshold}, $bundle->{pending}, $bundle->{running}, ); } sub render { my $self = shift; my ($bundle) = @_; my $out = "\n" . BEGIN_MARKER . "\n"; $out .= $self->headline($bundle) . "\n"; $out .= "This may be benign: the scheduler can also be waiting on something legitimate.\n"; $out .= "It never ends the run. Use --stall-report to change or disable this.\n\n"; my $state = $bundle->{state_summary} // {}; $out .= sprintf( "Pending: %d Running: %d Started so far: %d Queue ended: %s\n", scalar(@{$state->{pending_tasks} // []}), $state->{running} // 0, $state->{total_started} // 0, $state->{queue_ended} ? 'yes' : 'no', ); my $stages = $state->{stages} // {}; $out .= "Stages: " . join(', ', map { "$_=" . ($stages->{$_} ? $stages->{$_} : 'down') } sort keys %$stages) . "\n"; $out .= $self->task_lines('Running', $state->{running_tasks}); $out .= $self->task_lines('Pending', $state->{pending_tasks}); for my $sample (@{$bundle->{samples} // []}) { $out .= sprintf("\nSample %d:\n", $sample->{round}); for my $pid (sort { $a <=> $b } keys %{$sample->{procs} // {}}) { my $proc = $sample->{procs}->{$pid}; next if $proc->{gone}; $out .= sprintf( " pid %-7s %-18s state=%-22s wchan=%-24s syscall=%s\n", $pid, $proc->{name} // '?', $proc->{state} // '?', $proc->{wchan} // '?', defined($proc->{syscall}) ? $proc->{syscall} : 'unavailable (needs ptrace permission)', ); } } my $traces = $bundle->{traces} // {}; if (keys %$traces) { $out .= "\nStack traces:\n"; $out .= $traces->{$_} . "\n" for sort keys %$traces; } else { $out .= "\nNo stack traces were produced. A process that cannot run Perl -- one in an\n"; $out .= "uninterruptible syscall, or in XS that retries EINTR -- never runs the handler.\n"; } $out .= "\nFull details: " . $self->json_file($bundle->{round}) . "\n"; $out .= END_MARKER . "\n"; return $out; } # The tests themselves, since which ones are stuck waiting is usually the first # thing a reader wants. Bounded: a stalled run can have hundreds pending, and # the full list is in the JSON. sub task_lines { my $self = shift; my ($label, $tasks) = @_; $tasks //= []; return '' unless @$tasks; my $out = "\n$label (" . scalar(@$tasks) . "):\n"; my $shown = 0; for my $task (@$tasks) { last if $shown++ >= 20; my @extra; push @extra => $task->{category} if $task->{category} && $task->{category} ne 'general'; push @extra => 'conflicts: ' . join(',', @{$task->{conflicts}}) if @{$task->{conflicts} // []}; push @extra => 'shares: ' . join(',', @{$task->{shares}}) if @{$task->{shares} // []}; $out .= sprintf(" %s%s\n", $task->{file} // $task->{job_id} // '?', @extra ? ' [' . join('; ', @extra) . ']' : ''); } $out .= sprintf(" ... and %d more\n", scalar(@$tasks) - $shown) if @$tasks > $shown; return $out; } sub json_file { my $self = shift; my ($round) = @_; # The run id keeps bundles from different runs apart; the round keeps a # run's own reports from overwriting each other. my $name = join('-', 'yath-stall-report', $self->{+RUN_ID} // $$, $round // 1) . '.json'; return clean_path(File::Spec->catfile($self->{+REPORT_DIR}, $name)); } # The aux_logs name matters. The collector re-reads that directory on every # poll, picks up files created mid-run, and tags anything ending -STDERR.log as # debug output, so this reaches the yath UI with no new plumbing. error.log # cannot be used: it is the runner's redirected STDERR, opened without append, # so a second writer and the runner would overwrite each other. sub aux_file { my $self = shift; my $dir = File::Spec->catdir($self->{+WORKDIR}, 'aux_logs'); mkdir($dir); return File::Spec->catfile($dir, 'stall-STDERR.log'); } sub emit { my $self = shift; my ($bundle) = @_; my $text = $self->render($bundle); my $json = encode_json($bundle); # The terminal and the CI log get the readable form only. The bundle is # large and would drown the report it belongs to. print STDERR $text; if (open(my $fh, '>>', $self->aux_file)) { print $fh $text; # One physical line, so the collector turns the whole bundle into a # single info facet rather than one per line. encode_json escapes # embedded newlines, so this holds however long the bundle gets. It can # be pulled back out of that facet later. print $fh $json, "\n"; close($fh); } my $file = $self->json_file($bundle->{round}); my $ok = eval { write_file_atomic($file, $json . "\n"); 1 }; warn "Could not write stall report '$file': $@" unless $ok; return $text; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Stall::Report - Render and deliver a stall report. =head1 DESCRIPTION Turns a capture bundle into something a person and an analysis agent can both read, and puts it where both will find it. Reports go to two places. The main process's STDERR is never redirected by yath, so it reaches the CI log directly, even if the event pipeline is itself unhealthy. C<aux_logs/stall-STDERR.log> is picked up by L<Test2::Harness::Collector>, which re-reads that directory on every poll and tags anything ending C<-STDERR.log> as debug output, so it reaches the yath UI with no new plumbing. The runner's C<error.log> is deliberately not used: it is opened without append, so a second writer and the runner would overwrite each other. The full bundle is also written as JSON, twice. Once to the aux log as a single physical line, so it reaches the yath UI as one info facet and can be pulled back out later. Once to a file, outside the working directory, because for a plain C<yath test> that directory is temporary and is removed when the run ends; that copy goes to the directory yath was run from unless C<--stall-report-dir> says otherwise. The text report is a reduced view; open files, locks, the process tree and C<strace> output live only in the JSON. Begin and end markers let the text be extracted from a log by pattern. =head1 SYNOPSIS use Test2::Harness::Stall::Report; my $report = Test2::Harness::Stall::Report->new( workdir => $workdir, run_id => $run_id, ); $bundle->{state_summary} = $report->state_summary($state, $tasks); $report->emit($bundle); =head1 ATTRIBUTES =over 4 =item $string = $report->workdir() The run's working directory, used for the aux log. =item $string = $report->run_id() Names the JSON bundle, so bundles from different runs can sit together. =item $string = $report->report_dir() Where the JSON bundle is written. Defaults to the directory yath was run from. =back =head1 PUBLIC METHODS =over 4 =item $hashref = $report->state_summary($state, $tasks) What the run looked like, taken from the replay rather than any live harness object. =item $string = $report->render($bundle) The human-readable report, between begin and end markers. =item $string = $report->emit($bundle) Renders, writes to both channels and the JSON bundle, and returns the text. =item $string = $report->headline($bundle) One line saying what was observed. =item $string = $report->task_lines($label, $tasks) A bounded list of tests; the full list is in the JSON. =item $string = $report->json_file($round) Where the bundle for a given report is written. =item $string = $report->aux_file() The aux log the collector forwards. =back =head1 SOURCE The source code repository for Test2-Harness can be found at L<https://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<https://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������default.tx������������������������������������������������������������������������������������������100644��001750��001750�� 1025�15267772575� 23373� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; require App::Yath; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added lib, blib/lib, and blib/arch to the front of the line" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FAST.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 21�15267772575� 23006� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package FAST; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������exclusive.tx����������������������������������������������������������������������������������������100644��001750��001750�� 534�15267772575� 23421� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/shares����������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-CONFLICTS-DB # This one keeps a real duration on purpose. The assertions about it are # negative -- that nothing ran alongside it -- and a test that finishes # instantly would satisfy them without ever giving the scheduler a window in # which it could have got them wrong. sleep 1; ok(1, "pass"); sleep 1; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������test-durations.json���������������������������������������������������������������������������������100644��001750��001750�� 476�15267772575� 23435� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������{ "t/integration/test-durations/fast-01.tx": "SHORT", "t/integration/test-durations/fast-02.tx": "SHORT", "t/integration/test-durations/fast-03.tx": "SHORT", "t/integration/test-durations/fast-04.tx": "SHORT", "t/integration/test-durations/slow-01.tx": "LONG", "t/integration/test-durations/slow-02.tx": "LONG" }��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Git.script������������������������������������������������������������������������������������������100755��001750��001750�� 7422�15267772575� 23066� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/App/Yath/Plugin��������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env perl use strict; use warnings; my $args = join ' ' => @ARGV; my $afile = <<'EOT'; diff --git a/a.file b/a.file index a7175683..7646fa7b 100644 --- a/a.file +++ b/a.file @@ garbage @@ package A; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } +my @foo = ("X", "Y"); - sub sub3 { ... } -my @foo = ("X", "Y"); 1; EOT my $bfile = <<'EOT'; diff --git a/b.file b/b.file index a7175683..7646fa7b 100644 --- a/b.file +++ b/b.file @@ garbage @@ package B; +our $global = "yes"; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } 1; EOT my $cfile = <<'EOT'; diff --git a/c.file b/c.file index a7175683..7646fa7b 100644 --- a/c.file +++ b/c.file @@ garbage @@ package C; sub sub1 { - my ($self) = @_; + my $self = shift; ... } sub sub2 { ... } 1; EOT my %out = ( 'rev-parse HEAD' => [0, "4570988f2c2bd26a1691a82766d5bf5c7524bcea\n"], 'rev-parse --short HEAD' => [0, "4570988\n"], 'status -s' => [0, " M lib/App/Yath/Plugin/Git.pm\n"], 'rev-parse --abbrev-ref HEAD' => [0, "my.branch.foo\n"], 'merge-base --is-ancestor HEAD master' => [1, ""], 'diff HEAD --name-only' => [0, ""], 'diff -U1000000 -W --minimal HEAD' => [0, ""], 'merge-base --is-ancestor HEAD^ master' => [1, ""], 'diff HEAD^ --name-only' => [0, "a.file\n"], 'diff -U1000000 -W --minimal HEAD^' => [0, $afile], 'merge-base --is-ancestor HEAD^^ master' => [1, ""], 'diff HEAD^^ --name-only' => [0, "a.file\nb.file\n"], 'diff -U1000000 -W --minimal HEAD^^' => [0, $afile . $bfile], 'merge-base --is-ancestor HEAD^^^ master' => [0, ""], 'diff HEAD^^^ --name-only' => [0, "a.file\nb.file\nc.file\n"], 'diff -U1000000 -W --minimal HEAD^^^' => [0, $afile . $bfile . $cfile], ); if (my $res = $out{$args}) { my ($exit, $text) = @$res; print $text; exit $exit; } print STDERR "Invalid args: $args\n"; exit 1; __END__ diff --git a/lib/App/Yath/Plugin/Git.pm b/lib/App/Yath/Plugin/Git.pm index a7175683..7646fa7b 100644 --- a/lib/App/Yath/Plugin/Git.pm +++ b/lib/App/Yath/Plugin/Git.pm @@ -1,170 +1,218 @@ package App::Yath::Plugin::Git; use strict; use warnings; our $VERSION = '1.000045'; use IPC::Cmd qw/can_run/; use Test2::Harness::Util::IPC qw/run_cmd/; use parent 'App::Yath::Plugin'; use App::Yath::Options; option_group {prefix => 'git', category => "Git Options"} => sub { option change_base => ( type => 's', description => "Find files changed by all commits in the current branch from most recent stopping when a commit is found that is also present in the history of the branch/commit specified as the change base.", long_examples => [" master", " HEAD^", " df22abe4"], ); }; my $GIT_CMD = can_run('git'); sub git_cmd { $ENV{GIT_COMMAND} || $GIT_CMD } sub git_output { my $class = shift; my (@args) = @_; my $cmd = $class->git_cmd or return; my ($rh, $wh, $irh, $iwh); pipe($rh, $wh) or die "No pipe: $!"; pipe($irh, $iwh) or die "No pipe: $!"; my $pid = run_cmd(stderr => $iwh, stdout => $wh, command => [$cmd, @args]); - waitpid($pid, 0); - return if $?; close($wh); close($iwh); + + waitpid($pid, 0); + if($?) { + print STDERR <$irh>; + return; + } + close($irh); return <$rh>; } sub inject_run_data { my $class = shift; my %params = @_; my $meta = $params{meta}; my $fields = $params{fields}; my $long_sha = $ENV{GIT_LONG_SHA}; my $short_sha = $ENV{GIT_SHORT_SHA}; my $status = $ENV{GIT_STATUS}; my $branch = $ENV{GIT_BRANCH}; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Runner����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21737� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������Job.t�����������������������������������������������������������������������������������������������100644��001750��001750�� 17037�15267772575� 23026� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner���������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::Job'; # HARNESS-DURATION-SHORT # HARNESS-NO-PRELOAD use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Settings; my $tmp = tempdir(CLEANUP => 1); { package MockRunner; sub new { bless {}, shift } sub all_libs { () } } { package MockRun; sub new { bless {}, shift } sub run_dir { $tmp } sub run_id { 'mock-run' } sub test_args { undef } } sub make_settings { my (%overrides) = @_; my $settings = Test2::Harness::Settings->new(); $settings->define_prefix('debug'); $settings->debug->vivify_field('dummy'); $settings->debug->field(dummy => $overrides{dummy} // 0); $settings->define_prefix('runner'); for my $field (qw/fail_on_resource_skip nytprof/) { $settings->runner->vivify_field($field); } $settings->runner->field(fail_on_resource_skip => $overrides{fail_on_resource_skip} // 0); $settings->runner->field(nytprof => 0); return $settings; } sub make_job { my (%args) = @_; my $job_dir = File::Spec->catdir($tmp, "job_$$" . ++$main::JOB_COUNT); mkdir $job_dir; # Create required files in job_dir so open_file calls succeed for my $f (qw/stdout stderr/) { open my $fh, '>', File::Spec->catfile($job_dir, $f) or die $!; close $fh; } # Create stdin file open my $fh, '>', File::Spec->catfile($job_dir, 'stdin') or die $!; close $fh; my $settings = $args{settings} // make_settings(%{$args{settings_overrides} // {}}); my $task = $args{task} // { job_id => "job-$$-$main::JOB_COUNT", file => __FILE__, %{$args{task_overrides} // {}}, }; my $runner = $args{runner} // MockRunner->new; my $run = $args{run} // MockRun->new; my $job = $CLASS->new( task => $task, runner => $runner, run => $run, settings => $settings, ); # Pre-set job_dir so file operations work $job->{+Test2::Harness::Runner::Job::JOB_DIR()} = $job_dir; return $job; } # Create shared temp files for mock file handles my $devnull = File::Spec->catfile($tmp, 'devnull'); open my $dn, '>', $devnull or die $!; close $dn; # Mock methods on the Job class that spawn_params calls, so we don't # need to set up the full settings/runner/run chain. my $mock = mock $CLASS => ( override => [ cli_includes => sub { () }, switches => sub { () }, cli_options => sub { () }, args => sub { () }, ch_dir => sub { '' }, env_vars => sub { {} }, out_file => sub { $devnull }, err_file => sub { $devnull }, in_file => sub { $devnull }, ], ); subtest 'via returns undef for resource_skip' => sub { my $job = make_job( task_overrides => {resource_skip => ['SomeResource']}, settings_overrides => {dummy => 0}, ); is($job->via, undef, "via() returns undef when task has resource_skip"); }; subtest 'spawn_params with resource_skip (default: skip)' => sub { my $job = make_job( task_overrides => {resource_skip => ['Port', 'Database']}, settings_overrides => {fail_on_resource_skip => 0}, ); my $params = $job->spawn_params; my $command = $params->{command}; # Find the -e argument in the command array my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; ok(defined $e_idx, "Found -e flag in command"); my $script = $command->[$e_idx + 1]; like($script, qr/1\.\.0 # SKIP/, "Generates TAP skip output"); like($script, qr/Some resources are not available: Port, Database/, "Skip message lists unavailable resources"); unlike($script, qr/not ok/, "Does not contain a failure"); }; subtest 'spawn_params with resource_skip and --fail-on-resource-skip' => sub { my $job = make_job( task_overrides => {resource_skip => ['Port', 'Database']}, settings_overrides => {fail_on_resource_skip => 1}, ); my $params = $job->spawn_params; my $command = $params->{command}; my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; ok(defined $e_idx, "Found -e flag in command"); my $script = $command->[$e_idx + 1]; like($script, qr/1\.\.1/, "Generates TAP with 1 test planned"); like($script, qr/not ok 1/, "Generates a TAP failure"); like($script, qr/Some resources are not available: Port, Database/, "Failure message lists unavailable resources"); unlike($script, qr/# SKIP/, "Does not contain a skip directive"); }; subtest 'spawn_params with no resource_skip runs test normally' => sub { my $job = make_job( settings_overrides => {fail_on_resource_skip => 1}, ); my $params = $job->spawn_params; my $command = $params->{command}; # Should contain a coderef (the run_file callback), not -e my $has_coderef = grep { ref($_) eq 'CODE' } @$command; ok($has_coderef, "Command contains a CODE ref (run_file) when no resource_skip"); my $has_e = grep { !ref($_) && $_ eq '-e' } @$command; ok(!$has_e, "Command does not contain -e flag"); }; subtest 'spawn_params dummy mode still skips even with fail_on_resource_skip' => sub { my $job = make_job( settings_overrides => {dummy => 1, fail_on_resource_skip => 1}, ); my $params = $job->spawn_params; my $command = $params->{command}; my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; ok(defined $e_idx, "Found -e flag in command"); my $script = $command->[$e_idx + 1]; like($script, qr/1\.\.0 # SKIP dummy mode/, "Dummy mode produces a skip, not a failure"); unlike($script, qr/not ok/, "No failure for dummy mode"); }; subtest 'spawn_params resource_skip with single resource' => sub { my $job = make_job( task_overrides => {resource_skip => ['Port']}, settings_overrides => {fail_on_resource_skip => 1}, ); my $params = $job->spawn_params; my $command = $params->{command}; my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; ok(defined $e_idx, "Found -e flag in command"); my $script = $command->[$e_idx + 1]; like($script, qr/not ok 1 - Some resources are not available: Port/, "Failure message with single resource"); }; subtest 'TAP output is valid when executed' => sub { # Verify the generated -e scripts produce valid TAP when run subtest 'skip TAP' => sub { my $job = make_job( task_overrides => {resource_skip => ['Port']}, settings_overrides => {fail_on_resource_skip => 0}, ); my $params = $job->spawn_params; my $command = $params->{command}; my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; my $script = $command->[$e_idx + 1]; my $output = `$^X -e '$script'`; is($output, "1..0 # SKIP Some resources are not available: Port", "Skip TAP output is correct"); }; subtest 'fail TAP' => sub { my $job = make_job( task_overrides => {resource_skip => ['Port']}, settings_overrides => {fail_on_resource_skip => 1}, ); my $params = $job->spawn_params; my $command = $params->{command}; my ($e_idx) = grep { !ref($command->[$_]) && $command->[$_] eq '-e' } 0 .. $#$command; my $script = $command->[$e_idx + 1]; my $output = `$^X -e '$script'`; like($output, qr/^1\.\.1\nnot ok 1 - Some resources are not available: Port$/s, "Fail TAP output is correct"); }; }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������scripts���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22405� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/yath_script/nested����������������������������������������������������������������������������������������������������������������������������yath������������������������������������������������������������������������������������������������100644��001750��001750�� 0�15267772575� 23343� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/yath_script/nested/scripts��������������������������������������������������������������������������������������������������������������������PreCommand.pm���������������������������������������������������������������������������������������100644��001750��001750�� 15552�15267772575� 23241� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/App/Yath/Options����������������������������������������������������������������������������������������������������������������������������package App::Yath::Options::PreCommand; use strict; use warnings; our $VERSION = '1.000182'; use App::Yath::Util qw/find_pfile/; use Test2::Harness::Util qw/mod2file clean_path/; use App::Yath::Options; option_group {prefix => 'harness', pre_command => 1} => sub { option plugins => ( type => 'm', short => 'p', alt => ['plugin'], category => 'Plugins', long_examples => [' PLUGIN', ' +App::Yath::Plugin::PLUGIN', ' PLUGIN=arg1,arg2,...'], short_examples => ['PLUGIN'], description => 'Load a yath plugin.', action => \&plugin_action, ); option no_scan_plugins => ( type => 'b', category => 'Plugins', description => 'Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not.', ); option project => ( type => 's', alt => ['project-name'], category => 'Environment', description => 'This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner.', ); option persist_dir => ( type => 's', category => 'Environment', description => 'Where to find persistence files.', normalize => \&clean_path, ); option persist_file => ( type => 's', category => 'Environment', alt => ['pfile'], normalize => \&clean_path, description => "Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system.", ); option dev_libs => ( type => 'D', short => 'D', name => 'dev-lib', category => 'Developer', description => 'Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch.', long_examples => ['', '=lib'], short_examples => ['', '=lib', 'lib'], normalize => \&normalize_dev_libs, action => \&dev_libs_action, ); post \&post_process; }; sub plugin_action { my ($prefix, $field, $raw, $norm, $slot, $settings, $handler, $options) = @_; my ($class, $args) = split /=/, $norm, 2; $args = [split ',', $args] if $args; $class = "App::Yath::Plugin::$class" unless $class =~ s/^\+//; return if grep { $class eq (ref($_) || $_) } @{$settings->harness->plugins}; my $file = mod2file($class); require $file; $options->include_from($class) if $class->can('options'); my $plugin = $class->can('new') ? $class->new(@{$args // []}) : $class; $handler->($slot, $plugin); } sub normalize_dev_libs { my $val = shift; return $val if $val eq '1'; return clean_path($val); } sub dev_libs_action { my ($prefix, $field, $raw, $norm, $slot, $settings) = @_; my %seen = map { $_ => 1 } @{$$slot}; my @new = grep { !$seen{$_}++ } ($norm eq '1') ? (map { clean_path($_) } 'lib', 'blib/lib', 'blib/arch') : ($norm); return unless @new; warn <<" EOT" for @new; dev-lib '$_' added to \@INC late, it is possible some yath libraries were already loaded from other paths. (Maybe you need to move the -D or --dev-lib argument(s) to be earlier in your command line or config file?) EOT unshift @INC => @new; unshift @{$$slot} => @new; } sub post_process { my %params = @_; my $settings = $params{settings}; $settings->harness->field(persist_file => find_pfile($settings, vivify => 1, no_checks => 1)) unless defined $settings->harness->persist_file; } 1; __END__ =pod =encoding UTF-8 =head1 NAME App::Yath::Options::PreCommand - Options for yath before command is specified. =head1 DESCRIPTION This is where many pre-command options are defined. =head1 PROVIDED OPTIONS =head2 YATH OPTIONS (PRE-COMMAND) =head3 Developer =over 4 =item --dev-lib =item --dev-lib=lib =item -D =item -D=lib =item -Dlib =item --no-dev-lib Add paths to @INC before loading ANYTHING. This is what you use if you are developing yath or yath plugins to make sure the yath script finds the local code instead of the installed versions of the same code. You can provide an argument (-Dfoo) to provide a custom path, or you can just use -D without and arg to add lib, blib/lib and blib/arch. Can be specified multiple times =back =head3 Environment =over 4 =item --persist-dir ARG =item --persist-dir=ARG =item --no-persist-dir Where to find persistence files. =item --persist-file ARG =item --persist-file=ARG =item --pfile ARG =item --pfile=ARG =item --no-persist-file Where to find the persistence file. The default is /{system-tempdir}/project-yath-persist.json. If no project is specified then it will fall back to the current directory. If the current directory is not writable it will default to /tmp/yath-persist.json which limits you to one persistent runner on your system. =item --project ARG =item --project=ARG =item --project-name ARG =item --project-name=ARG =item --no-project This lets you provide a label for your current project/codebase. This is best used in a .yath.rc file. This is necessary for a persistent runner. =back =head3 Plugins =over 4 =item --no-scan-plugins =item --no-no-scan-plugins Normally yath scans for and loads all App::Yath::Plugin::* modules in order to bring in command-line options they may provide. This flag will disable that. This is useful if you have a naughty plugin that is loading other modules when it should not. =item --plugins PLUGIN =item --plugins +App::Yath::Plugin::PLUGIN =item --plugins PLUGIN=arg1,arg2,... =item --plugin PLUGIN =item --plugin +App::Yath::Plugin::PLUGIN =item --plugin PLUGIN=arg1,arg2,... =item -pPLUGIN =item --no-plugins Load a yath plugin. Can be specified multiple times =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������Capture.pm������������������������������������������������������������������������������������������100644��001750��001750�� 34432�15267772575� 23220� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Stall�������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Stall::Capture; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Config qw/%Config/; use File::Spec(); use Time::HiRes qw/sleep time/; use Test2::Harness::Util::HashBase qw{ <workdir <stall_dir <root_pid }; # Rounds of per-process sampling, and the gap between them. More than one # sample is what separates a process wedged on a single operation from one # looping without progress, which is the first question any analysis asks. use constant ROUNDS => 3; use constant ROUND_GAP => 2; use constant SIG_WAIT => 1; use constant MAX_FIELD => 8192; # The whole capture blocks the render loop. Nothing is being rendered during a # stall, but keep the bound small enough that a benign report is not felt. use constant SHELL_SECONDS => 1; sub init { my $self = shift; croak "You must specify a workdir" unless defined $self->{+WORKDIR}; $self->{+STALL_DIR} //= File::Spec->catdir($self->{+WORKDIR}, 'stall'); $self->{+ROOT_PID} //= $$; return; } sub have_proc { return ($^O eq 'linux' && -d '/proc') ? 1 : 0 } sub read_proc { my $self = shift; my ($pid, $what) = @_; my $path = File::Spec->catfile('/proc', $pid, $what); open(my $fh, '<', $path) or return; local $/; my $out = <$fh>; close($fh); # /proc/PID/syscall and friends are gated on ptrace permission. When it is # denied the open succeeds and the read comes back empty, so the read is # what has to be checked, not the open. return unless defined $out && length $out; $out =~ s/\0/ /g; $out =~ s/\s+\z//; return substr($out, 0, MAX_FIELD); } sub list_fds { my $self = shift; my ($pid) = @_; my $dir = File::Spec->catdir('/proc', $pid, 'fd'); opendir(my $dh, $dir) or return; my @fds = grep { m/^\d+$/ } readdir($dh); closedir($dh); my %out; for my $fd (sort { $a <=> $b } @fds) { my $target = readlink(File::Spec->catfile($dir, $fd)) // next; $out{$fd} = $target; } return \%out; } sub proc_snapshot { my $self = shift; my ($pid) = @_; my %out = (pid => $pid); unless ($self->have_proc) { # Not the same as gone: the process is alive, we simply cannot see it. $out{unavailable} = "no /proc on $^O"; return \%out; } my $status = $self->read_proc($pid, 'status'); unless (defined $status) { $out{gone} = 1; return \%out; } for my $field (qw/Name State PPid Threads SigBlk SigIgn SigCgt/) { next unless $status =~ m/^\Q$field\E:\s*(.*)$/m; $out{lc($field)} = $1; } $out{cmdline} = $self->read_proc($pid, 'cmdline'); $out{wchan} = $self->read_proc($pid, 'wchan'); $out{syscall} = $self->read_proc($pid, 'syscall'); $out{stack} = $self->read_proc($pid, 'stack'); $out{fds} = $self->list_fds($pid); return \%out; } # Every descendant of the runner, so a wedged process that is not on the # whitelist still appears in the report even though it is never signalled. sub all_pids { my $self = shift; opendir(my $dh, '/proc') or return; my @pids = grep { m/^\d+$/ } readdir($dh); closedir($dh); return \@pids; } sub process_tree { my $self = shift; my ($root) = @_; return unless $root && $self->have_proc; my $pids = $self->all_pids or return; my %parent; for my $pid (@$pids) { my $stat = $self->read_proc($pid, 'stat') or next; # comm can contain spaces and parens, so parse after the last ')'. my $tail = substr($stat, rindex($stat, ')') + 1); next unless $tail =~ m/^\s+\S+\s+(\d+)/; $parent{$pid} = $1; } my %keep = ($root => 1); my $added = 1; while ($added) { $added = 0; for my $pid (keys %parent) { next if $keep{$pid}; next unless $keep{$parent{$pid}}; $keep{$pid} = 1; $added++; } } return [sort { $a <=> $b } keys %keep]; } sub system_snapshot { my $self = shift; my %out; return \%out unless $self->have_proc; for my $file (qw/loadavg meminfo locks/) { open(my $fh, '<', "/proc/$file") or next; local $/; my $content = <$fh>; close($fh); next unless defined $content; # meminfo is long and only its head is ever useful here. if ($file eq 'meminfo') { my @lines = split /\n/, $content; $content = join("\n", @lines[0 .. ($#lines < 8 ? $#lines : 8)]); } $out{$file} = substr($content, 0, MAX_FIELD); } return \%out; } sub workdir_filesystem { my $self = shift; return unless $self->have_proc; my $seconds = SHELL_SECONDS; my $dir = $self->{+WORKDIR}; $dir =~ s/'/'\\''/g; # Bounded, and quoted: a hung mount is a plausible cause of the stall being # diagnosed, and an unbounded df against one would hang the render loop. my $out = `timeout $seconds df -PT '$dir' 2>/dev/null`; return unless defined $out && length $out; return substr($out, 0, MAX_FIELD); } sub strace { my $self = shift; my ($pid) = @_; # Usually denied. Yama checks the tracer against the target's ancestry and # strace is a freshly exec'd process, so it is never an ancestor of the # scheduler no matter who launches it. Kept because some CI containers run # with ptrace_scope=0 or CAP_SYS_PTRACE; /proc/PID/syscall and wchan answer # the same question when it is not available. my $seconds = SHELL_SECONDS; my $out = `timeout $seconds strace -qq -p $pid -e trace=all 2>&1`; return unless defined $out && length $out; return substr($out, 0, MAX_FIELD); } sub read_traces { my $self = shift; my $dir = $self->{+STALL_DIR}; opendir(my $dh, $dir) or return {}; my @files = grep { m/^stack-\d+-\d+\.txt$/ } readdir($dh); closedir($dh); my %out; for my $file (@files) { my $path = File::Spec->catfile($dir, $file); open(my $fh, '<', $path) or next; local $/; my $content = <$fh>; close($fh); next unless defined $content; $out{$file} = substr($content, 0, MAX_FIELD); # Consume them, so the next report shows only its own traces. Filtering # by round number instead would need every process to have been # signalled in every round, which a stage that comes up late has not. unlink($path); } return \%out; } # Bit for a signal number in the SigCgt / SigIgn masks of /proc/PID/status. sub _sig_bit { return 1 << ($_[1] - 1) } # Not a constant: SIGUSR1 is 10 on x86 but 16 on MIPS and 30 on SPARC, and # have_proc only narrows this to Linux. my $USR1; sub usr1_number { return $USR1 //= do { my @names = split ' ', $Config{sig_name}; my @nums = split ' ', $Config{sig_num}; my %map; @map{@names} = @nums; $map{USR1} // 10; }; } sub catches_usr1 { my $self = shift; my ($proc) = @_; my $mask = $proc->{sigcgt} or return 0; return 0 unless $mask =~ m/^[0-9a-fA-F]+$/; # The field is a 64 bit mask written as hex, which overflows hex() on a 32 # bit perl. Only the low word holds the ordinary signals, and SIGUSR1 is # one of them. return (hex(substr($mask, -8)) & $self->_sig_bit($self->usr1_number)) ? 1 : 0; } sub kill_pid { return kill('USR1', $_[1]) } sub signal_pids { my $self = shift; my ($pids, $procs) = @_; $procs //= {}; my @sent; for my $pid (@$pids) { # Never a process group. A negative pid here would signal one, and # SIGUSR1's default action is to terminate. next unless $pid && $pid > 0; # Only a process that actually installed the handler. A test job sheds # it when the runner restores the original %SIG, so a signal there # kills a running test; and a pid recorded earlier may since have # exited and been recycled by something unrelated. SigCgt answers both # exactly, and proc_snapshot already collected it moments ago. if ($self->have_proc) { my $proc = $procs->{$pid}; next unless $proc && !$proc->{gone}; next unless $self->catches_usr1($proc); } push @sent => $pid if $self->kill_pid($pid); } return \@sent; } sub collect { my $self = shift; my ($info) = @_; my $whitelist = $info->{harness_pids} // []; mkdir($self->{+STALL_DIR}); my %out = ( time => time, tier => $info->{tier}, idle => $info->{idle}, threshold => $info->{threshold}, pending => $info->{pending}, running => $info->{running}, round => $info->{round}, harness_pids => $whitelist, have_proc => $self->have_proc, system => $self->system_snapshot, filesystem => $self->workdir_filesystem, tree => $self->process_tree($self->{+ROOT_PID}), samples => [], ); my $tree = $out{tree} // $whitelist; for my $round (1 .. ROUNDS) { # Collect before signalling. A process in an uninterruptible syscall # never runs its handler, and that is exactly the case most in need of # description, so the external evidence must not depend on a reply. my %sample = (round => $round, procs => {}); my %seen; $sample{procs}->{$_} = $self->proc_snapshot($_) for grep { !$seen{$_}++ } @$tree, @$whitelist; $sample{strace} = $self->strace($info->{scheduler_pid}) if $round == 1 && $info->{scheduler_pid}; $sample{signalled} = $self->signal_pids($whitelist, $sample{procs}); push @{$out{samples}} => \%sample; sleep(ROUND_GAP) if $round < ROUNDS; } # Whatever arrived. A missing trace is itself evidence: no stack plus an # uninterruptible state says the process could not run Perl at all. sleep(SIG_WAIT); $out{traces} = $self->read_traces(); return \%out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Stall::Capture - Collect evidence about a stalled run from outside the stuck processes. =head1 DESCRIPTION Gathers everything obtainable without the stuck process's cooperation, then asks each harness process for its Perl call stack. The order matters. A process in an uninterruptible syscall, or in XS that retries C<EINTR>, never runs a signal handler, so external evidence must not depend on a reply. A missing stack is itself a finding: no stack plus an uninterruptible state says the process could not run Perl at all. Each report samples several times a few seconds apart. Frames and syscalls that move between samples mean a loop making no progress; frames that do not mean the process is stuck on one operation. That distinction is the first question any analysis asks. C<strace> is attempted and usually denied: Yama checks the tracer against the target's ancestry, and C<strace> is a freshly exec'd process, so it is never an ancestor of the scheduler. It is kept for hosts that permit it, and C</proc/PID/wchan> and C</proc/PID/syscall> answer the same question when it does not. Every shell-out is bounded, because this blocks the caller. Everything here is Linux-specific and degrades to the state dump and the stack traces elsewhere. =head1 SYNOPSIS use Test2::Harness::Stall::Capture; my $capture = Test2::Harness::Stall::Capture->new( workdir => $workdir, root_pid => $$, ); my $bundle = $capture->collect(\%info); =head1 ATTRIBUTES =over 4 =item $string = $capture->workdir() The run's working directory. =item $string = $capture->stall_dir() Where the signalled processes leave their stack traces. Defaults to C<stall> inside the working directory. =item $int = $capture->root_pid() Root of the process tree to describe. Defaults to the current process. =back =head1 PUBLIC METHODS =over 4 =item $hashref = $capture->collect(\%info) Runs the whole capture and returns the bundle. C<%info> carries what the detector observed, and the pids to signal as C<harness_pids>. =item $bool = $capture->have_proc() True on a platform where C</proc> can be read. =item $hashref = $capture->proc_snapshot($pid) State, wait channel, syscall, command line, caught signals and open files for one process. =item $string = $capture->read_proc($pid, $what) One C</proc/PID> file, or nothing. Some of these are gated on ptrace permission, and when it is refused the open succeeds and the read comes back empty -- so the read is what must be checked. =item $hashref = $capture->list_fds($pid) File descriptor number to what it points at. =item $arrayref = $capture->process_tree($pid) Every descendant of a pid, including it. =item $arrayref = $capture->all_pids() Every pid on the system, or nothing where there is no C</proc>. =item $bool = $capture->kill_pid($pid) Sends C<SIGUSR1> to one pid. =item $arrayref = $capture->signal_pids(\@pids, \%procs) Sends C<SIGUSR1> to each pid that this round's snapshot shows alive and catching that signal, and returns those actually signalled. A process that did not install the handler is never signalled, because the default action would terminate it. Where there is no C</proc> that check cannot be made and every positive pid in the list is signalled. Never signals a process group. =item $bool = $capture->catches_usr1(\%proc) Whether a snapshot shows the process catching C<SIGUSR1>, read from C<SigCgt>. =item $int = $capture->usr1_number() The local signal number for C<SIGUSR1>. =item $hashref = $capture->system_snapshot() Load, memory and the lock table. =item $string = $capture->workdir_filesystem() Filesystem type and free space for the working directory. =item $string = $capture->strace($pid) Best-effort C<strace> output, or its refusal. =item $hashref = $capture->read_traces() Stack traces written since the last call, keyed by filename. Consumes them. =back =head1 SOURCE The source code repository for Test2-Harness can be found at L<https://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<https://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������HashBase.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 32370�15267772575� 23130� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::HashBase; use strict; use warnings; our $VERSION = '1.000182'; ################################################################# # # # This is a generated file! Do not modify this file directly! # # Use hashbase_inc.pl script to regenerate this file. # # The script is part of the Object::HashBase distribution. # # Note: You can modify the version number above this comment # # if needed, that is fine. # # # ################################################################# { no warnings 'once'; $Test2::Harness::Util::HashBase::HB_VERSION = '0.008'; *Test2::Harness::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS; *Test2::Harness::Util::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST; *Test2::Harness::Util::HashBase::VERSION = \%Object::HashBase::VERSION; *Test2::Harness::Util::HashBase::CAN_CACHE = \%Object::HashBase::CAN_CACHE; } require Carp; { no warnings 'once'; $Carp::Internal{+__PACKAGE__} = 1; } BEGIN { # these are not strictly equivalent, but for out use we don't care # about order *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub { no strict 'refs'; my @packages = ($_[0]); my %seen; for my $package (@packages) { push @packages, grep !$seen{$_}++, @{"$package\::ISA"}; } return \@packages; } } my %SPEC = ( '^' => {reader => 1, writer => 0, dep_writer => 1, read_only => 0, strip => 1}, '-' => {reader => 1, writer => 0, dep_writer => 0, read_only => 1, strip => 1}, '>' => {reader => 0, writer => 1, dep_writer => 0, read_only => 0, strip => 1}, '<' => {reader => 1, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, '+' => {reader => 0, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, ); sub import { my $class = shift; my $into = caller; # Make sure we list the OLDEST version used to create this class. my $ver = $Test2::Harness::Util::HashBase::HB_VERSION || $Test2::Harness::Util::HashBase::VERSION; $Test2::Harness::Util::HashBase::VERSION{$into} = $ver if !$Test2::Harness::Util::HashBase::VERSION{$into} || $Test2::Harness::Util::HashBase::VERSION{$into} > $ver; my $isa = _isa($into); my $attr_list = $Test2::Harness::Util::HashBase::ATTR_LIST{$into} ||= []; my $attr_subs = $Test2::Harness::Util::HashBase::ATTR_SUBS{$into} ||= {}; my %subs = ( ($into->can('new') ? () : (new => \&_new)), (map %{$Test2::Harness::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]), ( map { my $p = substr($_, 0, 1); my $x = $_; my $spec = $SPEC{$p} || {reader => 1, writer => 1}; substr($x, 0, 1) = '' if $spec->{strip}; push @$attr_list => $x; my ($sub, $attr) = (uc $x, $x); $attr_subs->{$sub} = sub() { $attr }; my %out = ($sub => $attr_subs->{$sub}); $out{$attr} = sub { $_[0]->{$attr} } if $spec->{reader}; $out{"set_$attr"} = sub { $_[0]->{$attr} = $_[1] } if $spec->{writer}; $out{"set_$attr"} = sub { Carp::croak("'$attr' is read-only") } if $spec->{read_only}; $out{"set_$attr"} = sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] } if $spec->{dep_writer}; %out; } @_ ), ); no strict 'refs'; *{"$into\::$_"} = $subs{$_} for keys %subs; } sub attr_list { my $class = shift; my $isa = _isa($class); my %seen; my @list = grep { !$seen{$_}++ } map { my @out; if (0.004 > ($Test2::Harness::Util::HashBase::VERSION{$_} || 0)) { Carp::carp("$_ uses an inlined version of Test2::Harness::Util::HashBase too old to support attr_list()"); } else { my $list = $Test2::Harness::Util::HashBase::ATTR_LIST{$_}; @out = $list ? @$list : () } @out; } reverse @$isa; return @list; } sub _new { my $class = shift; my $self; if (@_ == 1) { my $arg = shift; my $type = ref($arg); if ($type eq 'HASH') { $self = bless({%$arg}, $class) } else { Carp::croak("Not sure what to do with '$type' in $class constructor") unless $type eq 'ARRAY'; my %proto; my @attributes = attr_list($class); while (@$arg) { my $val = shift @$arg; my $key = shift @attributes or Carp::croak("Too many arguments for $class constructor"); $proto{$key} = $val; } $self = bless(\%proto, $class); } } else { $self = bless({@_}, $class); } $Test2::Harness::Util::HashBase::CAN_CACHE{$class} = $self->can('init') unless exists $Test2::Harness::Util::HashBase::CAN_CACHE{$class}; $self->init if $Test2::Harness::Util::HashBase::CAN_CACHE{$class}; $self; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::HashBase - Build hash based classes. =head1 SYNOPSIS A class: package My::Class; use strict; use warnings; # Generate 3 accessors use Test2::Harness::Util::HashBase qw/foo -bar ^baz <bat >ban +boo/; # Chance to initialize defaults sub init { my $self = shift; # No other args $self->{+FOO} ||= "foo"; $self->{+BAR} ||= "bar"; $self->{+BAZ} ||= "baz"; $self->{+BAT} ||= "bat"; $self->{+BAN} ||= "ban"; $self->{+BOO} ||= "boo"; } sub print { print join ", " => map { $self->{$_} } FOO, BAR, BAZ, BAT, BAN, BOO; } Subclass it package My::Subclass; use strict; use warnings; # Note, you should subclass before loading HashBase. use base 'My::Class'; use Test2::Harness::Util::HashBase qw/bub/; sub init { my $self = shift; # We get the constants from the base class for free. $self->{+FOO} ||= 'SubFoo'; $self->{+BUB} ||= 'bub'; $self->SUPER::init(); } use it: package main; use strict; use warnings; use My::Class; # These are all functionally identical my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar'); my $two = My::Class->new({foo => 'MyFoo', bar => 'MyBar'}); my $three = My::Class->new(['MyFoo', 'MyBar']); # Readers! my $foo = $one->foo; # 'MyFoo' my $bar = $one->bar; # 'MyBar' my $baz = $one->baz; # Defaulted to: 'baz' my $bat = $one->bat; # Defaulted to: 'bat' # '>ban' means setter only, no reader # '+boo' means no setter or reader, just the BOO constant # Setters! $one->set_foo('A Foo'); #'-bar' means read-only, so the setter will throw an exception (but is defined). $one->set_bar('A bar'); # '^baz' means deprecated setter, this will warn about the setter being # deprecated. $one->set_baz('A Baz'); # '<bat' means no setter defined at all # '+boo' means no setter or reader, just the BOO constant $one->{+FOO} = 'xxx'; =head1 DESCRIPTION This package is used to generate classes based on hashrefs. Using this class will give you a C<new()> method, as well as generating accessors you request. Generated accessors will be getters, C<set_ACCESSOR> setters will also be generated for you. You also get constants for each accessor (all caps) which return the key into the hash for that accessor. Single inheritance is also supported. =head1 THIS IS A BUNDLED COPY OF HASHBASE This is a bundled copy of L<Object::HashBase>. This file was generated using the C</home/exodist/perl5/perlbrew/perls/main/bin/hashbase_inc.pl> script. =head1 METHODS =head2 PROVIDED BY HASH BASE =over 4 =item $it = $class->new(%PAIRS) =item $it = $class->new(\%PAIRS) =item $it = $class->new(\@ORDERED_VALUES) Create a new instance. HashBase will not export C<new()> if there is already a C<new()> method in your packages inheritance chain. B<If you do not want this method you can define your own> you just have to declare it before loading L<Test2::Harness::Util::HashBase>. package My::Package; # predeclare new() so that HashBase does not give us one. sub new; use Test2::Harness::Util::HashBase qw/foo bar baz/; # Now we define our own new method. sub new { ... } This makes it so that HashBase sees that you have your own C<new()> method. Alternatively you can define the method before loading HashBase instead of just declaring it, but that scatters your use statements. The most common way to create an object is to pass in key/value pairs where each key is an attribute and each value is what you want assigned to that attribute. No checking is done to verify the attributes or values are valid, you may do that in C<init()> if desired. If you would like, you can pass in a hashref instead of pairs. When you do so the hashref will be copied, and the copy will be returned blessed as an object. There is no way to ask HashBase to bless a specific hashref. In some cases an object may only have 1 or 2 attributes, in which case a hashref may be too verbose for your liking. In these cases you can pass in an arrayref with only values. The values will be assigned to attributes in the order the attributes were listed. When there is inheritance involved the attributes from parent classes will come before subclasses. =back =head2 HOOKS =over 4 =item $self->init() This gives you the chance to set some default values to your fields. The only argument is C<$self> with its indexes already set from the constructor. B<Note:> Test2::Harness::Util::HashBase checks for an init using C<< $class->can('init') >> during construction. It DOES NOT call C<can()> on the created object. Also note that the result of the check is cached, it is only ever checked once, the first time an instance of your class is created. This means that adding an C<init()> method AFTER the first construction will result in it being ignored. =back =head1 ACCESSORS =head2 READ/WRITE To generate accessors you list them when using the module: use Test2::Harness::Util::HashBase qw/foo/; This will generate the following subs in your namespace: =over 4 =item foo() Getter, used to get the value of the C<foo> field. =item set_foo() Setter, used to set the value of the C<foo> field. =item FOO() Constant, returns the field C<foo>'s key into the class hashref. Subclasses will also get this function as a constant, not simply a method, that means it is copied into the subclass namespace. The main reason for using these constants is to help avoid spelling mistakes and similar typos. It will not help you if you forget to prefix the '+' though. =back =head2 READ ONLY use Test2::Harness::Util::HashBase qw/-foo/; =over 4 =item set_foo() Throws an exception telling you the attribute is read-only. This is exported to override any active setters for the attribute in a parent class. =back =head2 DEPRECATED SETTER use Test2::Harness::Util::HashBase qw/^foo/; =over 4 =item set_foo() This will set the value, but it will also warn you that the method is deprecated. =back =head2 NO SETTER use Test2::Harness::Util::HashBase qw/<foo/; Only gives you a reader, no C<set_foo> method is defined at all. =head2 NO READER use Test2::Harness::Util::HashBase qw/>foo/; Only gives you a write (C<set_foo>), no C<foo> method is defined at all. =head2 CONSTANT ONLY use Test2::Harness::Util::HashBase qw/+foo/; This does not create any methods for you, it just adds the C<FOO> constant. =head1 SUBCLASSING You can subclass an existing HashBase class. use base 'Another::HashBase::Class'; use Test2::Harness::Util::HashBase qw/foo bar baz/; The base class is added to C<@ISA> for you, and all constants from base classes are added to subclasses automatically. =head1 GETTING A LIST OF ATTRIBUTES FOR A CLASS Test2::Harness::Util::HashBase provides a function for retrieving a list of attributes for an Test2::Harness::Util::HashBase class. =over 4 =item @list = Test2::Harness::Util::HashBase::attr_list($class) =item @list = $class->Test2::Harness::Util::HashBase::attr_list() Either form above will work. This will return a list of attributes defined on the object. This list is returned in the attribute definition order, parent class attributes are listed before subclass attributes. Duplicate attributes will be removed before the list is returned. B<Note:> This list is used in the C<< $class->new(\@ARRAY) >> constructor to determine the attribute to which each value will be paired. =back =head1 SOURCE The source code repository for HashBase can be found at F<http://github.com/Test-More/HashBase/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2017 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FakeHook.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 270�15267772575� 23363� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/inc_hook��������������������������������������������������������������������������������������������������������������������������package FakeHook; use strict; use warnings; # INC is a special identifier that lives in main::, hence the FQN. sub FakeHook::INC { return } unshift @INC, bless({}, __PACKAGE__); 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������dot-last.tx�����������������������������������������������������������������������������������������100644��001750��001750�� 1105�15267772575� 23475� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added all via cli, in order" ); is($INC[-1], '.', "Dot added last"); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������not-perl.pl�����������������������������������������������������������������������������������������100644��001750��001750�� 1512�15267772575� 23470� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; use Config qw/%Config/; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); use App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added all the expected paths in order" ); like( [split $Config{path_sep}, $ENV{PERL5LIB}], [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "When running non-perl the libs were added via PERL5LIB" ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������not-perl.sh�����������������������������������������������������������������������������������������100755��001750��001750�� 60�15267772575� 23427� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������#!/usr/bin/env bash exec $YATH_PERL not-perl.pl ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Resource.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 2517�15267772575� 23547� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource��������������������������������������������������������������������������������������������������������������������������package Resource; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; my $limit = 2; my $no_slots_msg = 0; sub available { my $self = shift; my ($task) = @_; for my $slot (1 .. $limit) { return 1 unless defined $self->{$slot}; } $self->message("No Slots") unless $no_slots_msg++; return 0; } sub assign { my $self = shift; my ($task, $state) = @_; for my $slot (1 .. $limit) { next if defined $self->{$slot}; $self->message("Assigned: $task->{job_id} - $slot"); $state->{record} = $slot; $state->{env_vars}->{RESOURCE_TEST} = $slot; push @{$state->{args}} => $slot; return; } die "Error, no slots to assign"; } sub record { my $self = shift; my ($job_id, $slot) = @_; $self->message("Record: $job_id - $slot"); $self->{$slot} = $job_id; $self->{$job_id} = $slot; } sub release { my $self = shift; my ($job_id) = @_; my $slot = delete $self->{$job_id}; delete $self->{$slot}; $self->message("Release: $job_id - $slot"); } sub cleanup { my $self = shift; $self->message("RESOURCE CLEANUP"); } my $pid; sub message { my $self = shift; my ($msg) = @_; if (!$pid || $$ != $pid) { $pid = $$; print "$$ - $0\n"; } print "$$ - $msg\n"; } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������scheduler_death�������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22551� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 65�15267772575� 23447� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/scheduler_death�������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 65�15267772575� 23450� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/scheduler_death�������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������c.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 65�15267772575� 23451� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/scheduler_death�������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; ok(1, "pass"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Tools�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20163� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2������������������������������������������������������������������������������������������������������������������������������������HarnessTester.t�������������������������������������������������������������������������������������100644��001750��001750�� 1522�15267772575� 23302� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Tools������������������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Tools::HarnessTester'; use Test2::Tools::HarnessTester qw/summarize_events/; imported_ok qw/summarize_events/; my $events = intercept { ok(1, "Pass") for 1 .. 4; ok(0, "Fail"); ok(1, "Pass"); done_testing; }; is( summarize_events($events), { assertions => 6, errors => 0, fail => 1, failures => 1, pass => 0, plan => {count => 6}, }, "Failure, assertion count, plan", ); $events = intercept { ok(1, "Pass") for 1 .. 4; done_testing; }; is( summarize_events($events), { assertions => 4, errors => 0, fail => 0, failures => 0, pass => 1, plan => {count => 4}, }, "pass, assertion count, plan", ); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nested����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20716� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/yath_script�����������������������������������������������������������������������������������������������������������������������������������.yath.user.rc���������������������������������������������������������������������������������������100644��001750��001750�� 603�15267772575� 23363� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/yath_script/nested���������������������������������������������������������������������������������������������������������������������������� ; comment! -Dpre_user_lib; comment! -D=rel(pre/xxx/user/lib) ;comment! -D=rel( pre/yyy/user/lib ) -pUSER_XXX -p USER_YYY [test] -Itest_user_lib; comment! -I=rel(test/xxx/user/lib) ;comment! -I rel( test/yyy/user/lib ) -user_xxxx;comment! user_foo user_bar user_baz user_bat [run] -Irun_user_lib -I=rel(run/xxx/user/lib) -I rel( run/yyy/user/lib ) -user_xxxx user_foo user_bar �����������������������������������������������������������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20616� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t2/lib/App/Yath���������������������������������������������������������������������������������������������������������������������������������SelfTest.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 1275�15267772575� 23052� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t2/lib/App/Yath/Plugin��������������������������������������������������������������������������������������������������������������������������package App::Yath::Plugin::SelfTest; use strict; use warnings; use Test2::Harness::TestFile; use IPC::Cmd qw/can_run/; use parent 'App::Yath::Plugin'; sub find_files { my ($plugin, $run, $search) = @_; return if ($search && !grep { m{^(./)?t2(/non_perl(/(.*)?)?)?} } @$search); my @out; if (can_run('/usr/bin/bash')) { push @out => Test2::Harness::TestFile->new(file => "t2/non_perl/test.sh"); } if (can_run('gcc')) { system('gcc', '-o' => 't2/non_perl/test.binary', 't2/non_perl/test.c') and die "Failed to compile t2/non_perl/test.c"; push @out => Test2::Harness::TestFile->new(file => "t2/non_perl/test.binary"); } return @out; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Preload.pm������������������������������������������������������������������������������������������100644��001750��001750�� 37541�15267772575� 23401� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Preload; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Runner::Preload::Stage(); sub import { my $class = shift; my $caller = caller; my %exports; my $instance = $class->new; $exports{TEST2_HARNESS_PRELOAD} = sub { $instance }; $exports{stage} = sub { my ($name, $code) = @_; my @caller = caller(); $instance->build_stage( name => $name, code => $code, caller => \@caller, ); }; $exports{eager} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->set_eager(1); }; $exports{default} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; my $name = $stage->name; $instance->set_default_stage($name); }; $exports{file_stage} = sub { my ($callback) = @_; my @caller = caller(); croak "'file_stage' cannot be used under a stage" if @{$instance->stack}; $instance->add_file_stage(\@caller, $callback); }; for my $name (qw/pre_fork post_fork pre_launch/) { my $meth = "add_${name}_callback"; $exports{$name} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->$meth(@_); }; } $exports{watch} = sub { if (@{$instance->stack}) { my $stage = $instance->stack->[-1]; return $stage->watch(@_); } if ($INC{'Test2/Harness/Runner/DepTracer.pm'}) { if (my $active = Test2::Harness::Runner::DepTracer->ACTIVE) { return $active->add_callback(@_); } } croak "No current stage, and no active deptracer"; }; $exports{preload} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->add_to_load_sequence(@_); }; $exports{reload_remove_check} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->set_reload_remove_check(@_); }; $exports{reload_inplace_check} = sub { croak "No current stage" unless @{$instance->stack}; my $stage = $instance->stack->[-1]; $stage->set_reload_inplace_check(@_); }; for my $name (keys %exports) { no strict 'refs'; *{"$caller\::$name"} = $exports{$name}; } } use Test2::Harness::Util::HashBase qw{ <stage_list <stage_lookup <stack +default_stage +file_stage }; sub init { my $self = shift; $self->{+STAGE_LIST} //= []; $self->{+STAGE_LOOKUP} //= {}; $self->{+STACK} //= []; $self->{+FILE_STAGE} //= []; } sub build_stage { my $self = shift; my %params = @_; my $caller = $params{caller} //= [caller()]; die "A coderef is required at $caller->[1] line $caller->[2].\n" unless $params{code}; my $stage = Test2::Harness::Runner::Preload::Stage->new( stage_lookup => $self->{+STAGE_LOOKUP}, %params, ); my $stack = $self->{+STACK} //= []; push @$stack => $stage; my $ok = eval { $params{code}->($stage); 1 }; my $err = $@; die "Mangled stack" unless @$stack && $stack->[-1] eq $stage; pop @$stack; die $err unless $ok; if (@$stack) { $stack->[-1]->add_child($stage); } else { $self->add_stage($stage, $caller); } return $stage; } sub add_stage { my $self = shift; my ($stage, $caller) = @_; $caller //= [caller()]; my @all = ($stage, @{$stage->all_children}); for my $item (@all) { my $name = $item->name; if (my $existing = $self->{+STAGE_LOOKUP}->{$name}) { $caller //= [caller()]; my $ncaller = $item->frame; my $ecaller = $existing->frame; die <<" EOT" A stage named '$name' was already defined. First at $ecaller->[1] line $ecaller->[2]. Second at $ncaller->[1] line $ncaller->[2]. Mixed at $caller->[1] line $caller->[2]. EOT } $self->{+STAGE_LOOKUP}->{$name} = $item; } push @{$self->{+STAGE_LIST}} => $stage; } sub merge { my $self = shift; my ($merge) = @_; my $caller = [caller()]; for my $stage (@{$merge->{+STAGE_LIST}}) { $self->add_stage($stage, $caller); } push @{$self->{+FILE_STAGE}} => @{$merge->{+FILE_STAGE}}; $self->{+DEFAULT_STAGE} //= $merge->default_stage; } sub add_file_stage { my $self = shift; my ($caller, $code) = @_; croak "Caller must be defined and an array" unless $caller && ref($caller) eq 'ARRAY'; croak "Code must be defined and a coderef" unless $code && ref($code) eq 'CODE'; push @{$self->{+FILE_STAGE}} => [$caller, $code]; } sub file_stage { my $self = shift; my ($file) = @_; for my $cb (@{$self->{+FILE_STAGE}}) { my ($caller, $code) = @$cb; my $stage = $code->($file) or next; die "file_stage callback returned invalid stage: $stage at $caller->[1] line $caller->[2].\n" unless $self->{+STAGE_LOOKUP}->{$stage}; return $stage; } return; } sub default_stage { my $self = shift; return $self->{+DEFAULT_STAGE} if $self->{+DEFAULT_STAGE}; return $self->{+STAGE_LIST}->[0]; } sub set_default_stage { my $self = shift; my ($name) = @_; croak "Default stage already set to $self->{+DEFAULT_STAGE}" if $self->{+DEFAULT_STAGE}; $self->{+DEFAULT_STAGE} = $name; } sub eager_stages { my $self = shift; my %eager; for my $root (@{$self->{+STAGE_LIST}}) { for my $stage ($root, @{$root->all_children}) { next unless $stage->eager; $eager{$stage->name} = [map { $_->name } @{$stage->all_children}]; } } return \%eager; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preload - DSL for building complex stage-based preload tools. =head1 DESCRIPTION L<Test2::Harness> allows you to preload libraries for a performance boost. This module provides tools that let you go beyond that and build a more complex preload. In addition you can build multiple preload I<stages>, each stage will be its own process and tests can run from a specific stage. This allows for multiple different preload states from which to run tests. =head1 SYNOPSIS =head2 USING YOUR PRELOAD The C<-P> or C<--preload> options work for custom preload modules just as they do regular modules. Yath will know the difference and act accordingly. yath test -PMy::Preload =head2 WRITING YOUR PRELOAD package My::Preload; use strict; use warnings; # This imports several useful tools, and puts the necessary meta-data in # your package to identify it as a special preload. use Test2::Harness::Runner::Preload; # You must specify at least one stage. stage Moose => sub { # Preload can be called multiple times, and can load multiple modules # per call. Order is preserved. preload 'Moose', 'Moose::Role'; preload 'Scalar::Util', 'List::Util'; # preload can also be given a sub if you have some custom code to run # at a specific point in the load order preload sub { # Do something before loading Try::Tiny ... }; preload 'Try::Tiny'; # Tell the runner to watch this file for changes, if it does change run # the sub instead of the usual reload process. This lets you reload # configs and other non-perl files, or allows you to use a custom # reload sub for perl files. watch 'path/to/file' => sub { ... }; # You can also use watch inside preload subs: preload sub { watch 'path/to/file' => sub { ... }; }; # In app code you can add watches dynamically when applicable: preload sub { ... # inside app code if ($INC{'Test2/Harness/Runner/DepTracer.pm'}) { if (my $active = Test2::Harness::Runner::DepTracer->ACTIVE) { $active->add_callback('path/to/file' => sub { ... }); } } ... }; # Eager means tests from nested stages can be run in this stage as # well, this is useful if the nested stage takes a long time to load as # it allows yath to start running tests sooner instead of waiting for # the stage to finish loading. Once the nested stage is loaded tests # intended for it will start running from it instead. eager(); # default means this stage is the one to use if the test does not # specify a stage. default(); # These are hooks that let you run arbitrary code at specific points in # the process. pre_fork happens just before forking to run a test. # post_fork happens just after forking for a test. pre_launch happens # as late as possible before the test starts executing (post fork, # after $0 and other special state are reset). pre_fork sub { ... }; post_fork sub { ... }; pre_launch sub { ... }; # Stages can be nested, nested ones build off the previous stage, but # are in a forked process to avoid contaminating the parent. stage Types => sub { preload 'MooseX::Types'; }; }; # Alternative stage that loads Moo instead of Moose stage Moo => sub { preload 'Moo'; ... }; =head2 HARNESS DIRECTIVES IN PRELOADS If you use a staged preload, and the --reload option, you can add 'CHURN' directives to files in order to only reload sections you are working on. This is particularly useful when a file cannot be reloaded in full, or when doing so is expensive. You can wrap subroutines in the churn directives to have yath reload only those subroutines. sub do_not_reload_this { ... { # HARNESS-CHURN-START sub reload_this_one { ... } sub reload_this_one_too { ... } # HARNESS-CHURN-STOP sub this_is_not_reloaded { ... } You can put as many churn sections you want in as many preloaded modules as you want. If a change is detected then only the churn sections will be reloaded. The churn sections are reloaded by taking the source between the start and stop markers, and running them in an eval like this: eval <<EOT package MODULE_FROM_FILENAME; use strict; use warnings; no warnings 'redefine'; #line $line_number $file $YOUR_CODE ;1; EOT In most cases this is sufficient to replace the old sub with the new one. If the automatically determined package is not correct you can add a C<package FOO;> statement inside the markers. If the strict/warnings settings are not to your specifications you can add overrides inside the markers. Any valid perl code can go into the markers. B<CAVEATS:> Be aware they do not have their original scope, and that can lead to problems if you are not paying attention. Variables outside your markers are not accessible, and lexical variables put inside your markers will be "new" on each reload, this can cause confusion if you have lexicals used by multiple subs where some are inside churn blocks and others are not, so best not to do that. Package variables work a bit better, but any assignment lines are re-run. So C<our $FOO;> is fine (it does not change the value if it is set) but C<our $FOO = ...> will reset the var on each reload. =head1 EXPORTS =over 4 =item $meta = TEST2_HARNESS_PRELOAD() =item $meta = $class->TEST2_HARNESS_PRELOAD() This export provides the meta object, which is an instance of this class. This method being present is how Test2::Harness differentiates between a regular module and a special preload library. =item stage NAME => sub { ... } This creates a new stage with the given C<NAME>, and then runs the coderef with the new stage set as the I<active> one upon which the other function here will operate. Once the coderef returns the I<active> stage is cleared. You may nest stages by calling this function again inside the codeblock. B<NOTE:> stage names B<ARE> case sensitive. This can be confusing when you consider that most harness directives are all-caps. In the following case the stage requested by the test and the stage defined in the library are NOT the same. In a test file: # HARNESS-STAGE-FOO In a preload library: stage foo { ... } Harness directives are all-caps, however the user data portion need not be, this is fine: # HARNESS-STAGE-foo However it is very easy to make the mistake of thinking it is case insensitive. It is also easy to assume the 'foo' part of the harness directive must be all caps. In many cases it is smart to make your stage names all-caps. =item preload $module_name =item preload @module_names =item preload sub { ... } This B<MUST> be called inside a C<stage()> builder coderef. This adds modules to the list of libraries to preload. Order is preserved. You can also add coderefs to execute arbitrary code between module loads. The coderef is called with no arguments, and its return is ignored. =item eager() This B<MUST> be called inside a C<stage()> builder coderef. This marks the I<active> stage as being I<eager>. An eager stage will start running tests for nested stages if it finds itself with no tests of its own to run before the nested stage can finish loading. The idea here is to avoid unused test slots when possible allowing for tests to complete sooner. =item default() This B<MUST> be called inside a C<stage()> builder coderef. This B<MUST> be called only once across C<ALL> stages in a given library. If multiple preload libraries are loaded then the I<first> default set (based on load order) will be the default, others will not be honored. =item $stage_name = file_stage($test_file) This is optional. If defined this callback will have a chance to look at all files that are going to be run and assign them a stage. This may return undef or an empty list if it does not have a stage to assign. If multiple preload libraries define file_stage callbacks they will be called in order, the first one to return a stage name will win. If no file_stage callbacks provide a stage for a file then any harness directives declaring a stage will be honored. If no stage is ever assigned then the test will be run int he default stage. =item pre_fork sub { ... } This B<MUST> be called inside a C<stage()> builder coderef. Add a callback to be run just before the preload-stage process forks to run the test. Note that any state changes here can effect future tests to be run. =item post_fork sub { ... } This B<MUST> be called inside a C<stage()> builder coderef. Add a callback to be run just after the preload-stage process forks to run the test. This is run as early as possible, things like C<$0> may not be set properly yet. =item pre_launch sub { ... } This B<MUST> be called inside a C<stage()> builder coderef. Add a callback to be run just before control of the test process is turned over to the test file itself. This is run as late as possible, so things like C<$0> should be set properly. =back =head1 META-OBJECT This class is also the meta-object used to construct a preload library. The methods are left undocumented as this is an implementation detail and you are not intended to directly use this object. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������Detector.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 33313�15267772575� 23363� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Stall�������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Stall::Detector; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use List::Util qw/first/; use File::Spec(); use Time::HiRes qw/time/; use Test2::Harness::Util::Queue(); use Test2::Harness::Util::HashBase qw{ <workdir <job_count <strong <loose +queue +state +last_check +last_start +first_ready +scheduler_pid +stage_pids +reports +replay_errors }; # Give up after this many consecutive replay failures. A State handler that # dislikes a record will dislike it every time, and re-reading the whole # dispatch file once a second is worse than not reporting. use constant MAX_REPLAY_ERRORS => 3; # Actions only the scheduler process enqueues. start_run is the useful one: it # is written before any task starts, so it is present even in a run where # nothing ever ran. my %SCHEDULER_ACTIONS = (start_run => 1, start_task => 1); # How often check() is allowed to touch the filesystem. The render loop calls # it thousands of times a second. use constant CHECK_INTERVAL => 1; # Wait this long before saying the same stall again, so a benign tail cannot # flood a CI log, and stop entirely after MAX_REPORTS. use constant REPEAT_INTERVAL => 300; use constant MAX_REPORTS => 5; sub init { my $self = shift; croak "You must specify a workdir" unless defined $self->{+WORKDIR}; $self->{+JOB_COUNT} //= 1; $self->{+REPORTS} = []; return; } # Parse a --stall-report value: 'STRONG:LOOSE', or one number for both. # Returns nothing when reporting is disabled. sub parse_spec { my $class = shift; my ($spec) = @_; return unless defined $spec && length "$spec"; my ($strong, $loose) = split /:/, "$spec", 2; $loose = $strong unless defined $loose && length $loose; # An opt-in diagnostic that silently disables itself on a typo is a trap: # the site turns it on once and only finds out years later. for my $val ($strong, $loose) { croak "Invalid --stall-report value '$spec', want SECONDS or STRONG:LOOSE" unless defined $val && $val =~ m/^\d+(?:\.\d+)?$/; } return if $strong <= 0 && $loose <= 0; return (strong => $strong, loose => $loose); } # A State that can never reach a user resource class. State::init only builds # the classes named in the settings when 'resources' is empty, so handing it an # in-tree resource means _stop_task's release() only ever reaches JobCount. # Without this the main process would run the very callback most likely to be # wedged. Do not remove the resources argument. sub build_state { my $self = shift; # Loaded here rather than at compile time: the collector loads this module # only to ask whether reporting is on, and should not pay for the runner's # state machine to answer that. require Test2::Harness::Runner::State; require Test2::Harness::Runner::Resource::JobCount; return Test2::Harness::Runner::State->new( workdir => $self->{+WORKDIR}, job_count => $self->{+JOB_COUNT}, observe => 1, resources => [ Test2::Harness::Runner::Resource::JobCount->new( job_count => $self->{+JOB_COUNT}, ), ], ); } # Read only for the record stamps State does not expose. last_job_activity is # no use here, it moves when a test stops as well as when one starts. sub queue { my $self = shift; return $self->{+QUEUE} //= Test2::Harness::Util::Queue->new( file => File::Spec->catfile($self->{+WORKDIR}, 'dispatch.jsonl'), ); } sub poll_stamps { my $self = shift; my $items = eval { [$self->queue->poll] }; unless ($items) { my $count = ++$self->{+REPLAY_ERRORS}; warn "Stall detector could not read the dispatch queue: $@" if $count <= MAX_REPLAY_ERRORS; return 0; } for my $item (@$items) { my $data = $item->[-1] or next; my $action = $data->{action} or next; my $stamp = $data->{stamp}; $self->{+LAST_START} = $stamp if $action eq 'start_task'; if ($action eq 'stage_ready') { $self->{+FIRST_READY} //= $stamp; $self->{+STAGE_PIDS}->{$data->{item}} = $data->{pid} if $data->{pid}; } # A stage that has gone down must leave the list. Its pid can be # recycled, and SIGUSR1 to a process that never installed the handler # kills it. delete $self->{+STAGE_PIDS}->{$data->{item}} if $action eq 'stage_down'; $self->{+SCHEDULER_PID} //= $data->{pid} if $data->{pid} && $SCHEDULER_ACTIONS{$action}; } return 1; } sub stage_pids { $_[0]->{+STAGE_PIDS} // {} } sub replay { my $self = shift; # State's handlers die on anything they consider inconsistent, and they # were not written for read-only replay in another process. State::init # polls as its last act, so construction can die too and has to be inside # the same guard. A detector must never be able to end a healthy run. my $state = $self->{+STATE}; my $ok = eval { $state //= $self->build_state(); $state->poll; 1; }; my $err = $@; unless ($ok) { $self->{+STATE} = undef; my $count = ++$self->{+REPLAY_ERRORS}; warn "Stall detector could not read the run state: $err"; warn "Stall reporting disabled after $count failures.\n" if $count == MAX_REPLAY_ERRORS; return; } $self->{+STATE} = $state; return $state; } sub pending_tasks { my $self = shift; my ($state) = @_; my @out; my $pending = $state->pending_tasks // {}; for my $run_id (keys %$pending) { for my $smoke (values %{$pending->{$run_id} // {}}) { for my $stage (values %{$smoke // {}}) { for my $cat (values %{$stage // {}}) { for my $dur (values %{$cat // {}}) { push @out => @{$dur // []}; } } } } } return \@out; } # True when every pending test is one the scheduler is right to be holding # back. These waits are legitimate and can last as long as the longest running # test, so reporting them would be noise. sub all_pending_blocked { my $self = shift; my ($state, $tasks) = @_; my $running = $state->running // 0; my $categories = $state->running_categories // {}; my $conflicts = $state->running_conflicts // {}; my $shares = $state->running_shares // {}; for my $task (@$tasks) { my $cat = $task->{category} // 'general'; next if $cat eq 'isolation' && $running; next if $cat eq 'immiscible' && $categories->{immiscible}; # These mirror the two rejections in State::_next. An exclusive claim # waits for anything holding the name, exclusively or shared; a shared # claim waits only for an exclusive holder. next if first { $conflicts->{$_} || $shares->{$_} } @{$task->{conflicts} // []}; next if first { $conflicts->{$_} } @{$task->{shares} // []}; return 0; } return 1; } sub check { my $self = shift; return unless $self->{+STRONG} || $self->{+LOOSE}; return if @{$self->{+REPORTS}} >= MAX_REPORTS; return if ($self->{+REPLAY_ERRORS} // 0) >= MAX_REPLAY_ERRORS; my $now = time; return if $self->{+LAST_CHECK} && $now - $self->{+LAST_CHECK} < CHECK_INTERVAL; $self->{+LAST_CHECK} = $now; my $polled = $self->poll_stamps(); my $state = $self->replay() or return; # Both readers got through in this call, so nothing is persistently wrong. # Consecutive, as MAX_REPLAY_ERRORS says: a healthy run must clear it, not # only a run that is about to report. $self->{+REPLAY_ERRORS} = 0 if $polled; return unless $self->{+FIRST_READY}; return unless grep { $_ } values %{$state->stage_readiness // {}}; my $tasks = $self->pending_tasks($state); return unless @$tasks; my $running = $state->running // 0; my $tier = $running ? 'loose' : 'strong'; my $threshold = $running ? $self->{+LOOSE} : $self->{+STRONG}; return unless $threshold; my $since = $now - ($self->{+LAST_START} // $self->{+FIRST_READY}); return if $since < $threshold; return if $self->all_pending_blocked($state, $tasks); my $last = $self->{+REPORTS}->[-1]; return if $last && $now - $last < REPEAT_INTERVAL; push @{$self->{+REPORTS}} => $now; return { tier => $tier, idle => $since, threshold => $threshold, running => $running, pending => scalar(@$tasks), round => scalar(@{$self->{+REPORTS}}), state => $state, tasks => $tasks, scheduler_pid => $self->{+SCHEDULER_PID}, stage_pids => $self->stage_pids, }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Stall::Detector - Notice when the scheduler has stopped starting tests. =head1 DESCRIPTION A stall is new tests not being started even though tests are pending and there is capacity to start them. Whether other tests are currently running is irrelevant; a stall is about what is not being started. This class decides when that has happened. It is driven from the main C<yath test> process, which is healthy during a stall and is an ancestor of the scheduler. It adds no bookkeeping to the runner: everything it needs is already in the run's own C<dispatch.jsonl>. Two readers are involved. A raw L<Test2::Harness::Util::Queue> supplies the record stamps, because C<last_job_activity> moves when a test stops as well as when one starts. A L<Test2::Harness::Runner::State> replay supplies the counts. The replay is built with an explicit in-tree C<resources> list. C<Test2::Harness::Runner::State> only constructs the resource classes named in the settings when none are supplied, so passing one keeps C<release()> away from user code -- the callback most likely to be wedged when this fires. B<Do not remove that argument.> Nothing here may end a healthy run, so the replay is wrapped and repeated failures disable reporting rather than repeating forever. =head2 WHAT IS NOT A STALL Two waits are suppressed, because the scheduler is right to hold back and both can last as long as the longest running test: pending tests that are all C<isolation> while something is running, and pending tests all blocked by a conflict already held. Reporting is also gated on a stage being currently ready, so a long preload is not mistaken for a stall. =head1 SYNOPSIS use Test2::Harness::Stall::Detector; my %spec = Test2::Harness::Stall::Detector->parse_spec('600:1200') or return; my $detector = Test2::Harness::Stall::Detector->new( %spec, workdir => $workdir, job_count => $job_count, ); # Called often; it rate-limits itself. if (my $found = $detector->check) { ... } =head1 ATTRIBUTES =over 4 =item $string = $detector->workdir() The run's working directory. =item $int = $detector->job_count() Used only to build the replay's job limiter. =item $seconds = $detector->strong() How long to wait before reporting while tests are pending and none are running. =item $seconds = $detector->loose() How long to wait before reporting while tests are pending and others are still running. =back =head1 PUBLIC METHODS =over 4 =item %spec = $class->parse_spec($string) Parses a C<--stall-report> value, either C<SECONDS> or C<STRONG:LOOSE>. Returns an empty list when reporting is disabled, and croaks on an unparseable value. =item $hashref = $detector->check() Returns nothing unless a stall is being reported. Rate-limits itself, so it is safe to call from a busy loop. The returned hashref describes what was observed, and carries the replayed state, the pending tasks, and the scheduler and stage pids. =item $hashref = $detector->stage_pids() Stage name to pid, for stages that are currently up. These feed the signal whitelist, so a stage that has gone down is removed. =item $queue = $detector->queue() The raw dispatch queue reader, separate from the replay's own. Never C<$state-E<gt>dispatch_file>: that reader is stateful and the main process needs it untouched so C<stop()> can replay the whole file on Ctrl-C. =item $bool = $detector->poll_stamps() Reads new records for their stamps and pids, returning false if the queue could not be read. C<last_job_activity> cannot serve here, because it moves when a test stops as well as when one starts. =item $state = $detector->build_state() Builds the observer state. See the warning above about the C<resources> argument. =item $state = $detector->replay() Polls the observer state, returning nothing if it could not be read. Repeated failures disable reporting rather than re-reading the whole queue every second for the rest of the run. =item $arrayref = $detector->pending_tasks($state) Every pending task across all runs, flattened. =item $bool = $detector->all_pending_blocked($state, $tasks) Whether every pending test is one the scheduler is right to be holding back: an C<isolation> test while anything runs, an C<immiscible> one while another immiscible runs, an exclusive claim on a name something else holds either way, or a shared claim on a name something holds exclusively. These mirror the rejections in C<State::_next> and must follow it. =back =head1 SOURCE The source code repository for Test2-Harness can be found at L<https://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<https://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������File������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21606� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util��������������������������������������������������������������������������������������������������������������������������JSON.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 3524�15267772575� 23061� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util/File���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::File::JSON; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak confess/; use Test2::Harness::Util::JSON qw/encode_json decode_json encode_pretty_json/; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase qw/pretty/; sub decode { shift; decode_json(@_) } sub encode { shift->pretty ? encode_pretty_json(@_) : encode_json(@_) } sub reset { croak "line reading is disabled for json files" } sub read_line { croak "line reading is disabled for json files" } sub maybe_read { my $self = shift; return undef unless -e $self->{+NAME}; my $out = Test2::Harness::Util::read_file($self->{+NAME}); return undef unless defined($out) && length($out); eval { $out = $self->decode($out); 1 } or confess "$self->{+NAME}: $@"; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::JSON - Utility class for a JSON file. =head1 DESCRIPTION Subclass of L<Test2::Harness::Util::File> which automatically handles encoding/decoding JSON data. =head1 SYNOPSIS require Test2::Harness::Util::File::JSON; my $file = Test2::Harness::Util::File::JSON->new(name => '/path/to/file.json'); $hash = $file->read; # or $$file->write({...}); =head1 SEE ALSO See the base class L<Test2::Harness::Util::File> for methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������no-plugin.tx����������������������������������������������������������������������������������������100644��001750��001750�� 1112�15267772575� 23634� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/encoding��������������������������������������������������������������������������������������������������������������������������use strict; use warnings; use Test::More; note "valid note [“”\xff\xff]"; note "valid note [“”]"; diag "valid diag [“”\xff\xff]"; diag "valid diag [“”]"; print "valid stdout [“”\xff\xff]\n"; print "valid stdout [“”]\n"; print STDERR "valid stderr [“”\xff\xff]\n"; print STDERR "valid stderr [“”]\n"; ok 1, "valid ok [“”\xff\xff]"; ok 1, "valid ok [“”]"; print STDOUT "STDOUT: Mākaha\n"; print STDERR "STDERR: Mākaha\n"; diag "DIAG: Mākaha"; note "NOTE: Mākaha"; ok(1, "ASSERT: Mākaha"); ok(1, "І ще трохи"); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������failure_cases���������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22233� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������exit.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 161�15267772575� 23677� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; use strict; use warnings; ok(1); done_testing; exit(123) unless $ENV{FAILURE_DO_PASS}; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������default-i.tx����������������������������������������������������������������������������������������100644��001750��001750�� 1066�15267772575� 23626� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'xyz'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), ], "Added lib, blib/lib, and blib/arch AFTER the -Ixyz" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Broken.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 47�15267772575� 23501� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package Broken; die "This is broken"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������no_preload.tx���������������������������������������������������������������������������������������100644��001750��001750�� 175�15267772575� 23676� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; # HARNESS-NO-PRELOAD is($ENV{T2_HARNESS_STAGE}, 'NOPRELOAD', "Running in 'NOPRELOAD' stage"); done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21442� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload����������������������������������������������������������������������������������������������������������������������������Preload.pm������������������������������������������������������������������������������������������100644��001750��001750�� 2157�15267772575� 23533� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib������������������������������������������������������������������������������������������������������������������������package Preload; use strict; use warnings; use Test2::Harness::Runner::Preload; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; my $path = __FILE__; $path =~ s{\.pm$}{}; use Data::Dumper; print Dumper($path); stage A => sub { default(); watch "$path/nonperl1" => sub { print "$$ $0 - RELOAD CALLBACK nonperl1\n" }; preload sub { watch "$path/nonperl2" => sub { print "$$ $0 - RELOAD CALLBACK nonperl2\n" }; }; preload 'Preload::A'; preload 'Preload::WarningA'; preload 'Preload::ExceptionA'; preload 'Preload::ExporterA'; preload 'Preload::Churn'; }; stage B => sub { reload_remove_check sub { my %params = @_; return 1 if $params{reload_file} eq $params{from_file}; return 0; }; preload sub { *Preload::B::PreDefined = sub { 'yes' }; }; preload 'Preload::A'; preload 'Preload::WarningA'; preload 'Preload::ExceptionA'; preload 'Preload::ExporterA'; preload 'Preload::B'; preload 'Preload::WarningB'; preload 'Preload::ExceptionB'; preload 'Preload::ExporterB'; preload 'Preload::IncChange'; }; 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������reload_syntax_error.t�������������������������������������������������������������������������������100644��001750��001750�� 3303�15267772575� 24037� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::Require::AuthorTesting; use File::Temp qw/tempdir/; use File::Spec; use App::Yath::Tester qw/yath/; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Util qw/CAN_REALLY_FORK/; skip_all "Cannot fork, skipping preload test" if $ENV{T2_NO_FORK} || !CAN_REALLY_FORK; my $tx = __FILE__ . 'x'; my $tmpdir = tempdir(CLEANUP => 1); mkdir("$tmpdir/Preload") or die "($tmpdir/Preload) $!"; { open(my $fh, '>', "$tmpdir/Preload.pm") or die "Could not create preload: $!"; print $fh <<' EOT'; package Preload; use strict; use warnings; use Test2::Harness::Runner::Preload; stage A => sub { default(); # Do like this to avoid blacklisting preload sub { require Preload::Flux }; }; 1; EOT } sub touch { my ($inject) = @_; my $path = "$tmpdir/Preload/Flux.pm"; note "Touching $path..."; sleep 1; open(my $fh, '>', $path) or die $!; print $fh <<" EOT"; package Preload::Flux; use strict; use warnings; sub foo { 'foo' } $inject 1; EOT close($fh); sleep 2; } touch('$Preload::Flux::VAR = "initial";'); yath( command => 'start', pre => ["-D$tmpdir"], args => ["-I$tmpdir", '-PPreload'], debug => 2, exit => 0, ); yath( command => 'run', args => [$tx, '::', 'initial'], exit => 0, ); touch('$Preload::Flux::VAR = "Syntax Error $bob";'); yath( command => 'run', args => [$tx], # no arg, so undef exit => 0, ); touch('$Preload::Flux::VAR = "fixed";'); yath( command => 'run', args => [$tx, '::', 'fixed'], exit => 0, ); yath(command => 'stop', exit => 0); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������resource_timeout������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23023� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 54�15267772575� 23717� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource_timeout������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 54�15267772575� 23720� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource_timeout������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "pass"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������signals���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21066� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������abrt_or_iot.t���������������������������������������������������������������������������������������100644��001750��001750�� 376�15267772575� 23704� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/signals���������������������������������������������������������������������������������������������������������������������������#!perl use strict; use warnings; use Test::More; # note: this is going to fail if IOT is defined before... # %SIG = %SIG; will introduce a flapping behavior $SIG{'ABRT'} = sub { my ($sig) = @_; is $sig, 'ABRT'; }; kill 'ABRT', $$; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-inc��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21154� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������check-INC.tx����������������������������������������������������������������������������������������100644��001750��001750�� 774�15267772575� 23345� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-inc��������������������������������������������������������������������������������������������������������������������������package My::Simple::Test; use Test2::V0; my $has_dot_in_inc = grep { $_ eq '.' } @INC; ok !$has_dot_in_inc, q['.' is not in @INC run with --no-unsafe-inc]; { # relative path in @INC my @relative_path = grep { index( $_, '/', 0 ) != 0 } @INC; is \@relative_path, [], q[@INC does not contain relative path]; } { # check elative path in %INC my @relative_path = grep { index( $_, '/', 0 ) != 0 } sort values %INC; is \@relative_path, [], q[%INC does not contain relative path values]; } done_testing; ����State.t���������������������������������������������������������������������������������������������100644��001750��001750�� 13501�15267772575� 23364� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner���������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::State'; # HARNESS-DURATION-SHORT use ok $CLASS; use File::Temp qw/tempdir/; use Test2::Harness::Settings; my $RUN_ID = 'test-run'; # Drive the scheduler by hand and check which tasks it is willing to run # together. # # 'tasks' is an ordered list of NAME => TASK_SPEC pairs; the spec carries only # what the case is about (usually 'conflicts' and/or 'shares'), everything else # gets a default. # # 'steps' is an ordered list of pairs describing what should happen: # # running => \@names Let the scheduler start everything it can, then check # that exactly these tasks are running. # stop => \@names Pretend these tasks finished. Nothing forks here, so # this is the only way a task ever completes. # queue => \@tasks Queue more NAME => TASK_SPEC pairs mid-run. sub schedule_ok { my ($name, %params) = @_; my @tasks = @{$params{tasks}}; my @steps = @{$params{steps}}; my $job_count = $params{job_count} // 10; my $ctx = context(); my $settings = Test2::Harness::Settings->new( runner => { job_count => $job_count, slots_per_job => $job_count, resources => [], }, ); my $state = $CLASS->new( workdir => tempdir(CLEANUP => 1), settings => $settings, eager_stages => {}, ); $state->queue_run({run_id => $RUN_ID}); $state->stage_ready('DEFAULT'); my %name_for; my $queue = sub { my (@tasks) = @_; while (@tasks) { my ($task_name, $spec) = splice(@tasks, 0, 2); my $job_id = "job-$task_name"; $name_for{$job_id} = $task_name; $state->queue_task({ run_id => $RUN_ID, job_id => $job_id, category => 'general', duration => 'short', use_preload => 1, %$spec, }); } }; $queue->(@tasks); my $out = subtest $name => sub { while (@steps) { my ($action, $args) = splice(@steps, 0, 2); if ($action eq 'running') { 1 while $state->advance; my @running = map { $name_for{$_} } keys %{$state->running_tasks // {}}; is([sort @running], [sort @$args], "Running: " . join(', ' => sort @$args)); } elsif ($action eq 'stop') { $state->stop_task("job-$_") for @$args; } elsif ($action eq 'queue') { $queue->(@$args); } else { die "Unknown step '$action'"; } } }; $ctx->release; return $out; } schedule_ok( "Two exclusive claims on one name cannot run together", tasks => [ a => {conflicts => ['db']}, b => {conflicts => ['db']}, ], steps => [ running => [qw/a/], stop => [qw/a/], running => [qw/b/], ], ); schedule_ok( "Any number of shared claims on one name run together", tasks => [ a => {shares => ['db']}, b => {shares => ['db']}, c => {shares => ['db']}, ], steps => [running => [qw/a b c/]], ); schedule_ok( "Running shared claims keep an exclusive claim waiting, then release it", tasks => [ a => {shares => ['db']}, b => {shares => ['db']}, ], steps => [ running => [qw/a b/], queue => [c => {conflicts => ['db']}], running => [qw/a b/], stop => [qw/a/], running => [qw/b/], stop => [qw/b/], running => [qw/c/], ], ); schedule_ok( "An exclusive claim is picked ahead of shared claims on the same name", tasks => [ a => {shares => ['db']}, b => {shares => ['db']}, c => {conflicts => ['db']}, ], steps => [ running => [qw/c/], stop => [qw/c/], running => [qw/a b/], ], ); schedule_ok( "An exclusive claim keeps shared claims waiting", tasks => [ a => {conflicts => ['db']}, b => {shares => ['db']}, c => {shares => ['db']}, ], steps => [ running => [qw/a/], stop => [qw/a/], running => [qw/b c/], ], ); schedule_ok( "Claims on unrelated names do not interact", tasks => [ a => {shares => ['db']}, b => {conflicts => ['mysql']}, c => {shares => ['mysql']}, d => {conflicts => ['db']}, ], steps => [ running => [qw/b d/], stop => [qw/b d/], running => [qw/a c/], ], ); schedule_ok( "One task can hold an exclusive claim and a shared claim at once", tasks => [ a => {conflicts => ['db'], shares => ['mysql']}, b => {shares => ['mysql']}, c => {shares => ['db']}, d => {conflicts => ['mysql']}, ], steps => [ running => [qw/a b/], stop => [qw/a b/], running => [qw/c d/], ], ); schedule_ok( "A task with no 'shares' key at all still dispatches", tasks => [ a => {}, b => {conflicts => ['db']}, ], steps => [running => [qw/a b/]], ); schedule_ok( "A name claimed both ways by one task does not block that task", tasks => [ a => {conflicts => ['db'], shares => ['db']}, b => {shares => ['db']}, ], steps => [ running => [qw/a/], stop => [qw/a/], running => [qw/b/], ], ); schedule_ok( "The job limiter still caps how many run at once", job_count => 2, tasks => [ a => {shares => ['db']}, b => {shares => ['db']}, c => {shares => ['db']}, ], steps => [ running => [qw/a b/], stop => [qw/a b/], running => [qw/c/], ], ); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Auditor���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21421� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Watcher.pm������������������������������������������������������������������������������������������100644��001750��001750�� 36024�15267772575� 23541� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Auditor�����������������������������������������������������������������������������������������������������������������������package Test2::Harness::Auditor::Watcher; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; use List::Util qw/first max/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util qw/hub_truth parse_exit/; use Test2::Harness::Auditor::TimeTracker; use Test2::Harness::Util::HashBase qw{ -job -try -assertion_count -exit -plan -_errors -_failures -_sub_failures -_plans -_info -_sub_info -_subtest_id -nested -subtests -numbers -times -halt -failed_subtest_tree }; sub init { my $self = shift; croak "'job' is a required attribute" unless $self->{+JOB}; croak "'try' is a required attribute" unless defined $self->{+TRY}; $self->{+_FAILURES} = 0; $self->{+_ERRORS} = 0; $self->{+ASSERTION_COUNT} = 0; $self->{+NUMBERS} = {}; $self->{+TIMES} = Test2::Harness::Auditor::TimeTracker->new(); $self->{+NESTED} = 0 unless defined $self->{+NESTED}; } sub pass { !$_[0]->fail } sub file { $_[0]->{+JOB}->{file} } sub fail { !!$_[0]->fail_error_facet_list } sub has_exit { defined $_[0]->{+EXIT} } sub has_plan { defined $_[0]->{+PLAN} } sub process { my $self = shift; my ($event) = @_; my $f = $event->{facet_data}; my $hf = hub_truth($f); my $nested = $hf->{nested} || 0; $self->times->process($event, $f, $self->{+ASSERTION_COUNT}) unless $nested; return if $hf->{buffered}; my $is_ours = $nested == $self->{+NESTED}; return unless $is_ours || $f->{from_tap}; # Add parent if we start a buffered subtest if ($f->{harness} && $f->{harness}->{subtest_start}) { my $st = $self->{+SUBTESTS}->{$nested + 1} ||= {}; $st->{event} = $event; $f->{harness_watcher}->{no_render} = 1; return; } my @out; # Not actually a subtest end, someone printed to STDOUT if ($f->{from_tap} && $f->{harness}->{subtest_end} && !($self->{+SUBTESTS} && keys %{$self->{+SUBTESTS}})) { # Alter $f so that this incorrect event is not sent to the renderer. $f->{harness_watcher}->{no_render} = 1; # Make a new $f and $event for the rest of the processing. $f = { %{$f}, harness_watcher => {added_by_watcher => 1}, parent => undef, trace => undef, harness => { %{$f->{harness} || {}}, subtest_end => undef, }, info => [ @{$f->{info} || []}, { details => $f->{from_tap}->{details}, tag => $f->{from_tap}->{source} || 'STDOUT', from_harness => 1, } ], }; $event = Test2::Harness::Event->new(stamp => time, job_try => $self->{+TRY}, facet_data => $f); } push @out => $event; # Close any deeper subtests, unless this event is nothing but output. A # line the test wrote to STDOUT or STDERR that is not TAP says nothing # about nesting, it just happens to have no indentation, so a warning from # a module must not end a subtest that is still being parsed. push @out => $self->close_deeper_subtests($nested, $event) unless $self->output_only($f); unless ($is_ours) { my $st = $self->{+SUBTESTS}->{$nested} ||= {}; my $fd = {%$f}; push @{$st->{children}} => $fd; return @out; } $self->subtest_process($f, $event); return @out; } sub close_deeper_subtests { my $self = shift; my ($nested, $event) = @_; my $sts = $self->{+SUBTESTS} or return; my @out; for my $n (sort { $b <=> $a } grep { $_ > $nested } keys %$sts) { my $st = delete $sts->{$n}; my $se = $st->{event} || $event; my $fd = $se->{facet_data}; delete $fd->{harness_watcher}->{no_render}; $fd->{parent}->{hid} ||= $n; $fd->{parent}->{children} ||= $st->{children}; $fd->{harness}->{closed_by} = $event; $fd->{harness}->{closed_by_eid} = $event->{event_id}; my $pn = $n - 1; if ($st->{event}) { if ($pn > $self->{+NESTED}) { push @{$sts->{$pn}->{children}} => $fd; } elsif ($pn == $self->{+NESTED}) { $self->subtest_process($fd, $se); push @out => $se; } } else { push @out => $se if $self->{+NESTED} && $pn == $self->{+NESTED}; } } return @out; } sub output_only { my $self = shift; my ($f) = @_; # TAP tells us about nesting, even when all it holds is a comment. return 0 if $f->{from_tap}; return 0 if $f->{assert} || $f->{plan} || $f->{parent} || $f->{control} || $f->{errors}; return 0 if $f->{harness} && ($f->{harness}->{subtest_start} || $f->{harness}->{subtest_end}); return $f->{info} ? 1 : 0; } sub subtest_process { my $self = shift; my ($f, $event) = @_; my $closer = delete $f->{harness}->{closed_by}; $event ||= Test2::Harness::Event->new(facet_data => $f, job_try => $self->{+TRY}); $self->{+NUMBERS}->{$f->{assert}->{number}}++ if $f->{assert} && $f->{assert}->{number}; if ($f->{parent} && $f->{assert}) { my $name = $f->{assert}->{details} // "unnamed subtest ($f->{trace}->{frame}->[1] line $f->{trace}->{frame}->[2])"; my $subwatcher = blessed($self)->new(nested => $self->{+NESTED} + 1, job => $self->{+JOB}, try => $self->{+TRY}); my $id = 1; for my $sf (@{$f->{parent}->{children}}) { $sf->{harness}->{job_id} ||= $f->{harness}->{job_id}; $sf->{harness}->{run_id} ||= $f->{harness}->{run_id}; $sf->{harness}->{event_id} ||= $sf->{about}->{uuid} ||= gen_uuid(); $subwatcher->subtest_process($sf); } my @errors = $subwatcher->subtest_fail_error_facet_list(); if ($f->{harness}->{subtest_start}) { push @{$f->{errors}} => {tag => 'REASON', fail => 1, from_harness => 1, details => "Buffered subtest ended abruptly (missing closing brace event)"} unless $closer && $closer->{facet_data}->{harness}->{subtest_end}; } my $fail = 0; if (@errors) { push @{$f->{errors}} => @errors; $fail = 1; } else { $fail ||= $f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}}); $fail ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate}); $fail ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}}; } if ($fail) { $self->{+_SUB_FAILURES}++; # Populate the tree up to this subtest my $tree = $self->{+FAILED_SUBTEST_TREE} //= []; push @$tree => [$name, $subwatcher->{+FAILED_SUBTEST_TREE} // []]; } } $self->{+ASSERTION_COUNT}++ if $f->{assert}; if ($f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}})) { $self->{+_FAILURES}++; } if ($f->{control} || $f->{errors}) { my $err ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate}); $err ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}}; $self->{+_ERRORS}++ if $err; $self->{+HALT} = $f->{control}->{details} || '1' if $f->{control} && $f->{control}->{halt} && (!$self->{+HALT} || $self->{+HALT} eq '1'); } if ($f->{plan} && !$f->{plan}->{none}) { $self->{+_PLANS}++; $self->{+PLAN} = $f->{plan}; } if ($f->{harness_job_exit}) { $self->{+EXIT} = $f->{harness_job_exit}->{exit}; my $file = $self->file(); my $end = $f->{harness_job_end} = { file => $file, rel_file => File::Spec->abs2rel($file), abs_file => File::Spec->rel2abs($file), retry => $f->{harness_job_exit}->{retry}, fail => $self->fail(), stamp => $f->{harness_job_exit}->{stamp}, }; my $plan = $self->plan; $end->{skip} = $plan->{details} || "No reason given" if $plan && !$plan->{count}; my $times = $self->times; if ($times && $times->useful) { $end->{times} = $times->data_dump; push @{$f->{harness_job_fields}} => $times->job_fields; push @{$f->{info}} => {tag => 'TIME', details => $times->summary, table => $times->table}; } push @{$f->{errors}} => $self->fail_error_facet_list; } return; } sub subtest_fail_error_facet_list { my $self = shift; return @{$self->{+_SUB_INFO}} if $self->{+_SUB_INFO}; my @out; my $plan = $self->{+PLAN} ? $self->{+PLAN}->{count} : undef; my $count = $self->{+ASSERTION_COUNT}; my $numbers = $self->{+NUMBERS}; my $max = max(keys %$numbers); if ($max) { for my $i (1 .. $max) { if (!$numbers->{$i}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was never seen"}; } elsif ($numbers->{$i} > 1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was seen more than once"}; } } } if (!$self->{+_PLANS}) { if ($count) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared"}; } else { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared, and no assertions were made."}; } } elsif ($self->{+_PLANS} > 1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Too many plans were declared (Count: $self->{+_PLANS})"}; } push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Planned for $plan assertions, but saw $self->{+ASSERTION_COUNT}"} if $plan && $count != $plan; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Subtest failures were encountered (Count: $self->{+_SUB_FAILURES})"} if $self->{+_SUB_FAILURES}; return @out; } sub fail_error_facet_list { my $self = shift; return @{$self->{+_INFO}} if $self->{+_INFO}; my @out; my $incomplete_subtests = values %{$self->{+SUBTESTS}}; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "One or more incomplete subtests (Count: $incomplete_subtests)"} if $incomplete_subtests; if (my $wstat = $self->{+EXIT}) { if ($wstat == -1) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "The harness could not get the exit code! (Code: $wstat)"}; } else { my $e = parse_exit($wstat); if ($e->{err}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Err: $e->{err})"}; } if ($e->{sig}) { push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Signal: $e->{sig})"}; } } } push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Errors were encountered (Count: $self->{+_ERRORS})"} if $self->{+_ERRORS}; push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion failures were encountered (Count: $self->{+_FAILURES})"} if $self->{+_FAILURES}; push @out => $self->subtest_fail_error_facet_list(); return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor::Watcher - Class to monitor events for a single job and pass judgement on the result. =head1 DESCRIPTION This module represents a per-job state tracker. This module sees every event and manages the state produced. In the end this tracker determines if a test job passed or failed, and why. =head1 SYNOPSIS use Test2::Harness::Auditor::Watcher; my $watcher = Test2::Harness::Auditor::Watcher->new(); for my $event (@events) { $watcher->process($event); } print "Pass!" if $watcher->pass; print "Fail!" if $watcher->fail; =head1 METHODS =over 4 =item $int = $watcher->assertion_count() Number of assertions that have been seen. =item $exit = $watcher->exit() If the job has exited this will return the exit value (integer, 0 or greater). If the job has not exited yet (or at least if the watcher has not seen the exit event yet) this will return undef. =item $bool = $watcher->fail() Returns true if the job has failed/is failing. =item @error_facets = $watcher->fail_error_facet_list Used internally to get a list of 'error' facets to inject into the harness_job_exit event. =item $file = $watcher->file If the test file is known this will return it (string). This will return undef if the file is not yet known. =item $string = $watcher->halt If the test was halted (bail-out) this will contain the human readable reason. =item $bool = $watcher->has_exit Check if the exit value is known. =item $bool = $watcher->has_plan Check if a plan has been seen. =item $job = $watcher->job If the job is known this will return the detailed structure of the job. =item $int = $watcher->nested If this watcher represents a subtest this will be an integer greater than 0, the top-level test is 0. =item $hash = $watcher->numbers This is an internal state tracking what test numbers have been seen. This is really only applicable in tests that produced TAP. =item @events = $watcher->close_deeper_subtests($nested, $event) Closes every subtest open below the given nesting level, as the given event ends them. Returns the events the renderer still needs. =item $bool = $watcher->output_only($facet_data) True if the facet data holds nothing but output the test wrote to STDOUT or STDERR. Such an event says nothing about where the test is in a subtest, so it does not close one. =item $bool = $watcher->pass Check if the test job is passing. =item $plan_facet = $watcher->plan() If the plan facet has been seen this will return it. =item $watcher->process($event); Modify the state based on the provided event. =item $watcher->subtest_fail_error_facet_list Used internally to get a list of 'error' facets to inject into the harness_job_exit event. =item $times = $watcher->times() Returns the L<Test2::Harness::Auditor::TimeTracker> instance. =item $int = $watcher->try() Sometimes a job is run more than once, in those cases this will be an integer greater than 0 representing the try. 0 is used for the first try. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Reloader.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 17103�15267772575� 23540� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Reloader; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Time::HiRes qw/time/; use Test2::Harness::Util qw/file2mod is_same_file/; use File::Spec(); BEGIN { local $@; my $inotify = eval { require Linux::Inotify2; 1 }; if ($inotify) { my $MASK = Linux::Inotify2::IN_MODIFY(); $MASK |= Linux::Inotify2::IN_ATTRIB(); $MASK |= Linux::Inotify2::IN_DELETE_SELF(); $MASK |= Linux::Inotify2::IN_MOVE_SELF(); $MASK |= Linux::Inotify2::IN_MOVE_SELF(); *USE_INOTIFY = sub() { 1 }; require constant; constant->import(INOTIFY_MASK => $MASK); } else { *USE_INOTIFY = sub() { 0 }; *INOTIFY_MASK = sub() { 0 }; } } use Test2::Harness::Util::HashBase qw{ <notify_cb <find_loaded_cb <should_watch_cb <can_reload_cb <reload_cb <delete_symbol_cb <monitored <monitor_lookup <watcher <stat_min_gap <stat_last_checked <pid }; sub _pid_check { my $self = shift; return 1 unless USE_INOTIFY; my $pid = $self->{+PID} //= $$; croak "PID has changed $$ vs $pid (Maybe you need to call reset()?)" unless $$ == $pid; return 1; } sub init { my $self = shift; $self->{+CAN_RELOAD_CB} //= $self->can('_can_reload'); $self->{+FIND_LOADED_CB} //= $self->can('_find_loaded'); $self->{+STAT_MIN_GAP} //= 2; $self->reset; } sub reset { my $self = shift; delete $self->{+PID}; $self->{+MONITORED} = {}; $self->{+MONITOR_LOOKUP} = {}; if (USE_INOTIFY) { $self->{+WATCHER} = Linux::Inotify2->new; $self->{+WATCHER}->blocking(0); } else { $self->{+WATCHER} = {}; } delete $self->{+STAT_LAST_CHECKED}; } sub _find_loaded { keys %INC } sub refresh { my $self = shift; $self->_pid_check(); my $monitored = $self->{+MONITORED}; my $cb = $self->{+FIND_LOADED_CB}; for my $file ($self->$cb($monitored)) { next if exists $monitored->{$file}; $self->monitor($file); } } sub monitor { my $self = shift; my ($file) = @_; $self->_pid_check(); my $monitored = $self->{+MONITORED}; return if exists $monitored->{$file}; my $watch = $self->find_file_to_watch($file); return $monitored->{$file} = 0 unless $watch && -e $watch; if (my $should_watch_cb = $self->{+SHOULD_WATCH_CB}) { return $monitored->{$file} = 0 unless $self->$should_watch_cb($file => $watch); } if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; $inotify->watch($watch, INOTIFY_MASK()); } else { my $stats = $self->{+WATCHER}; $stats->{$watch} = $self->_get_file_times($watch); } $self->{+MONITOR_LOOKUP}->{$watch} = $file; $monitored->{$file} = $watch; return $watch; } sub find_file_to_watch { my $self = shift; my ($file) = @_; return $INC{$file} if $INC{$file} && -e $INC{$file}; for my $dir (@INC) { next if ref($dir); my $path = File::Spec->catfile($dir, $file); return $path if -f $path; } return $file if -e $file; } sub _get_file_times { my $self = shift; my ($file) = @_; my (undef, undef, undef, undef, undef, undef, undef, undef, undef, $mtime, $ctime) = stat($file); return [$mtime, $ctime]; } sub _get_changes { my $self = shift; if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; my @todo = $inotify->read or return; return {map { ($_->fullname() => 1) } @todo}; } # Do not hammer the disk getting stat my $check_time = time; my $gap = $self->{+STAT_MIN_GAP}; my $last_checked = $self->{+STAT_LAST_CHECKED}; return if $last_checked && $gap && $gap > ($check_time - $last_checked); $last_checked = $check_time; my $found = 0; my $changed = {}; my $stats = $self->{+WATCHER}; for my $file (keys %$stats) { my $old_times = $stats->{$file}; my $new_times = $self->_get_file_times($file); # Compare times next if $old_times->[0] == $new_times->[0] && $old_times->[1] == $new_times->[1]; # Update in case we choose not to reload $stats->{$file} = $new_times; $found++; $changed->{$file} = 1; } return unless $found; return $changed; } sub _can_reload { my %params = @_; my $mod = $params{module}; return 1 unless $mod->can('import'); return 0 if $mod->can('IMPORTER_MENU'); { no strict 'refs'; return 0 if @{"$mod\::EXPORT"}; return 0 if @{"$mod\::EXPORT_OK"}; } return 1; } sub reload_changes { my $self = shift; $self->_pid_check(); my $monitored = $self->{+MONITORED}; $self->refresh(); my $changed = $self->_get_changes() or return; my $notify_cb = $self->{+NOTIFY_CB}; $notify_cb->(changes_detected => [keys %$changed]) if $notify_cb; my %out; for my $file (sort keys %$changed) { if (USE_INOTIFY) { my $inotify = $self->{+WATCHER}; $inotify->watch($file, INOTIFY_MASK()); } $notify_cb->(file_changed => $file) if $notify_cb; my $rel = $self->{+MONITOR_LOOKUP}->{$file}; my $mod = file2mod($rel); my %params = (reloader => $self, file => $file, relative => $rel, module => $mod, notify_cb => $notify_cb); my ($status, %fields) = $self->_reload_file(%params); $out{$file} = { file => $file, relative => $rel, module => $mod, reloaded => $status, %fields, }; } return \%out; } sub _reload_file { my $self = shift; my %params = @_; if (my $reload_cb = $self->{+RELOAD_CB}) { my ($status, %fields) = $reload_cb->(%params); return ($status, %fields) if defined $status; } if (my $can_reload_cb = $self->{+CAN_RELOAD_CB}) { my ($can, %fields) = $can_reload_cb->(%params); return ($can, %fields) unless $can; } my $notify_cb = delete $params{notify_cb}; $notify_cb->(reload_inplace => \%params) if $notify_cb; my $del_cb = $self->{+DELETE_SYMBOL_CB}; my ($file, $rel, $mod) = @params{qw/file relative module/}; my @warnings; my $ok = eval { local $SIG{__WARN__} = sub { push @warnings => @_ }; my $stash = do { no strict 'refs'; \%{"${mod}\::"} }; for my $sym (keys %$stash) { next if $sym =~ m/::$/; next if $del_cb && $del_cb->(%params, symbol => $sym, stash => $stash); delete $stash->{$sym}; } delete $INC{$rel}; local $.; require $rel; die "Reloading '$rel' loaded '$INC{$rel}' instead of '$file', \@INC must have been altered" unless is_same_file($file, $INC{$rel}); 1; }; my $err = $@; return (1) if $ok && !@warnings; $notify_cb->(reload_fail => {%params, warnings => \@warnings, error => $err}) if $notify_cb; return (undef, error => $err, warnings => \@warnings); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Reloader - reload logic. =head1 DESCRIPTION =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Resource.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 45634�15267772575� 23604� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Resource; use strict; use warnings; use Term::Table; use Time::HiRes qw/time/; use Test2::Util::Times qw/render_duration/; our $VERSION = '1.000182'; sub scope_global { 0 } sub scope_host { 0 } sub scope_run { 1 } sub setup {} sub new { my $class = shift; return bless({@_}, $class); } sub tick { } sub refresh { } sub discharge { } sub sort_weight { my $class = shift; return 100 if $class->job_limiter; return 50; } sub job_limiter { 0 } sub job_limiter_max { } sub job_limiter_at_max { 0 } sub available { -1 } sub record { } sub assign { } sub release { } sub cleanup { } sub status_data {()} sub status_lines { my $self = shift; my $data = $self->status_data || return; return unless @$data; my $out = ""; for my $group (@$data) { my $gout = "\n"; $gout .= "**** $group->{title} ****\n\n" if defined $group->{title}; for my $table (@{$group->{tables} || []}) { my $rows = $table->{rows}; if (my $format = $table->{format}) { my $rows2 = []; for my $row (@$rows) { my $row2 = []; for (my $i = 0; $i < @$row; $i++) { my $val = $row->[$i]; my $fmt = $format->[$i]; $val = defined($val) ? render_duration($val) : '--' if $fmt && $fmt eq 'duration'; push @$row2 => $val; } push @$rows2 => $row2; } $rows = $rows2; } next unless $rows && @$rows; my $tt = Term::Table->new( header => $table->{header}, rows => $rows, sanitize => 1, collapse => 1, auto_columns => 1, %{$table->{term_table_opts} || {}}, ); $gout .= "** $table->{title} **\n" if defined $table->{title}; $gout .= "$_\n" for $tt->render; $gout .= "\n"; } if ($group->{lines} && @{$group->{lines}}) { $gout .= "$_\n" for @{$group->{lines}}; $gout .= "\n"; } $out .= $gout; } return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource - Base class for resource management classes =head1 DESCRIPTION Sometimes you have limited resources that must be shared/divided between tests that run concurrently. Resource classes give you a way to leverage the IPC system used by L<Test2::Harness> to manage resource assignment and recovery. =head1 SYNOPSIS Here is a resource class that simply assigns an integer to each test. It would be possible to re-use integers, but since there are infinite integers this example is kept simple and just always grabs the next one. package Test2::Harness::Runner::Resource::Foo; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; sub setup { my $class = shift; # NOT AN INSTANCE ... } sub available { my $self = shift; my ($task) = @_; # There are an infinite amount of integers, so we always return true return 1; } sub assign { my $self = shift; my ($task, $state) = @_; # Next ID, do not record the state change yet! my $id = 1 + ($self->{ID} //= 0); print "ASSIGN: $id = $task->{job_id}\n"; # 'record' should get whatever we need to record the resource, whatever you # pass in will become the argument to the record() sub below. This may be a # scalar, a hash, an array, etc. It will be serialized to JSON before # record() sees it. $state->{record} = $id; # Pass the resource into the test, this can be done as envronment variables # and/or arguments to the test (@ARGV). $state->{env_vars}->{FOO_ID} = $id; push @{$state->{args}} => $id; # The return is ignored. return; } sub record { my $self = shift; my ($job_id, $record_arg_from_assign) = @_; # The ID from $state->{record}->{$pkg} in assign. my $id = $record_arg_from_assign; # Update our internal state to reflect the new ID. $self->{ID} = $id; # Add a mapping of what job ID gets what integer ID. $self->{ID_TO_JOB_ID}->{$id} = $job_id; $self->{JOB_ID_TO_ID}->{$job_id} = $id; print "RECORD: $id = $job_id\n"; # The return is ignored } sub tick { my $self = shift; # This is called by only 1 process at a time and gives you a way to do # extra stuff at a regular interval without other processes trying to # do the same work at the same time. # For example, if a database is left in a dirty state after it is # released, you can fire off a cleanup action here knowing no other # process will run it at the same time. You can also be sure no record # messages will be sent while this sub is running as the process it # runs in has a lock. ... } sub release { my $self = shift; my ($job_id) = @_; # Clear the internal mapping, the integer ID is now free. Theoretically it # can be reused, but this example is not that complex. my $id = delete $self->{JOB_ID_TO_ID}->{$job_id}; # This is called for all tests that complete, even if they did not use # this resource, so we return if the job_id is not applicable. return unless defined $id; delete $self->{ID_TO_JOB_ID}->{$id}; print " FREE: $id = $job_id\n"; # The return is ignored } sub cleanup { my $self = shift; print "CLEANUP!\n"; } 1; The print statements generated will look like this when running 2 tests concurrently: yath test -R Foo -j2 t/testA.t t/testB.t [...] (INTERNAL) ASSIGN: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) RECORD: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) ASSIGN: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) RECORD: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) FREE: 1 = 4F7CF5F6-E43F-11EA-9199-24FCBF610F44 (INTERNAL) FREE: 2 = E19CD98C-E436-11EA-8469-8DF0BF610F44 (INTERNAL) CLEANUP! [...] Depending on the tests run the 'FREE' prints may be out of order. =head1 WORKFLOW =head2 HOW STATE IS MANAGED Depending on your preload configuration, yath may have several runners launching tests. If a runner has nothing to do it will lock the queue and try to find the next test that should be run. Only 1 of the runners will be in control of the queue at any given time, but the control of the queue may pass between runners. To manage this there is a mechanism to record messages that allow each runner to maintain a copy of the current state. =head2 CHECK IF RESOURCES ARE AVAILABLE Each runner will have an instance of your resource class. When the runner is in control of the queue, and wants to designate the next test to run, it will check with the resource classes to make sure the correct resources are available. To do that it will call C<available($task)> on each resource instance. The C<$task> will contain the specification for the test, it is a hashref, and you B<SHOULD NOT> modify it. The only key most people care about is the 'file' key, which has the test file that will be run if resources are available. If resources are available, or if the specific file does not need the resource, the C<available()> method should return true. If the file does need your resource(s), and none are available, this should return false. If any resource class returns false it means the test cannot be run yet and the runner will look for another test to run. If C<available()> returns a negative value (e.g. C<-1>), the resource is considered permanently unavailable. By default the test will be skipped. If the C<--fail-on-resource-skip> runner option is enabled, the test will be marked as a failure instead. =head2 ASSIGN A RESOURCE If the runner has determined the test can be run, and all necessary resources are available, it will then call C<assign($task, $state)> on all resource class instances. At this time the resource class should decide what resource(s) to assign to the class. B<CRITICAL NOTE:> the C<assing()> method B<MUST NOT> alter any internal state on the resource class instance. State modification must wait for the C<record()> method to be called. This is because the C<assign()> method is only called in one runner process, the C<record()> method call will happen in every runner process to insure they all have the same internal state. The assign() sub should modify the C<$state> hash, which has 3 keys: =over 4 =item env_vars => {} Env vars to set for the test =item args => [] Arguments to pass to the test =item record => ... Data needed to record the state change for resource classes. Can be a scalar, hashref, arrayref, etc. It will be serialized to JSON to be passed between processes. =back =head2 RECORD A RESOURCE Once a resource is assigned, a message will be sent to all runner processes B<INCLUDING THE ONE THAT DID THE ASSIGN> that says it should call C<record($job_id, $record_val)> on your resource class instance. Your resource class instance must use this to update the state so that once done ALL processes will have the proper internal state. The C<$record_val> is whatever you put into C<< $state->{record} >> in the C<assign()> method above. =head2 QUEUE MANAGEMENT IS UNLOCKED Once the above has been done, queue management will be unlocked. You can be guaranteed that only one process will be run the C<available()>, and C<assign()> sequence at a time, and that they will be called in order, though C<assign()> may not be called if another resource was not available. If C<assign()> is called, you can be guaranteed that all processes, including the one that called C<assign()> will have their C<record()> called with the proper argument B<BEFORE> they try to manage the queue (which is the only place resources are checked or assigned). =head2 RELEASE A RESOURCE Whenever a process that is using a resource exits, the runner that waits on that process will I<eventually> send an IPC message announcing that the job_id has completed. Every time a job_id completes the C<release($job_id)> method will be called on your resource class in all runner processes. This allows the state to be updated to reflect the freed resource. You can be guaranteed that any process that locks the queue to run a new test will eventually see the message. The message may come in during a loop that is checking for resources, in which case the state will not reflect the resource being available, however in such cases the loop will end and be called again later with the message having been received. There will be no deadlock due to a queue manager waiting for the message. There are no guarantees about what order resources will be released in. =head1 METHODS =over 4 =item $class->setup($settings) This will be called once before the runner forks or initialized per-process instances. If you have any "setup once" tasks to initialize resources before tests run this is a good place to do it. This runs immediately after plugin setup() methods are called. B<NOTE:> Do not rely on recording any global state here, the runner and per-process instances may not be forked from the process that calls setup(). =item $res = $class->new(settings => $settings); A default new method, returns a blessed hashref with the settings key set to the L<Test2::Harness::Settings> instance. =item $val = $res->available(\%task) B<DO NOT MODIFY ANY INTERNAL STATE IN THIS METHOD> B<DO NOT MODIFY THE TASK HASHREF> Returns a positive true value if the resource is available. Returns false if the resource is not available, but will be in the future (IE in use by another test, but will be free when that test is done). Returns a negative value if the resource is not available and never will be. This will cause any tests dependent on the resource to be skipped. If the C<--fail-on-resource-skip> flag is set, these tests will be marked as failures instead of skips. The only key in C<\%task> hashref that most resources will care about is the C<'file'> key, which contains the test file to be run. =item $res->assign(\%task, \%state) B<DO NOT MODIFY THE TASK HASHREF> B<DO NOT MODIFY ANY INTERNAL STATE IN THIS METHOD> If the task does not need any resources you may simply return. If resources are needed you should deduce what resources to assign. You should put any data needed to update the internal state of your resource instance in the C<< $state->{record} >> hash key. It B<WILL> be serialized to JSON before being used as an argument to C<record()>. $state->{record} = $id; If you do not set the 'record' key, or set it to undef, then the C<record()> method will not be called. If your tests need to know what resources to use, you may set environment variables and/or command line arguments to pass into the test (C<@ARGV>). $state->{env_vars}->{FOO_ID} = $id; push @{$state->{args}} => $id; The C<\%state> hashref is used only by your instance, you are free to fully replace the 'env_vars' and 'args' keys. They will eventually be merged into a master state along with those of other resources, but this ref is exclusive to you in this method. =item $inst->record($job_id, $record_arg_from_assign) B<NOTE: THIS MAY BE CALLED IN MULTIPLE PROCESSES CONCURRENTLY>. This will be called in all processes so that your instance can update any internal state. The C<$job_id> variable contains the id for the job to which the resource was assigned. You should use this to record any internal state. The $job_id will be passed to C<release()> when the job completes and no longer needs the resource. This is intended only for modifying internal state, you should not do anything in this sub that will explode if it is also done in another process at the same time with the same arguments. For example creating a database should not be done here, multiple processes will fight to do the create. The creation, if necessary should be done in C<assign()> which will be called in only one process. =item $inst->release($job_id) B<NOTE: THIS MAY BE CALLED IN MULTIPLE PROCESSES CONCURRENTLY>. This will be called for every test job that completes, even if it did not use this resource. If the job_id did not use the resource you may simply return, otherwise update the internal state to reflect that the resource is no longer in use. This is intended only for modifying internal state, you should not do anything in this sub that will explode if it is also done in another process at the same time with the same arguments. For example deleting a database should not be done here, multiple processes will fight to do the delete. C<assign()> is the only method that will be run in a single process, so if a database needs to be cleaned before it can be used you should clean it there. Any final cleanup should be done in C<cleanup()> which will only be called by one process at the very end. =item $inst->cleanup() This will be called once by the parent runner process just before it exits. This is your chance to do any final cleanup tasks such as deleting databases that are no longer going to be used by tests as no more will be run. =item $inst->tick() This is called by only 1 process at a time and gives you a way to do extra stuff at a regular interval without other processes trying to do the same work at the same time. For example, if a database is left in a dirty state after it is released, you can fire off a cleanup action here knowing no other process will run it at the same time. You can also be sure no record messages will be sent while this sub is running as the process it runs in has a lock. =item $inst->refresh() Called once before each resource-request loop. This is your chance to do things between each set of requests for resources. =item $bool = $inst->job_limiter() True if your resource is intended as a job limiter (IE alternative to specifying C<-jN> at the command line). =item $int = $inst->job_limiter_max() Max number of jobs this will allow at the moment, if this resource is a job limiter. =item $bool = $inst->job_limiter_at_max() True if the limiter has reached its maximum number of running jobs. This is used to avoid a resource-allocation loop as an optimization. =item $number = $inst->sort_weight() Used to sort resources if you want them to be checked in a specific order. For most resources this defaults to 50. For job_limiter resources this defaults to 100. Lower numbers are sorted to the front of the list, IE they are acquired first, before other resources. Job slots are sorted later (100) so that we do not try to grab a job slot if other resources are not available. Most of the time order will not matter, however with Shared job slots we have a race with other test runs to get slots, and checking availability is enough to consume a slot, even if other resources are not available. =item $string = $inst->status_lines() Get a (multi-line) string with status info for this resource. This is used to populate the output for the C<yath resources> command. The default implementation will build a string from the data provided by the C<status_data()> method. =item $arrayref = $inst->status_data() The default implementation returns an empty list. This should return status data that looks like this: return [ { title => "Resource Group Title", tables => [ { header => \@columns, rows => [ \@row1, \@row2, ], # Optional fields ################## # formatting for fields in rows format => [undef, undef, 'duration', ...], # Title for the table title => "Table Title", # Options to pass to Term::Table if/when it the data is used in Term::Table term_table_opts => {...}, }, # Any number of tables is ok {...}, ], }, # Any number of groups is ok {...}, ]; Currently the only supported formats are 'default' (undef), and 'duration'. Duration takes a stamp and tells you how much time has passed since the stamp. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������Settings��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21612� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Prefix.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 10006�15267772575� 23562� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Settings����������������������������������������������������������������������������������������������������������������������package Test2::Harness::Settings::Prefix; use strict; use warnings; our $VERSION = '1.000182'; use Carp(); use Test2::Harness::Util(); sub new { my $class = shift; my $hash = {@_}; return bless \$hash, $class; } sub vivify_field { my $self = shift; my ($field) = @_; return \(${$self}->{$field}); } sub check_field { my $self = shift; my ($field) = @_; return exists ${$self}->{$field}; } sub field : lvalue { my $self = shift; my ($field, @args) = @_; Carp::croak("Too many arguments for field()") if @args > 1; Carp::croak("The '$field' field does not exist") unless exists ${$self}->{$field}; (${$self}->{$field}) = @args if @args; return ${$self}->{$field}; } sub remove_field { my $self = shift; my ($field) = @_; delete ${$self}->{$field}; } our $AUTOLOAD; sub AUTOLOAD : lvalue { my $this = shift; my $field = $AUTOLOAD; $field =~ s/^.*:://g; return if $field eq 'DESTROY'; Carp::croak("Method $field() must be called on a blessed instance") unless ref($this); Carp::croak("Too many arguments for $field()") if @_ > 1; $this->field($field, @_); } sub TO_JSON { my $self = shift; return {%$$self}; } sub build { my $self = shift; my ($class, @args) = @_; require(Test2::Harness::Util::mod2file($class)); return $class->new(%$$self, @args); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Settings::Prefix - Abstraction of a settings category, aka prefix. =head1 DESCRIPTION This class represents a settings category (prefix). =head1 SYNOPSIS # You will rarely if ever need to construct settings yourself, usually a # component of Test2::Harness will expose them to you. my $settings = $thing->settings; my $display = $settings->display; # Once you have your prefix you can read data from it: my $verbose = $display->verbose; # If you dislike autoload methods you can use the 'field' method: my $verbose = $display->field('verbose'); # You can also change values: $display->field(verbose => 1); # You can also use the autoloaded method as an lvalue, but this breaks on # perls older than 5.16, so it is not used internally, and you should only # use it if you know you will never need an older perl: $display->verbose = 1; =head1 METHODS Note that any field that does not conflict with the predefined methods can be accessed via AUTOLOAD generating the methods as needed. =over 4 =item $scalar_ref = $prefix->vivify_field($field_name) This will force a field into existence. It returns a scalar reference to the field which can be used to set the value: my $vref = $display->vivify_field('verbose'); # Create or find field ${$vref} = 1; # set verbosity to 1 =item $bool = $prefix->check_field($field_name) Check if a field is defined or not. =item $val = $prefix->field($field_name) =item $val = $prefix->$field_name =item $prefix->field($field_name, $val) =item $prefix->$field_name = $val Retrieve or set the value of the specified field. This will throw an exception if the field does not exist. B<Note>: The lvalue form C<< $prefix->$field_name = $val >> breaks on perls older then 5.16. =item $thing = $prefix->build($class, @args) This will create an instance of C<$class> passing the key/value pairs from the prefix as arguments. Additional arguments can be provided in C<@args>. =item $hashref = $prefix->TO_JSON() This method allows settings to be serialized into JSON. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������JSONL.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 3352�15267772575� 23174� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util/File���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::File::JSONL; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Util::JSON qw/encode_json decode_json/; use parent 'Test2::Harness::Util::File::Stream'; use Test2::Harness::Util::HashBase; sub decode { shift; decode_json($_[0]) } sub encode { shift; encode_json(@_) . "\n" } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::JSONL - Utility class for a JSONL file (stream) =head1 DESCRIPTION Subclass of L<Test2::Harness::Util::File> and L<Test2::Harness::Util::File::Stream> which automatically handles encoding/decoding JSONL data. =head1 SYNOPSIS use Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => '/path/to/file.jsonl'); while (1) { my @items = $jsonl->poll(max => 1000) or last; for my $item (@items) { ... handle $item ... } } or use Test2::Harness::Util::File::JSONL; my $jsonl = Test2::Harness::Util::File::JSONL->new(name => '/path/to/file.jsonl'); $jsonl->write({my => 'item', ... }); ... =head1 SEE ALSO See the base classes L<Test2::Harness::Util::File> and L<Test2::Harness::Util::File::Stream> for methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Value.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 3343�15267772575� 23363� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util/File���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::File::Value; use strict; use warnings; our $VERSION = '1.000182'; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase; sub init { my $self = shift; $self->{+DONE} = 1; } sub read { my $self = shift; my $out = $self->SUPER::read(@_); chomp($out) if defined $out; return $out; } sub read_line { my $self = shift; my $out = $self->SUPER::read_line(@_); chomp($out) if defined $out; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::Value - Utility class for a file that contains exactly 1 value. =head1 DESCRIPTION This is a subclass of L<Test2::Harness::Util::File> for files expected to have exactly 1 value stored in them. =head1 SYNOPSIS use Test2::Harness::Util::File::Value; my $vf = Test2::Harness::Util::File::Value->new(name => 'path/to/file'); my $val = $vf->read; =head1 METHODS =over 4 =item $val = $vf->read() Read all contents from the file, C<chomp()> it, and return it. =item $val = $vf->read_line() Read the first line from the file, C<chomp()> it, and return it. Note, this may not return anything if the value in the file does not terminate with a newline. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 1566�15267772575� 23733� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage/lib����������������������������������������������������������������������������������������������������������������������package Plugin; use strict; use warnings; use parent 'App::Yath::Plugin'; sub changed_files { return () unless $ENV{TEST_CASE}; return (['Ax.pm']) if $ENV{TEST_CASE} eq 'Ax'; return (['Bx.pm']) if $ENV{TEST_CASE} eq 'Bx'; return (['Cx.pm']) if $ENV{TEST_CASE} eq 'Cx'; return (['Bx.pm', 'b']) if $ENV{TEST_CASE} eq 'Bxb'; return (['Cx.pm', 'c']) if $ENV{TEST_CASE} eq 'Cxc'; return (['Ax.pm', '*']) if $ENV{TEST_CASE} eq 'Ax*'; return (['Ax.pm', 'a']) if $ENV{TEST_CASE} eq 'Axa'; return (['Ax.pm', 'aa']) if $ENV{TEST_CASE} eq 'Axaa'; return (['Ax.pm', 'aa', 'a']) if $ENV{TEST_CASE} eq 'Axaaa'; return (['Ax.pm', 'a'], ['Cx.pm', 'c']) if $ENV{TEST_CASE} eq 'AxCx'; return (); } 1; ������������������������������������������������������������������������������������������������������������������������������������������notok.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 120�15267772575� 24053� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; ok($ENV{FAILURE_DO_PASS}, "check env"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������simple_test.tx��������������������������������������������������������������������������������������100644��001750��001750�� 126�15267772575� 24100� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'TestSimplePreload.pm'}, "Preload is loaded"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������t���������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22266� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar����������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 465�15267772575� 23736� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar/t��������������������������������������������������������������������������������������������������������������������use Test2::V0; use Bar; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Foo }, qr{Loaded Foo.pm from the wrong project}, "Using our own libs (Foo)"); like(dies { require Baz }, qr{Loaded Baz.pm from the wrong project}, "Using our own libs (Baz)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������t���������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22276� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz����������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 465�15267772575� 23746� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz/t��������������������������������������������������������������������������������������������������������������������use Test2::V0; use Baz; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Foo }, qr{Loaded Foo.pm from the wrong project}, "Using our own libs (Foo)"); like(dies { require Bar }, qr{Loaded Bar.pm from the wrong project}, "Using our own libs (Bar)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������t���������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22305� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo����������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 465�15267772575� 23755� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo/t��������������������������������������������������������������������������������������������������������������������use Test2::V0; use Foo; is(__FILE__, 't/pass.tx', "__FILE__ is set correctly"); like(dies { require Bar }, qr{Loaded Bar.pm from the wrong project}, "Using our own libs (Bar)"); like(dies { require Baz }, qr{Loaded Baz.pm from the wrong project}, "Using our own libs (Baz)"); ok(1, "Pass"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������reload_syntax_error.tx������������������������������������������������������������������������������100644��001750��001750�� 150�15267772575� 24204� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; my ($want) = @ARGV; is($Preload::Flux::VAR, $want, "Var set as expected"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������retry-timeout���������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22257� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������retry.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 1376�15267772575� 24150� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/retry-timeout���������������������������������������������������������������������������������������������������������������������# HARNESS-TIMEOUT-EVENT 20 # The first try hangs and has to be killed by that timeout, so it is the floor # on how long this test takes. It still has to be long enough that a loaded # machine cannot trip it while perl is loading Test2::V0 on the retry, which is # a stretch of silence this test does not control. use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; pass("Test Start"); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; if ( $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1 ) { sleep 1 while 1; } pass("Final Test"); done_testing(); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-symlinks���������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22254� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������_base.xt��������������������������������������������������������������������������������������������100644��001750��001750�� 246�15267772575� 24024� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-symlinks���������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all( "Do Not Run on the Main base.t" ) if $0 =~ m{\Q/_base.xt\E$}; like $0, qr{symlink_to_base\.xt}, q[symlink preserved in $0]; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Stall�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21545� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������Capture.t�������������������������������������������������������������������������������������������100644��001750��001750�� 7260�15267772575� 23502� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Stall����������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Stall::Capture'; # HARNESS-DURATION-SHORT use ok $CLASS; use File::Temp qw/tempdir/; sub capture { return $CLASS->new(workdir => tempdir(CLEANUP => 1)); } subtest catches_usr1 => sub { my $one = capture(); # Pin the signal number: it is 10 here but 30 on the BSDs and Darwin and # 16 on Solaris, and this subtest is about parsing the mask, not about # what the local number happens to be. my $mock = mock $CLASS => (override => [usr1_number => sub { 10 }]); # SigCgt is a hex mask of caught signals; with SIGUSR1 at 10 that is bit 9. ok($one->catches_usr1({sigcgt => '0000000000000200'}), "usr1 caught"); ok($one->catches_usr1({sigcgt => '0000000180014a03'}), "usr1 among others"); ok(!$one->catches_usr1({sigcgt => '0000000000000100'}), "a neighbouring signal is not usr1"); ok(!$one->catches_usr1({sigcgt => '0000000000000000'}), "nothing caught"); ok(!$one->catches_usr1({}), "no field at all"); ok(!$one->catches_usr1({sigcgt => 'not-hex'}), "unparseable"); }; # SIGUSR1's default action is to terminate. A test job sheds the handler when # the runner restores the original %SIG, so signalling one kills a running # test; and a pid recorded earlier may have exited and been recycled. subtest signal_pids_refuses_anything_that_did_not_install_the_handler => sub { my $one = capture(); my @killed; # have_proc must be forced: without it this subtest signals everything on # any platform that has no /proc, and this file ships to CPAN smokers. my $mock = mock $CLASS => ( override => [ have_proc => sub { 1 }, usr1_number => sub { 10 }, kill_pid => sub { push @killed => $_[1]; 1 }, ], ); my $procs = { 100 => {pid => 100, sigcgt => '0000000000000200'}, # ours 200 => {pid => 200, sigcgt => '0000000000000000'}, # shed it 300 => {pid => 300, gone => 1}, # exited 400 => {pid => 400, sigcgt => '0000000000000200', gone => 1}, # exited }; my $sent = $one->signal_pids([100, 200, 300, 400, 500], $procs); is($sent, [100], "only the process catching SIGUSR1"); is(\@killed, [100], "and only that one was signalled"); }; subtest signal_pids_never_signals_a_process_group => sub { my $one = capture(); my @killed; my $mock = mock $CLASS => ( override => [ have_proc => sub { 1 }, kill_pid => sub { push @killed => $_[1]; 1 }, ], ); # A negative pid means a process group to kill(), which must never happen. my $sent = $one->signal_pids([-1, -100, 0], {-100 => {sigcgt => '0000000000000200'}}); is($sent, [], "nothing signalled"); is(\@killed, [], "kill was never called"); }; subtest process_tree_parses_a_comm_containing_spaces_and_parens => sub { my $one = capture(); # /proc/PID/stat puts comm in parens and it may contain anything, so ppid # has to be read after the last ')'. my $mock = mock $CLASS => ( override => [ have_proc => sub { 1 }, all_pids => sub { [10, 11, 12] }, read_proc => sub { my ($self, $pid, $what) = @_; return unless $what eq 'stat'; return "10 (yath) S 1 10 10 0 -1 0" if $pid == 10; return "11 (weird (name) here) S 10 1 1" if $pid == 11; return "12 (other) S 99 1 1" if $pid == 12; return; }, ], ); is($one->process_tree(10), [10, 11], "found the child despite the parens in its name"); }; done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Test2�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21353� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Formatter�����������������������������������������������������������������������������������������������������������������������������Composer.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 30003�15267772575� 23654� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Formatter/Test2�����������������������������������������������������������������������������������������������������������������������package Test2::Formatter::Test2::Composer; use strict; use warnings; our $VERSION = '1.000182'; use Scalar::Util qw/blessed/; use List::Util qw/first/; sub new { my $class = shift; return bless({}, $class); } sub render_one_line { my $class = shift; my $in = shift; my $f = blessed($in) ? $in->facet_data : $in; return [$f->{render}->[0]->{facet}, uc($f->{render}->[0]->{tag}), $f->{render}->[0]->{details}] if $f->{render} && @{$f->{render}}; return (($class->halt($f))[0]) if $class->{control} && defined $class->{control}->{halt}; for my $type (qw/assert errors plan info times about/) { next unless $f->{$type}; my $m = "render_$type"; my ($out) = $class->$m($f); return $out if defined $out; } return; } sub render_verbose { my $class = shift; my ($in, %params) = @_; my $f = blessed($in) ? $in->facet_data : $in; return [map {[$_->{facet}, uc($_->{tag}), $_->{details}]} @{$f->{render}}] if $f->{render} && @{$f->{render}}; my @out; push @out => $class->render_control($f, %params) if $f->{control}; push @out => $class->render_plan($f) if $f->{plan}; if ($f->{assert}) { push @out => $class->render_assert($f); push @out => $class->render_debug($f) unless $f->{assert}->{pass} || $f->{assert}->{no_debug}; push @out => $class->render_amnesty($f) if $f->{amnesty} && @{$f->{amnesty}}; } push @out => $class->render_info($f) if $f->{info}; push @out => $class->render_errors($f) if $f->{errors}; push @out => $class->render_about($f) if $f->{about} && !(@out || first { $f->{$_} } qw/stop plan info nest assert/); return \@out; } sub render_super_verbose { my $class = shift; my ($in) = @_; my $out = $class->render_verbose($in, super_verbose => 1); my $f = blessed($in) ? $in->facet_data : $in; push @$out => $class->render_launch($f) if $f->{harness_job_launch}; push @$out => $class->render_start($f) if $f->{harness_job_start}; push @$out => $class->render_exit($f) if $f->{harness_job_exit}; push @$out => $class->render_end($f) if $f->{harness_job_end}; unless (@$out) { my ($name, $fallback); for my $k (sort keys %$f) { my $v = $f->{$k}; # Fallback should be longest harness* facet name $fallback = $k if $k =~ m/harness/ && (!$fallback || length($fallback) < length($k)); my $list = ref($v) eq 'ARRAY' ? $v : [$v]; for my $i (@$list) { next unless ref($i); last if $name = $i->{details}; } } $name //= $fallback // join ', ' => sort keys %$f; push @$out => ['harness', 'HARNESS', $name]; } return $out; } sub render_launch { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', 'Job Launched at ' . $f->{harness_job_launch}->{stamp}]; } sub render_start { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', $f->{harness_job_start}->{details}]; } sub render_exit { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', $f->{harness_job_exit}->{details}]; } sub render_end { my $class = shift; my ($f) = @_; return ['harness', 'HARNESS', "Job completed at " . $f->{harness_job_end}->{stamp}]; } sub render_control { my $class = shift; my ($f, %params) = @_; my @out; push @out => ['control', 'HALT', $f->{control}->{details}] if defined $f->{control}->{halt}; return @out unless $params{super_verbose}; push @out => ['control', 'ENCODING', $f->{control}->{encoding}] if $f->{control}->{encoding}; return @out if @out; return ['control', 'CONTROL', $f->{control}->{details}] if defined $f->{control}->{details}; return; } my %SHOW_BRIEF_TAGS = ( 'CRITICAL' => 1, 'DEBUG' => 1, 'DIAG' => 1, 'ERROR' => 1, 'FAIL' => 1, 'FAILED' => 1, 'FATAL' => 1, 'HALT' => 1, 'PASSED' => 1, 'REASON' => 1, 'STDERR' => 1, 'TIMEOUT' => 1, 'WARN' => 1, 'WARNING' => 1, 'KILL' => 1, 'SKIPPED' => 1, ); my %SHOW_BRIEF_FACETS = ( control => 1, error => 1, trace => 1, ); sub render_brief { my $class = shift; my $in = shift; my $f = blessed($in) ? $in->facet_data : $in; if ($f->{render} && @{$f->{render}}) { my @show = grep { $SHOW_BRIEF_TAGS{uc($_->{tag})} || $SHOW_BRIEF_FACETS{lc($_->{facet})} } @{$f->{render}}; return [map { [$_->{facet}, uc($_->{tag}), $_->{details}] } @show]; } my @out; push @out => $class->render_control($f) if $f->{control}; if ($f->{assert} && !$f->{assert}->{pass} && !$f->{amnesty}) { push @out => $class->render_assert($f); push @out => $class->render_debug($f) unless $f->{assert}->{no_debug}; } if ($f->{info}) { my $if = {%$f, info => [grep { $_->{debug} || $_->{important} } @{$f->{info}}]}; push @out => $class->render_info($if) if @{$if->{info}}; } push @out => $class->render_errors($f) if $f->{errors}; return \@out; } sub render_plan { my $class = shift; my ($f) = @_; my $plan = $f->{plan}; return ['plan', 'NO PLAN', $f->{plan}->{details}] if $plan->{none}; if ($plan->{skip}) { return ['plan', 'SKIP ALL', $f->{plan}->{details}] if $f->{plan}->{details}; return ['plan', 'SKIP ALL', "No reason given"]; } return ['plan', 'PLAN', "Expected assertions: $f->{plan}->{count}"]; } sub render_assert { my $class = shift; my ($f) = @_; my $name = $f->{assert}->{details} || '<UNNAMED ASSERTION>'; return ['assert', '! PASS !', $name] if $f->{amnesty} && @{$f->{amnesty}}; return ['assert', 'PASS', $name] if $f->{assert}->{pass}; return ['assert', 'FAIL', $name] } sub render_amnesty { my $class = shift; my ($f) = @_; my %seen; return map { $seen{join '' => @{$_}{qw/tag details/}}++ ? () : ['amnesty', $_->{tag}, $_->{details}] } @{$f->{amnesty}}; } sub render_debug { my $class = shift; my ($f) = @_; my $name = $f->{assert}->{details}; my $trace = $f->{trace}; my $debug; if ($trace) { $debug = $trace->{details}; if(!$debug && $trace->{frame}) { my $frame = $trace->{frame}; $debug = "$frame->[1] line $frame->[2]"; } } $debug ||= "[No trace info available]"; chomp($debug); return ['trace', 'DEBUG', $debug]; } sub render_info { my $class = shift; my ($f) = @_; return map { my $details = $_->{details} // ''; my $msg; if (ref($details)) { require Data::Dumper; my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Useqq(1)->Sortkeys(1); chomp($msg = $dumper->Dump); } else { chomp($msg = $details); } ['info', $_->{tag}, $details, $_->{table} || ()] } @{$f->{info}}; } sub render_about { my $class = shift; my ($f) = @_; return if $f->{about}->{no_display}; return unless $f->{about} && $f->{about}->{details}; my $type; if ($f->{about}->{package}) { my $type = $f->{about}->{package}; $type =~ s/^.*:://; } $type //= 'ABOUT'; return ['about', $type, $f->{about}->{details}]; } sub render_errors { my $class = shift; my ($f) = @_; return map { my $details = $_->{details}; my $msg; if (ref($details)) { require Data::Dumper; my $dumper = Data::Dumper->new([$details])->Indent(2)->Terse(1)->Useqq(1)->Sortkeys(1); chomp($msg = $dumper->Dump); } else { chomp($msg = $details); } my $tag = $_->{tag} || ($_->{fail} ? 'FATAL' : 'ERROR'); ['error', $tag, $details] } @{$f->{errors}}; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Formatter::Test2::Composer - Compose output components from event facets =head1 DESCRIPTION This is used by L<Test2::Formatter::Test2> to turn events into output components. This logic lives here instead of in the formatter because it is also used by L<Test2::Harness::UI>. Other tools may also find this conversion useful. =head1 SYNOPSIS use Test2::Formatter::Test2::Composer; # Note, all methods are class methods, this is just here for convenience. my $comp = Test2::Formatter::Test2::Composer->new(); my $out = $comp->render_one_line($event); my ($facet_name, $tag_string, $text_for_humans) = @$out; ... for my $line ($comp->render_verbose($event)) { my ($facet_name, $tag_string, $text_for_humans) = @$line; ..., } =head1 METHODS All methods are class methods, but they also work just fine on a blessed instance. There is no benefit to a blessed instance, but you can create one for convenience if it makes you more comfortable. =over 4 =item $inst = $class->new() Create a blessed instance. This is here for convenience only. All methods are class methods. =item $arrayref = $class->render_one_line($event) =item $arrayref = $class->render_one_line(\%facet_data) my $out = $comp->render_one_line($event); my ($facet_name, $tag_string, $text_for_humans) = @$out; This will return a single line of output from the event, even if the event would normally return multiple lines. In order of priority: =over 4 =item Custom 'render' facet =item Control 'halt' facet (bail-out) =item Assertion (pass/fail) =item Error message =item Plan =item Info (note/diag) =item Timing data =item About =back =item @lines = $class->render_verbose($event, %control_params) =item @lines = $class->render_verbose(\%facet_data, %control_params) This will verbosely render any event. The C<%control_params> are passed directly to C<render_control()> and are not used for anything else. for my $line ($comp->render_verbose($event)) { my ($facet_name, $tag_string, $text_for_humans) = @$line; ..., } =item @lines = $class->render_super_verbose($event) =item @lines = $class->render_super_verbose(\%facet_data) This is even more verbose than C<render_verbose()> because it produces output lines even for facets that should normally not be seen, things that would usually be considered noise. This is mainly useful for tools that allow deep inspection of log files. =back =head2 FACET RENDERERS With exception of C<render_control()> these are all the same. These all take C<\%facet_data> as their only argument, and return a list of line-arrayrefs C<[$facet, $tag, $text_for_humans]>. =over 4 =item @lines = $class->render_control(\%facet_data, super_verbose => $bool) This specific one is special in that it can take an extra argument. This argument is used to toggle between super_verbose and regular verbosity. No other facet renderer needs this toggle. If omitted it defaults to not being super verbose. =item @lines = $class->render_launch(\%facet_data) =item @lines = $class->render_start(\%facet_data) =item @lines = $class->render_exit(\%facet_data) =item @lines = $class->render_end(\%facet_data) =item @lines = $class->render_brief(\%facet_data) =item @lines = $class->render_plan(\%facet_data) =item @lines = $class->render_assert(\%facet_data) =item @lines = $class->render_amnesty(\%facet_data) =item @lines = $class->render_debug(\%facet_data) =item @lines = $class->render_info(\%facet_data) =item @lines = $class->render_about(\%facet_data) =item @lines = $class->render_errors(\%facet_data) =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Collector�������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21740� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������JobDir.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 57104�15267772575� 23636� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Collector���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Collector::JobDir; use strict; use warnings; our $VERSION = '1.000182'; use File::Spec(); use Errno qw/EMFILE ENFILE/; use Carp qw/croak/; use Time::HiRes qw/time/; use List::Util qw/first/; use Test2::Util qw/ipc_separator/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use Test2::Harness::Util qw/maybe_read_file open_file apply_encoding/; use Test2::Harness::Event; use Test2::Harness::Util::File::Stream; use Test2::Harness::Util::File::JSONL; use Test2::Harness::Util::File::Value; use Test2::Harness::Collector::TapParser qw{ parse_stdout_tap parse_stderr_tap }; use Test2::Harness::Util::HashBase qw{ <run_id <job_id <job_try <job_root <runner_pid <done -_ready_buffer -_events_files -_events_buffer -_events_indexes -events_dir -_events_seen -stderr_file -_stderr_buffer -_stderr_index -_stderr_cg -_stderr_state -stdout_file -_stdout_buffer -_stdout_index -_stdout_cg -_stdout_state -exit_file -_exit_done -_exit_buffer -et_file -et_buffer -et_done -pet_file -pet_buffer -pet_done -last_stamp -open_errors -open_error_seen }; sub init { my $self = shift; croak "'run_id' is a required attribute" unless $self->{+RUN_ID}; croak "'job_id' is a required attribute" unless $self->{+JOB_ID}; croak "'job_root' is a required attribute" unless $self->{+JOB_ROOT}; $self->{+_EVENTS_SEEN} = {}; $self->{+_STDOUT_BUFFER} ||= []; $self->{+_STDERR_BUFFER} ||= []; $self->{+_EVENTS_BUFFER} ||= {}; $self->{+_READY_BUFFER} ||= []; $self->{+LAST_STAMP} = time(); } sub poll { my $self = shift; my ($max) = @_; delete $self->{+OPEN_ERRORS}; $self->_fill_buffers($max); return @{delete $self->{+OPEN_ERRORS}} if $self->{+OPEN_ERRORS}; my (@out, @new); # If we have a max number of events then we need to pass that along to the # inner-pollers, but we need to pass around how many MORE we need, this sub # will return the amount we still need. # If this finds that we do not need any more it will exit the loop instead # of returning a number. my $check = defined($max) ? sub { my $want = $max - scalar(@out) - scalar(@new); return undef if $want < 1; return $want; } : sub { 1 }; while (!defined($max) || @out < $max) { push @new => $self->_poll_streams($check->() // last); push @new => $self->_poll_timeouts($check->() // last) if $self->{+ET_BUFFER} || $self->{+PET_BUFFER}; # 'exit' MUST come last, so do not even think about grabbing # them until @new is empty. # Micro-optimization, 'exit' only ever has 1 thing, so do # not enter the subs if we do not need to. push @new => $self->_poll_exit($check->() // last) if !@new && defined $self->{+_EXIT_BUFFER}; # We need to check if the runner exited BEFORE trying to check the exit value. last unless @new; push @out => @new; @new = (); } return map { my $stamp = $_->{stamp} ? $self->{+LAST_STAMP} = $_->{stamp} : $self->{+LAST_STAMP}; Test2::Harness::Event->new(stamp => $stamp, %{$_}); } @out; } sub _poll_streams { my $self = shift; my ($max) = @_; my $ready = $self->{+_READY_BUFFER}; return splice(@$ready, 0, $max) unless @$ready < $max; my $stdout = $self->{+_STDOUT_BUFFER}; my $stdout_cg = $self->{+_STDOUT_CG} ||= []; my $stdout_params = { buffer => $stdout, comment_group => $stdout_cg, tag => 'STDOUT', debug => 0, parser => \&parse_stdout_tap, max => $max, }; my $stderr = $self->{+_STDERR_BUFFER}; my $stderr_cg = $self->{+_STDERR_CG} ||= []; my $stderr_params = { buffer => $stderr, comment_group => $stderr_cg, tag => 'STDERR', debug => 1, parser => \&parse_stderr_tap, max => $max, }; my $out_event = $self->_poll_stream($stdout_params); my $err_event = $self->_poll_stream($stderr_params); # Once both stderr and stdout are waiting for an event we should go ahead # and stick the events into ready. More often than not both streams will be # waiting for the same event, the read_buffer_event logic will avoid # duplicates. We want to call it on both buffers because some IPC # situations can result in both streams waiting for different events. Also # we need the sync point removed from both buffers so things can continue. # This is an intentional bottle-neck that keeps STDOUT, STDERR, and the # Test2 events in sync so that stderr and stdout appear where they should # (mostly) relative to the events. This is not perfect, but it is as close # as we can get when recombining 3+ output streams. if ($out_event && $err_event) { $self->_poll_streams_ready_buffer_event($stdout); $self->_poll_streams_ready_buffer_event($stderr); } if ($self->{+_EXIT_DONE} && (!$max || @$ready < $max)) { # All done, flush the comment groups $self->_poll_stream_flush_group($stdout_params) if @$stdout_cg; $self->_poll_stream_flush_group($stderr_params) if @$stderr_cg; $self->_poll_streams_flush_events(); } return splice(@$ready, 0, $max); } sub _poll_streams_flush_events { my $self = shift; my $buffers = $self->{+_EVENTS_BUFFER}; for my $pid (keys %$buffers) { for my $tid (keys %{$buffers->{$pid}}) { my $buffer = $buffers->{$pid}->{$tid} or next; while(my $e = shift @$buffer) { $e = ref($e) ? $e : decode_json($e); push @{$self->{+_READY_BUFFER}} => $self->_process_events_line($e); } } } } sub _poll_streams_ready_buffer_event { my $self = shift; my ($buffer) = @_; my $set = shift @$buffer; my ($pid, $tid, $sid) = @$set; my $seen = $self->{+_EVENTS_SEEN}; return if $seen->{$tid}->{$pid}->{$sid}; my $e = shift @{$self->{+_EVENTS_BUFFER}->{$pid}->{$tid}} or return; $seen->{$tid}->{$pid}->{$sid} = 1; $e = ref($e) ? $e : decode_json($e); die "Stream error: Events skipped or recieved out of order ($e->{stream_id} != $sid)" if $e->{stream_id} != $sid; push @{$self->{+_READY_BUFFER}} => $self->_process_events_line($e); } sub _poll_stream_add_event { my $self = shift; my ($line, $params) = @_; my $parser = $params->{parser}; my $tag = $params->{tag}; my $debug = $params->{debug}; my $facet_data = $parser->($line); $facet_data ||= {info => [{details => $line, tag => $tag, debug => $debug}]}; my $event_id = $facet_data->{about}->{uuid} ||= gen_uuid(); push @{$self->{+_READY_BUFFER}} => { facet_data => $facet_data, event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, }; } sub _poll_stream_flush_group { my $self = shift; my ($params) = @_; my $comment_group = $params->{comment_group}; return unless @$comment_group; shift @$comment_group; # Remove the indentation state my $line = join "\n" => @$comment_group; $self->_poll_stream_add_event($line, $params); @$comment_group = (); } sub _poll_stream_buffer_group { my $self = shift; my ($line, $params) = @_; return undef unless $line =~ m/^(\s*)#/; my $indent = $1; my $comment_group = $params->{comment_group}; if (@$comment_group && $comment_group->[0] ne $indent) { # If comment indentation has changed we do not want to append to the group $self->_poll_stream_flush_group($params); return 1; } else { # Starting a new group push @$comment_group => $indent; } push @$comment_group => $line; shift @{$params->{buffer}}; return 0; } sub _poll_stream { my $self = shift; my ($params) = @_; my $max = $params->{max}; my $buff = $params->{buffer}; my $comment_group = $params->{comment_group}; my $added = 0; while (@$buff && (!$max || $added < $max)) { my $line = $buff->[0]; # Already have an esync waiting return 1 if ref $line; chomp($line); my $esync = $self->_poll_stream_process_harness_line($line, $params); return 1 if $esync; # Put 'comment' lines together in a group, IE buffer this until we are done with comments # get undef if there was no comment to buffer # get 1 if we had to flush the buffer and start a new one # get 0 if we did buffer the event, but no flush my $stat = $self->_poll_stream_buffer_group($line, $params); if (defined($stat)) { $added += $stat; next; } # non-comment line, flush the comment group if (@$comment_group) { $self->_poll_stream_flush_group($params); $added++; next; } shift @$buff; $self->_poll_stream_add_event($line, $params); $added++; } return 0; } sub _poll_stream_process_harness_line { my $self = shift; my ($line, $params) = @_; my $job_id = $self->{+JOB_ID}; return undef unless $line =~ s/T2-HARNESS-\Q$job_id\E-(ESYNC|EVENT): (.+)//; my ($type, $data) = ($1, $2); my $esync; if ($type eq 'ESYNC') { $esync = [split ipc_separator() => $data]; } elsif ($type eq 'EVENT') { my $event_data = decode_json($data); my $pid = $event_data->{pid}; my $tid = $event_data->{tid}; my $sid = $event_data->{stream_id}; push @{$self->{+_EVENTS_BUFFER}->{$pid}->{$tid}} => $event_data; $esync = [$pid, $tid, $sid]; } else { die "Unexpected harness type: $type"; } # This becomes the esync, anything leftover actually belongs to the # next line. my $buff = $params->{buffer}; $buff->[0] = $esync; $buff->[1] = defined($buff->[1]) ? $line . $buff->[1] : $line if length $line; # Flush any comment group already buffered, an event is a sane # boundary, not above that partial comments that might be # interrupted by the sync point will be part of the next group $self->_poll_stream_flush_group($params); return $esync; } my %FILE_MAP = ( 'stdout' => [STDOUT_FILE, \&open_file], 'stderr' => [STDERR_FILE, \&open_file], 'exit' => [EXIT_FILE, 'Test2::Harness::Util::File::Value'], 'event_timeout' => [ET_FILE, 'Test2::Harness::Util::File::Value'], 'post_exit_timeout' => [PET_FILE, 'Test2::Harness::Util::File::Value'], ); sub _open_file { my $self = shift; my ($file) = @_; my $map = $FILE_MAP{$file} or croak "'$file' is not a known job file"; my ($key, $type) = @$map; return $self->{$key} if $self->{$key}; my $path = File::Spec->catfile($self->{+JOB_ROOT}, $file); my $out; if (ref $type) { return undef unless -e $path; return $self->{$key} = $self->try_open($path => sub { $type->($path, '<') }); } return $self->{$key} = $self->try_open($path => sub { $type->new(name => $path) }); } sub _fill_stream_buffers { my $self = shift; my ($max) = @_; my $stdout_state = $self->{+_STDOUT_STATE} //= {}; my $stderr_state = $self->{+_STDERR_STATE} //= {}; my $stdout_buff = $self->{+_STDOUT_BUFFER} ||= []; my $stderr_buff = $self->{+_STDERR_BUFFER} ||= []; my $stdout_file = $self->{+STDOUT_FILE} || $self->_open_file('stdout'); my $stderr_file = $self->{+STDERR_FILE} || $self->_open_file('stderr'); return unless $stdout_file && $stderr_file; my @sets = grep { defined $_->[0] } ( [$stdout_file, $stdout_buff, 'io', 'STDOUT', $stdout_state], [$stderr_file, $stderr_buff, 'io', 'STDERR', $stderr_state], ); return unless @sets; # Cache the result of the exists check on success, files can come into # existence at any time though so continue to check if it fails. while (1) { my $added = 0; my @events_files = $self->events_files(); for my $set (@events_files, @sets) { my ($file, $buff, $type, $name, $state) = @$set; next if $max && @$buff > $max; my $pos = tell($file); my $line = <$file>; if (defined($line) && ($self->{+_EXIT_DONE} || substr($line, -1) eq "\n")) { print "\n" if $state && delete $state->{$pos}; my $job_id = $self->{+JOB_ID}; if ($type eq 'io' && $line =~ s/T2-HARNESS-\Q$job_id\E-ENCODING: (.+)\n$//) { apply_encoding($file, $1); } push @$buff => $line if length($line); seek($file, 0, 1) if eof($file); # Reset EOF. $added++; } else { if ($name && defined($line) && $ENV{YATH_INTERACTIVE}) { my ($fh); if ($name eq 'STDOUT') { $fh = \*STDOUT; } elsif ($name eq 'STDERR') { $fh = \*STDERR; } my $len = length($line); if (my $check = $state->{$pos}->{len}) { if ($len != $check) { delete $state->{$pos}->{done}; $line = substr($line, $check); } else { $line = "\n[INTERACTIVE] $line"; } } else { $line = "\n[INTERACTIVE] $line"; } $state->{$pos}->{len} = $len; my $stamp = $state->{$pos}->{stamp} //= time; my $delta = time - $stamp; if($delta >= 1 && !$state->{$pos}->{done}) { $fh->autoflush(1); $state->{$pos}->{done} = 1; print $fh $line; } } seek($file, $pos, 0); } } last unless $added; } } sub events_files { my $self = shift; my $buff = $self->{+_EVENTS_BUFFER} ||= {}; my $files = $self->{+_EVENTS_FILES} ||= {}; my $dir = File::Spec->catdir($self->{+JOB_ROOT}, 'events'); return unless -d $dir; my $dh; if ($self->try_open($dir => sub { opendir($dh, $dir) or die $! })) { for my $file (readdir($dh)) { next unless '.jsonl' eq substr($file, -6); next if $files->{$file}; my $path = File::Spec->catfile($dir, $file); next if $files->{$file}; my $fh = $self->try_open( $path => sub { [ split(ipc_separator() => substr(substr($file, 6 + length(ipc_separator())), 0, -6)), open_file($path, '<'), ] } ); $files->{$file} = $fh if $fh; } closedir($dh); } return map { [$_->[2] => $buff->{$_->[0]}->{$_->[1]} ||= [], 'jsonl'] } values %$files; } sub try_open { my $self = shift; my ($path, $callback) = @_; local ($@, $?, $!, $.); my $out; my $ok = eval { $out = $callback->(); 1; }; my $errno = $!; my $err = $@; return $out if $ok; die $@ unless $errno == ENFILE || $errno == EMFILE; my $errors = $self->{+OPEN_ERRORS} //= []; unless ($self->{+OPEN_ERROR_SEEN}->{$path}++) { push @$errors => Test2::Harness::Event->new( stamp => time, job_id => 0, job_try => undef, event_id => gen_uuid(), run_id => $self->{+RUN_ID}, facet_data => { info => [{ details => "Could not open '$path', this is NOT FATAL as yath will try again. Errno is '$errno', Exception was: $err", tag => 'INTERNAL', important => 1, }], } ); } return undef; } sub _fill_buffers { my $self = shift; my ($max) = @_; # NOTE 1: 'max' will only effect stdout, stderr, and events.jsonl, the # other files only have 1 value each so they will not eat too much memory. # # NOTE 2: 'max' only effects how many items are ADDED to the buffer, not # how many are in the buffer, that is good enough, poll() will take care of # the actual event limiting. We only use this here to make sure the buffer # grows slowly, this is important if max is used to avoid eating memory. We # still need to add to the buffers each time though in case we are waiting # for a sync event before we flush. # Wait for the directory return unless -d $self->{+JOB_ROOT}; $self->_fill_stream_buffers($max); # Do not look for exit until we are done with the other streams return if $self->{+_EXIT_DONE} || @{$self->{+_STDOUT_BUFFER}} || @{$self->{+_STDERR_BUFFER}} || first { @$_ } map { values %{$_} } values %{$self->{+_EVENTS_BUFFER}}; $self->_open_file('event_timeout'); $self->_open_file('post_exit_timeout'); my $found_timeout = 0; for my $set ([ET_FILE, ET_BUFFER], [PET_FILE, PET_BUFFER]) { my ($key, $buffer_key) = @$set; next if $self->{$buffer_key}; next unless $self->{$key} && $self->{$key}->exists; $self->{$buffer_key} = $self->{$key}->read_line // next; $found_timeout++; } return if $found_timeout; return if $self->{+OPEN_ERRORS}; my $ended = 0; # We need to check if the runner exited BEFORE trying to check the exit value. my $runner_exited = $self->{+RUNNER_PID} && !kill(0, $self->{+RUNNER_PID}); my $exit_file = $self->{+EXIT_FILE} || $self->_open_file('exit') || return; return if $self->{+OPEN_ERRORS}; if ($exit_file->exists) { my $line = $exit_file->read_line; if (defined($line)) { $self->{+_EXIT_BUFFER} = $line; $self->{+_EXIT_DONE} = 1; $ended++; } } elsif ($runner_exited) { $self->{+_EXIT_BUFFER} = '-1'; $self->{+_EXIT_DONE} = 1; $ended++; } return unless $ended; # If we found exit we need one last buffer fill on the other sources. # If we do not do this we have a race condition. Ignore the max for this. $self->_fill_stream_buffers(); } sub _poll_timeouts { my $self = shift; my @out; if (defined $self->{+ET_BUFFER} && !$self->{+ET_DONE}++) { push @out => $self->_process_timeout_line('event' => $self->{+ET_BUFFER}, <<" EOT"); Test2::Harness checks for timeouts at a configurable interval, if a test does not produce any output to stdout or stderr between intervals it will be forcefully killed under the assumption it has hung. See the '--event-timeout' option to configure the interval. EOT } if (defined $self->{+PET_BUFFER} && !$self->{+PET_DONE}++) { push @out => $self->_process_timeout_line('post-exit' => $self->{+ET_BUFFER}, <<" EOT"); Sometimes tests will fork and then return. On supported systems Test2::Harness will start all tests with their own process group and will wait for the entire group to exit before considering the test done. In these cases Test2::Harness will poll for output from the process group at a configurable interval, if no output is produced between intervals the process group will be forcefully killed. See the '--post-exit-timeout' option to configure the interval. EOT } return @out; } sub _poll_exit { my $self = shift; # Intentionally ignoring the max argument, this only ever returns 1 item, # and would not be called if max was 0. return unless defined $self->{+_EXIT_BUFFER}; my $value = delete $self->{+_EXIT_BUFFER}; return $self->_process_exit_line($value); } sub _process_events_line { my $self = shift; my ($event_data) = @_; $event_data->{job_id} = $self->{+JOB_ID}; $event_data->{job_try} = $self->{+JOB_TRY}; $event_data->{run_id} = $self->{+RUN_ID}; $event_data->{event_id} ||= $event_data->{facet_data}->{about}->{uuid} ||= gen_uuid(); return $event_data; } sub _process_exit_line { my $self = shift; my ($value) = @_; chomp($value); my $stdout = maybe_read_file(File::Spec->catfile($self->{+JOB_ROOT}, "stdout")) // ''; my $stderr = maybe_read_file(File::Spec->catfile($self->{+JOB_ROOT}, "stderr")) // ''; $stdout =~ s/T2-HARNESS-\S+-(?:ESYNC|EVENT): .+\n//g; $stderr =~ s/T2-HARNESS-\S+-(?:ESYNC|EVENT): .+\n//g; my $event_id = gen_uuid(); my ($exit, $err, $sig, $dmp, $stamp, $retry) = (split(/\s+/, $value), '', '', '', '', '', ''); $self->{+DONE} = {retry => $retry}; return { event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, stamp => $stamp, facet_data => { about => {uuid => $event_id}, harness_job_exit => { details => "Test script exited $exit ($err\:$sig)", exit => $exit, code => $err, signal => $sig, dumped => $dmp, retry => $retry, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, stdout => $stdout, stderr => $stderr, stamp => $stamp, line => $value, }, } }; } sub _process_timeout_line { my $self = shift; my ($type, $buffer, $reason) = @_; chomp($buffer //= ''); my ($stamp, $delta) = split /\s+/, $buffer; $stamp //= time(); $delta = defined($delta) ? sprintf('%.4f', $delta) : '??'; my $event_id = gen_uuid(); return { event_id => $event_id, job_id => $self->{+JOB_ID}, job_try => $self->{+JOB_TRY}, run_id => $self->{+RUN_ID}, stamp => $stamp, facet_data => { about => {uuid => $event_id, details => "Timeout ($type)"}, errors => [ { tag => 'TIMEOUT', details => "A timeout ($type) has occured (after $delta seconds), job was forcefully killed", fail => 1, }, ], info => [ { tag => 'TIMEOUT', debug => 1, important => 1, details => $reason, }, ], } }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector::JobDir - Job Directory Parser, read events from an active jobs output directory. =head1 DESCRIPTION This module is responsible for reading and parsing a running jobs output directory. The result is an event stream. This module is not intended for external use, it is an implementation detail and can change at any time. Currently instances of this module are not passed to any plugins or callbacks. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Constants.pm����������������������������������������������������������������������������������������100644��001750��001750�� 2333�15267772575� 23736� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Constants; use strict; use warnings; our $VERSION = '1.000182'; use Importer Importer => 'import'; our @EXPORT = qw/CATEGORIES DURATIONS/; use constant CATEGORIES => {general => 1, isolation => 1, immiscible => 1}; use constant DURATIONS => {long => 1, medium => 1, short => 1}; 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Constants - Constants shared between multiple runner modules. =head1 DESCRIPTION Export some common structures. =head1 SYNOPSIS use Test2::Harness::Runner::Constants qw/CATEGORIES DURATIONS/; if (CATEGORIES->{$cat}) { print "$cat is valid\n"; } else { print "$cat is not valid\n"; } =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������DepTracer.pm����������������������������������������������������������������������������������������100644��001750��001750�� 13143�15267772575� 23654� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::DepTracer; use strict; use warnings; use Carp qw/croak/; our $VERSION = '1.000182'; use Test2::Harness::Util::HashBase qw/ -_on -exclude -dep_map -loaded -my_require -real_require -_my_inc -callbacks /; my %DEFAULT_EXCLUDE = ( 'warnings.pm' => 1, 'strict.pm' => 1, ); my $ACTIVE; sub ACTIVE { $ACTIVE } sub start { my $self = shift; croak "There is already an active DepTracer" if $ACTIVE; $ACTIVE = $self; unshift @INC => $self->my_inc; $self->{+_ON} = 1; } sub stop { my $self = shift; croak "DepTracer is not active" unless $ACTIVE; croak "Different DepTracer is active" unless "$ACTIVE" eq "$self"; $ACTIVE = undef; $self->{+_ON} = 0; my $inc = $self->{+_MY_INC} or return 0; @INC = grep { !(ref($_) && $inc == $_) } @INC; return 0; } sub my_inc { my $self = shift; return $self->{+_MY_INC} if $self->{+_MY_INC}; my $exclude = $self->{+EXCLUDE} ||= {%DEFAULT_EXCLUDE}; my $dep_map = $self->{+DEP_MAP} ||= {}; my $loaded = $self->{+LOADED} ||= {}; return $self->{+_MY_INC} ||= sub { my ($this, $file) = @_; return unless $self->{+_ON}; return unless $file =~ m/^[_a-z]/i; return if $exclude->{$file}; my $loaded_by = $self->loaded_by; push @{$dep_map->{$file}} => $loaded_by; $loaded->{$file}++; return; }; } sub clear_loaded { %{$_[0]->{+LOADED}} = () } my %REQUIRE_CACHE; sub add_callbacks { my $self = shift; my %watch = @_; for my $file (keys %watch) { my $cb = $watch{$file}; $self->add_callback($file => $cb); } } sub add_callback { my $self = shift; my ($file, $cb) = @_; $self->{+LOADED}->{$file}++; $self->{+CALLBACKS}->{$file} = $cb; } sub init { my $self = shift; my $exclude = $self->{+EXCLUDE} ||= { %DEFAULT_EXCLUDE }; my $stash = \%CORE::GLOBAL::; # We use a string in the reference below to prevent the glob slot from # being auto-vivified by the compiler. $self->{+REAL_REQUIRE} = exists $stash->{require} ? \&{'CORE::GLOBAL::require'} : undef; $self->{+CALLBACKS} //= {}; my $dep_map = $self->{+DEP_MAP} ||= {}; my $loaded = $self->{+LOADED} ||= {}; my $inc = $self->my_inc; my $require = $self->{+MY_REQUIRE} = sub { my ($file) = @_; my $loaded_by = $self->loaded_by; my $real_require = $self->{+REAL_REQUIRE}; unless($real_require) { my $caller = $loaded_by->[0]; $real_require = $REQUIRE_CACHE{$caller} ||= eval "package $caller; sub { CORE::require(\$_[0]) }" or die $@; } goto &$real_require unless $self->{+_ON}; if ($file =~ m/^[_a-z]/i) { unless ($exclude->{$file}) { push @{$dep_map->{$file}} => $loaded_by; $loaded->{$file}++; } } if (!ref($INC[0]) || $INC[0] != $inc) { @INC = ( $inc, grep { !(ref($_) && $inc == $_) } @INC, ); } local @INC = @INC[1 .. $#INC]; $real_require->(@_); }; { no strict 'refs'; no warnings 'redefine'; *{'CORE::GLOBAL::require'} = $require; } } sub loaded_by { my $level = 1; while(my @caller = caller($level++)) { next if $caller[0] eq __PACKAGE__; return [$caller[0], $caller[1]]; } return ['', '']; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::DepTracer - Tool for tracing module dependencies as they are loaded. =head1 DESCRIPTION This tool is used by Test2::Harness to build a graph of dependencies which can then be used to blacklist modified modules (and anything that uses them) when they change under a preloaded runner. =head1 SYNOPSIS use Test2::Harness::Runner::DepTracer; my $dt = Test2::Harness::Runner::DepTracer->new(); $dt->start(); require Some::Thing; # You can always check for and retrieve an active DepTrace this way: my $dt_reference = Test2::Harness::Runner::DepTracer->ACTIVE; $dt->stop(); my $dep_map = $dt->dep_map; my $loaded_by = $dep_map->{'Some/Thing.pm'}; print "Some::Thing was directly or indirectly loaded by:\n" . join("\n" => @$loaded_by) . "\n"; =head1 ATTRIBUTES These can be specified at construction, and will be populated during use. =over 4 =item $hashref = $dt->exclude A hashref of files/modules to exclude from dep tracking. By default C<strict> and C<warnings> are excluded. =item $hashref = $dt->dep_map Every file which is loaded while the tool is started will have an entry in this hash, each value is an array of all files which loaded the key file directly or indirectly. =item $hashref = $dt->loaded How many times each file was directly loaded. =back =head1 METHODS =over 4 =item $dt->start Start tracking modules which are loaded. =item $dt->stop Stop tracking modules that are loaded. =back =head1 CLASS METHODS =over 4 =item $dt_or_undef = Test2::Harness::Runner::DepTracer->ACTIVE(); Get the currently active DepTracer, if any. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Preloader.pm����������������������������������������������������������������������������������������100644��001750��001750�� 40203�15267772575� 23715� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Preloader; use strict; use warnings; our $VERSION = '1.000182'; use B(); use Carp qw/confess croak/; use Fcntl qw/LOCK_EX LOCK_UN/; use Time::HiRes qw/time sleep/; use Test2::Harness::Util qw/open_file file2mod mod2file lock_file unlock_file clean_path/; use Test2::Harness::Util::IPC qw/USE_P_GROUPS/; use Test2::Harness::Runner::Reloader; use Test2::Harness::Runner::Preloader::Stage; use File::Spec(); use List::Util qw/pairgrep/; use Test2::Harness::Util::HashBase( qw{ <dir <preloads <done <below_threshold <dtrace <reloader <staged <started_stages <stage <dump_depmap <changed <restrict_reload <blacklist_file <blacklist_lock <blacklist <monitored <last_update }, '<monitor', # This means watch for changes, restart stage if any found '<reload', # Try to reload in place instead of restart stage ); sub init { my $self = shift; $self->{+PRELOADS} //= []; $self->{+BELOW_THRESHOLD} //= 0; return if $self->{+BELOW_THRESHOLD}; $self->{+MONITOR} = 1 if $self->{+RELOAD}; my $need_depmap = $self->{+RELOAD} || $self->{+MONITOR} || $self->{+DUMP_DEPMAP}; if ($need_depmap) { require Test2::Harness::Runner::DepTracer; $self->{+DTRACE} //= Test2::Harness::Runner::DepTracer->new(); } if ($self->{+MONITOR} || $self->{+RELOAD}) { $self->{+BLACKLIST} //= {}; $self->{+BLACKLIST_FILE} //= File::Spec->catfile($self->{+DIR}, 'BLACKLIST'); } $self->{+RELOADER} = Test2::Harness::Runner::Reloader->new( stat_min_gap => 2, notify_cb => sub { $self->_reload_cb_notify(@_) }, find_loaded_cb => sub { $self->_reload_cb_find_loaded(@_) }, should_watch_cb => sub { $self->_reload_cb_should_watch(@_) }, can_reload_cb => sub { $self->_reload_cb_can_reload(@_) }, reload_cb => sub { $self->_reload_cb_reload(@_) }, delete_symbol_cb => sub { $self->_reload_cb_delete_symbol(@_) }, ); } sub stage_check { my $self = shift; my ($stage) = @_; return 0 if $self->{+BELOW_THRESHOLD}; my $p = $self->{+STAGED} or return 0; return 1 if $stage eq 'NOPRELOAD'; return 1 if $p->stage_lookup->{$stage}; return 0; } sub task_stage { my $self = shift; my ($file, $wants) = @_; $wants //= ""; return 'default' if $self->{+BELOW_THRESHOLD}; return 'default' unless $self->{+STAGED}; return $wants if $wants && $self->stage_check($wants); my $stage = $self->{+STAGED}->file_stage($file) // $self->{+STAGED}->default_stage; return $stage; } sub preload { my $self = shift; croak "Already preloaded" if $self->{+DONE}; return 'default' if $self->{+BELOW_THRESHOLD}; my $preloads = $self->{+PRELOADS} or return 'default'; return 'default' unless @$preloads; require Test2::API; Test2::API::test2_start_preload(); # Not loading blacklist yet because any preloads in this list need to # happen regardless of the blacklist. if ($self->{+MONITOR} || $self->{+DTRACE}) { $self->_monitor_preload($preloads); } else { $self->_preload($preloads); } $self->{+DONE} = 1; } sub preload_stages { my $self = shift; return 'default' unless $self->{+STAGED}; return $self->_preload_stages('NOPRELOAD', @{$self->{+STAGED}->stage_list}); } sub _preload_stages { my $self = shift; my @stages = @_; my $name = 'base'; my @procs; while (my $stage = shift @stages) { $stage = $self->{+STAGED}->stage_lookup->{$stage} unless ref $stage || $stage eq 'NOPRELOAD'; my $proc = $self->launch_stage($stage); if ($proc) { push @procs => $proc; next; } # We are in the stage now, reset these if (ref $stage) { $name = $stage->name; @procs = (); @stages = @{$stage->children}; } else { # NOPRELOAD $name = $stage; @procs = (); @stages = (); } $self->start_stage($stage); } return($name, @procs); } sub launch_stage { my $self = shift; my ($stage) = @_; $stage = $self->{+STAGED}->stage_lookup->{$stage} unless ref $stage || $stage eq 'NOPRELOAD'; my $name = ref($stage) ? $stage->name : $stage; my $pid = fork // die "Could not fork: $!"; return Test2::Harness::Runner::Preloader::Stage->new( pid => $pid, name => $name, ) if $pid; setpgrp(0, 0) if USE_P_GROUPS; $0 .= "-$name"; $ENV{T2_HARNESS_STAGE} = $name; return; } sub start_stage { my $self = shift; my ($stage) = @_; if ($self->{+STAGED}) { if ($stage && !ref($stage)) { $stage = $self->{+STAGED}->stage_lookup->{$stage}; } } else { $stage = undef; } $self->{+STAGE} = $stage; $self->load_blacklist if $self->{+MONITOR}; # Localize these in case something we preload tries to modify them. local $SIG{INT} = $SIG{INT}; local $SIG{HUP} = $SIG{HUP}; local $SIG{TERM} = $SIG{TERM}; my $preloads = $stage ? $stage->load_sequence : []; my $meth = $self->{+MONITOR} || $self->{+DTRACE} ? '_monitor_preload' : '_preload'; $self->$meth($preloads, $stage->watches) if $preloads && @$preloads; $self->_monitor() if $self->{+MONITOR}; } sub get_stage_callback { my $self = shift; my ($name) = @_; my $stage = $self->{+STAGE} or return undef; return undef unless ref $stage; return $stage->$name; } sub _monitor_preload { my $self = shift; my ($preloads, $watch) = @_; my $block = {%{$self->blacklist}}; my $dtrace = $self->dtrace; $dtrace->start; $self->_preload($preloads, $block, $dtrace->my_require); $dtrace->add_callbacks(%$watch) if $watch; $dtrace->stop; return; } sub _preload { my $self = shift; my ($preloads, $block, $require_sub) = @_; $block //= {}; my %seen; for my $mod (@$preloads) { next if $seen{$mod}++; if (ref($mod) eq 'CODE') { next if eval { $mod->($block, $require_sub); 1 }; $self->{+MONITOR} ? warn $@ : die $@; next; } next if $block && $block->{$mod}; next if eval { $self->_preload_module($mod, $block, $require_sub); 1 }; $self->{+MONITOR} ? warn $@ : die $@; } return; } sub _preload_module { my $self = shift; my ($mod, $block, $require_sub) = @_; my $file = mod2file($mod); $require_sub ? $require_sub->($file) : require $file; return unless $mod->can('TEST2_HARNESS_PRELOAD'); die "You cannot load a Test2::Harness::Runner::Preload module from within another" if $self->{+DONE}; $self->{+STAGED} //= do { require Test2::Harness::Runner::Preload; Test2::Harness::Runner::Preload->new(); }; $self->{+STAGED}->merge($mod->TEST2_HARNESS_PRELOAD); return; } sub eager_stages { my $self = shift; return unless $self->{+STAGED}; return $self->{+STAGED}->eager_stages; } sub load_blacklist { my $self = shift; my $bfile = $self->{+BLACKLIST_FILE}; my $blacklist = $self->{+BLACKLIST}; return unless -f $bfile; my $fh = open_file($bfile, '<'); while(my $pkg = <$fh>) { chomp($pkg); $blacklist->{$pkg} = 1; } } sub _lock_blacklist { my $self = shift; return $self->{+BLACKLIST_LOCK} if $self->{+BLACKLIST_LOCK}; my $bl = lock_file($self->{+BLACKLIST_FILE}, '>>'); seek($bl,2,0); return $self->{+BLACKLIST_LOCK} = $bl; } sub _unlock_blacklist { my $self = shift; my $bl = delete $self->{+BLACKLIST_LOCK} or return; $bl->flush; unlock_file($bl); close($bl); return; } sub _notify { my $self = shift; for my $msg (@_) { print "$$ $0 - $msg\n"; } } sub _reload_cb_notify { my $self = shift; my ($type, $info) = @_; return $self->_notify("Runner detected a change in one or more preloaded modules...") if $type eq 'changes_detected'; return $self->_notify("Runner detected changes in file '$info'...") if $type eq 'file_changed'; return $self->_notify("Runner attempting to reload '$info->{file}' in place...") if $type eq 'reload_inplace'; return $self->_notify( "Runner failed to reload '$info->{file}' in place...", map { split /\n/, $_ } grep { $_ } @{$info->{warnings} // []}, $info->{error}, ) if $type eq 'reload_fail'; require Data::Dumper; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Maxdepth = 2; return $self->_notify("Runner notification $type: " . (ref($info) ? Data::Dumper::Dumper($info) : $info) . "..."); } sub _reload_cb_find_loaded { keys %{$_[0]->dtrace->loaded} } sub _reload_cb_should_watch { my $self = shift; my ($reloader, $rel, $abs) = @_; my $dirs = $self->{+RESTRICT_RELOAD}; return 1 unless $dirs && @$dirs; for my $dir (@$dirs) { return 1 if 0 == index($abs, $dir); } return 0; } sub _reload_cb_can_reload { my $self = shift; my %params = @_; my $mod = $params{module}; my $file = $params{file}; return (0, reason => 'File is a yath preload module') if $mod->can('TEST2_HARNESS_PRELOAD'); if (my $cb = $self->get_stage_callback('reload_inplace_check')) { my ($res, %fields) = $cb->(module => $mod, file => $file); return ($res, %fields) if defined $res; } return (1) unless $mod->can('import'); return (0, reason => 'File is an importer') if $mod->can('IMPORTER_MENU'); { no strict 'refs'; return (0, reason => 'File is an importer') if @{"$mod\::EXPORT"}; return (0, reason => 'File is an importer') if @{"$mod\::EXPORT_OK"}; } return (1); } sub find_churn { my $self = shift; my ($file) = @_; # When a file is saved to disk it seems it can vanish temporarily. Use this loop to wait for it... my ($fh, $ok, $error); for (1 .. 50) { local $@; $ok = eval { $fh = open_file($file) }; $error = "LOOP $_: $@"; last if $ok; sleep 0.02; } die $error // "Unknown error opening file '$file'" unless $fh; my $active = 0; my @out; my $line_no = 0; while (my $line = <$fh>) { $line_no++; if ($active) { if ($line =~ m/^\s*#\s*HARNESS-CHURN-STOP\s*$/) { push @{$out[-1]} => $line_no; $active = 0; next; } else { $out[-1][-1] .= $line; next; } } if ($line =~ m/^\s*#\s*HARNESS-CHURN-START\s*$/) { $active = 1; push @out => [$line_no, '']; } } return @out; } sub _reload_cb_reload { my $self = shift; my %params = @_; my ($file, $rel, $mod) = @params{qw/file relative module/}; my $callbacks; if (my $dtrace = $self->dtrace) { $callbacks = $dtrace->callbacks; } $callbacks //= {}; if (my $cb = $callbacks->{$file} // $callbacks->{$rel}) { $self->_notify("Changed file '$rel' has a reload callback, executing it instead of regular reloading..."); my $ret = $cb->(); return (1, callback_return => $ret); } if (my @churn = $self->find_churn($file)) { $self->_notify("Changed file '$rel' contains churn sections, running them instead of a full reload..."); for my $churn (@churn) { my ($start, $code, $end) = @$churn; my $sline = $start + 1; if (eval "package $mod;\nuse strict;\nuse warnings;\nno warnings 'redefine';\n#line $sline $file\n$code\n ;1;") { $self->_notify("Success reloading churn block ($file lines $start -> $end)"); } else { $self->_notify("Error reloading churn block ($file lines $start -> $end): $@"); } } return (1); } return (0, reason => 'reloading disabled') unless $self->{+RELOAD}; return undef; } sub _reload_cb_delete_symbol { my $self = shift; my %params = @_; my $sym = $params{symbol}; my $mod = $params{module}; my $file = $params{file}; # Make sure the changed file and the file that defined the sub are the same. my $cb = $self->get_stage_callback('reload_remove_check') or return 0; my $sub = $mod->can($sym) or return 0; my $cobj = B::svref_2object($sub) or return 0; my $subfile = $cobj->FILE or return 0; my $res = $cb->( mod => $mod, sym => $sym, sub => $sub, from_file => -f $subfile ? clean_path($subfile) : $subfile, reload_file => -f $file ? clean_path($file) : $file, ); # 0 means do not skip, so if the cb returned true we do not skip return 0 if $res; return 1; } sub _monitor { my $self = shift; if ($self->{+MONITORED} && $self->{+MONITORED}->[0] == $$) { die "Monitor already starated\n" . "\n=======\n$0\n" . Carp::longmess() . "\n=====\n" . $self->{+MONITORED}->[1] . "\n" . $self->{+MONITORED}->[2] . "\n=======\n"; } $self->{+MONITORED} = [$$, $0, Carp::longmess()]; my $reloader = $self->{+RELOADER}; $reloader->reset(); $reloader->refresh(); return $self->{+MONITORED}; } sub check { my $self = shift; my ($state) = @_; return 1 if $self->{+CHANGED}; return 0 unless $self->{+MONITOR}; # Do not check for changes more often than 1 second (This is used in a loop that needs to be more often than once a second) return 0 if $self->{+LAST_UPDATE} && 1 > (time - $self->{+LAST_UPDATE}); $self->{+LAST_UPDATE} = time; my $dtrace = $self->dtrace; $dtrace->start if $self->{+RELOAD}; my $results = $self->{+RELOADER}->reload_changes(); $dtrace->stop if $self->{+RELOAD}; my (@todo, @fails); for my $item (values %$results) { my $stage = $self->{+STAGE} ? $self->{+STAGE}->name : 'default'; $state->reload($stage => $item); my $rel = $item->{reloaded}; next if $rel; # Reload success if (defined $rel) { # Not reloaded, but no error push @todo => $item; next; } } unless (@todo) { $self->{+RELOADER}->refresh(); return 0; } $self->{+CHANGED} = 1; $self->_notify("blacklisting changed files and reloading stage..."); my $bl = $self->_lock_blacklist(); my $dep_map = $self->dtrace->dep_map; my %CNI = reverse pairgrep { $b } %INC; my %seen; while (@todo) { my $item = shift @todo; my $ref = ref($item); my ($mod, $abs, $rel); if ($ref eq 'HASH') { ($mod, $abs, $rel) = @{$item}{qw/module file relative/}; } elsif ($ref eq 'ARRAY') { ($mod, $abs) = @$item; $rel = $CNI{$abs} || $abs; } else { die "Invalid ref type: $ref"; } next if $seen{$abs}++; next if $mod->can('TEST2_HARNESS_PRELOAD'); $self->_notify("Blacklisting $mod..."); print $bl "$mod\n"; my $next = $dep_map->{$abs} or next; push @todo => @$next; } $self->_unlock_blacklist(); return 1; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preloader - Preload logic. =head1 DESCRIPTION This module is responsible for preloading libraries before running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Stream.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 7754�15267772575� 23554� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Util/File���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Util::File::Stream; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Util qw/lock_file unlock_file/; use Fcntl qw/SEEK_SET/; use parent 'Test2::Harness::Util::File'; use Test2::Harness::Util::HashBase qw/use_write_lock -tail/; sub init { my $self = shift; $self->SUPER::init(); my $tail = $self->{+TAIL} or return; return unless $self->exists; my @lines = $self->poll_with_index; if (@lines < $self->{+TAIL}) { $self->seek(0); } else { $self->seek($lines[0 - $tail]->[0]); } } sub poll_with_index { my $self = shift; my %params = @_; my $max = delete $params{max} || 0; my $pos = $params{from}; $pos = $self->{+LINE_POS} ||= 0 unless defined $pos; my @out; while (!$max || @out < $max) { my ($spos, $epos, $line, $err) = $self->read_line(%params, from => $pos); last unless defined($line) || defined($spos) || defined($epos) || $err; $self->{+LINE_POS} = $epos unless $params{peek} || defined $params{from}; push @out => [$spos, $epos, $line] unless $err; $pos = $epos; } return @out; } sub read { my $self = shift; return $self->poll(from => 0); } sub poll { my $self = shift; my @lines = $self->poll_with_index(@_); return map { $_->[-1] } @lines; } sub write { my $self = shift; my $name = $self->{+NAME}; my $fh; if ($self->{+USE_WRITE_LOCK}) { $fh = lock_file($self->name, '>>'); } else { $fh = Test2::Harness::Util::open_file($self->name, '>>'); } $fh->autoflush(1); seek($fh,2,0); print {$fh} $self->encode($_) for @_; unlock_file($fh) if $self->{+USE_WRITE_LOCK}; close($fh) or die "Could not close file '$name': $!"; return @_; } sub seek { my $self = shift; my ($pos) = @_; my $fh = $self->fh; my $name = $self->{+NAME}; seek($fh, $pos, SEEK_SET) or die "Could not seek to position $pos in file '$name': $!"; $self->{+LINE_POS} = $pos; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Util::File::Stream - Utility class for manipulating a file that serves as an output stream. =head1 DESCRIPTION Subclass of L<Test2::Harness::File> that streams the contents of a file, even if the file is still being written. =head1 SYNOPSIS use Test2::Harness::Util::File::Stream; my $stream = Test2::Harness::Util::File::Stream->new(name => 'path/to/file'); # Read some lines my @lines = $stream->poll; ... # Read more lines, if any. push @lines => $stream->poll; =head1 ATTRIBUTES See L<Test2::Harness::File> for additional attributes. These can be passed in as construction arguments if desired. =over 4 =item $bool = $stream->use_write_lock =item $stream->use_write_lock($bool) Lock the file for every C<write()> operation. =item $bool = $stream->tail Start near the end of the file and only poll for updates appended to it. =back =head1 METHODS See L<Test2::Harness::File> for additional methods. =over 4 =item @lines = $stream->read() Read all lines from the beginning. Every time it is called it returns ALL lines. =item @lines = $stream->poll() =item @lines = $stream->poll(max => $int) Poll for lines. This is an iterator, it should not return the same line more than once, you can call it multiple times to get any additional lines that have been added since the last poll. =item $stream->write(@content) Append @content to the file. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������Manager.pm������������������������������������������������������������������������������������������100644��001750��001750�� 1251�15267772575� 24036� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/coverage/lib����������������������������������������������������������������������������������������������������������������������package Manager; use strict; use warnings; sub test_parameters { my $class = shift; my ($test, $coverage_data) = @_; my %seen; my @subtests; for my $set (values %$coverage_data) { for my $value (@$set) { next unless ref $value eq 'HASH'; my $subtest = $value->{subtest} or next; next if $seen{$subtest}++; push @subtests => $subtest; } } return unless @subtests; @subtests = sort @subtests; return { run => 1, env => { COVER_TEST_SUBTESTS => join(", " => @subtests) }, argv => \@subtests, stdin => join("\n" => @subtests) . "\n", }; } 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fail_on_resource_skip.t�����������������������������������������������������������������������������100644��001750��001750�� 3256�15267772575� 24325� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������use Test2::V0; use App::Yath::Tester qw/yath/; my $dir = __FILE__; $dir =~ s{\.t$}{}g; $dir =~ s{^\./}{}; # Test 1: Without --fail-on-resource-skip, tests with unavailable resources # are skipped and the overall run succeeds (exit 0). yath( command => 'test', args => [$dir, '--ext=tx', "-D$dir", '-R+UnavailableResource'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr/SKIP/i, "Output mentions skipped tests"); unlike($out->{output}, qr/FAILED/i, "No failures reported"); }, ); # Test 2: With --fail-on-resource-skip, tests with unavailable resources # are marked as failures and the overall run fails (exit != 0). yath( command => 'test', args => [$dir, '--ext=tx', "-D$dir", '-R+UnavailableResource', '--fail-on-resource-skip'], exit => T(), test => sub { my $out = shift; like($out->{output}, qr/FAIL.*Some resources are not available/s, "Output shows failures for unavailable resources"); like($out->{output}, qr/FAILED/, "Overall result is FAILED"); like($out->{output}, qr/UnavailableResource/, "Output mentions the unavailable resource name"); }, ); # Test 3: With --no-fail-on-resource-skip (explicit default), same as test 1. yath( command => 'test', args => [$dir, '--ext=tx', "-D$dir", '-R+UnavailableResource', '--no-fail-on-resource-skip'], exit => 0, test => sub { my $out = shift; like($out->{output}, qr/SKIP/i, "Output mentions skipped tests with explicit --no-fail-on-resource-skip"); unlike($out->{output}, qr/FAILED/i, "No failures with explicit --no-fail-on-resource-skip"); }, ); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������noplan.tx�������������������������������������������������������������������������������������������100644��001750��001750�� 111�15267772575� 24210� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������print <<EOT; ok foo ok bar EOT print "1..2\n" if $ENV{FAILURE_DO_PASS}; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CoderefHook.pm��������������������������������������������������������������������������������������100644��001750��001750�� 122�15267772575� 24060� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/inc_hook��������������������������������������������������������������������������������������������������������������������������package CoderefHook; use strict; use warnings; unshift @INC, sub { return }; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������order-ibili.tx��������������������������������������������������������������������������������������100644��001750��001750�� 1162�15267772575� 24152� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'a'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), File::Spec->catdir($path, 'b'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'c'), ], "Added all via cli, in order" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������order-ilibi.tx��������������������������������������������������������������������������������������100644��001750��001750�� 1162�15267772575� 24152� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/includes��������������������������������������������������������������������������������������������������������������������������use Test2::V0; use File::Spec; my @parts = File::Spec->splitpath(File::Spec->rel2abs(__FILE__)); pop @parts; my $path = File::Spec->catpath(@parts); require App::Yath; like( \@INC, [ App::Yath->app_path, File::Spec->catdir($path, 'a'), File::Spec->catdir($path, 'lib'), File::Spec->catdir($path, 'b'), File::Spec->catdir($path, 'blib', 'lib'), File::Spec->catdir($path, 'blib', 'arch'), File::Spec->catdir($path, 'c'), ], "Added all via cli, in order" ); is($ENV{PERL5LIB}, $ENV{OLD_PERL5LIB}, "PERL5LIB has not been modified"); done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������preload_test.tx�������������������������������������������������������������������������������������100644��001750��001750�� 120�15267772575� 24227� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload���������������������������������������������������������������������������������������������������������������������������use Test2::V0; ok($INC{'TestPreload.pm'}, "Preload is loaded"); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22571� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar����������������������������������������������������������������������������������������������������������������������Bar.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 21�15267772575� 23724� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar/lib������������������������������������������������������������������������������������������������������������������package Bar; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Baz.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23743� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar/lib������������������������������������������������������������������������������������������������������������������die "Loaded Baz.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Foo.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23752� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/bar/lib������������������������������������������������������������������������������������������������������������������die "Loaded Foo.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22601� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz����������������������������������������������������������������������������������������������������������������������Bar.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23743� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz/lib������������������������������������������������������������������������������������������������������������������die "Loaded Bar.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Baz.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 21�15267772575� 23744� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz/lib������������������������������������������������������������������������������������������������������������������package Baz; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Foo.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23762� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz/lib������������������������������������������������������������������������������������������������������������������die "Loaded Foo.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fail.txx��������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 24057� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/baz/t��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok(0, "Fail"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22610� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo����������������������������������������������������������������������������������������������������������������������Bar.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23752� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo/lib������������������������������������������������������������������������������������������������������������������die "Loaded Bar.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Baz.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 55�15267772575� 23762� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo/lib������������������������������������������������������������������������������������������������������������������die "Loaded Baz.pm from the wrong project!"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Foo.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 21�15267772575� 23762� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/projects/foo/lib������������������������������������������������������������������������������������������������������������������package Foo; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Preload���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23030� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib������������������������������������������������������������������������������������������������������������������������A.pm������������������������������������������������������������������������������������������������100644��001750��001750�� 256�15267772575� 23671� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::A; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::A //= 0; $PRELOAD::A++; } sub A { $PRELOAD::A } 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������B.pm������������������������������������������������������������������������������������������������100644��001750��001750�� 367�15267772575� 23675� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::B; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::B //= 0; $PRELOAD::B++; } sub B { $PRELOAD::B } die "PreDefined sub is missing!" unless __PACKAGE__->can('PreDefined'); 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������retry-symlinks��������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22442� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������retry.tx��������������������������������������������������������������������������������������������100644��001750��001750�� 1152�15267772575� 24323� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/retry-symlinks��������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������verbose_env�����������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21743� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������verbose1.tx�����������������������������������������������������������������������������������������100644��001750��001750�� 216�15267772575� 24165� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/verbose_env�����������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 1, "Verbosity level 1"); is($ENV{HARNESS_IS_VERBOSE}, 1, "Verbosity level 1"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������verbose2.tx�����������������������������������������������������������������������������������������100644��001750��001750�� 216�15267772575� 24166� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/verbose_env�����������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 2, "Verbosity level 2"); is($ENV{HARNESS_IS_VERBOSE}, 2, "Verbosity level 2"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Detector.t������������������������������������������������������������������������������������������100644��001750��001750�� 26513�15267772575� 23672� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Stall����������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Stall::Detector'; # HARNESS-DURATION-SHORT use ok $CLASS; use File::Spec(); use File::Temp qw/tempdir/; use Test2::Harness::Util::Queue(); my $JOB = 0; sub new_workdir { return tempdir(CLEANUP => 1); } sub queue_for { my ($dir) = @_; return Test2::Harness::Util::Queue->new(file => File::Spec->catfile($dir, 'dispatch.jsonl')); } sub record { my ($dir, $action, $item, %params) = @_; queue_for($dir)->enqueue({ action => $action, item => $item, stamp => $params{stamp} // time, pid => $params{pid} // $$, }); return; } sub task { my (%params) = @_; return { job_id => $params{job_id} // 'job-' . ++$JOB, run_id => 'run-1', file => $params{file} // 'a.t', category => $params{category} // 'general', duration => 'short', stage => 'default', conflicts => $params{conflicts} // [], shares => $params{shares} // [], smoke => 0, }; } # A run with one ready stage and however many queued tasks, laid down far # enough in the past that any threshold under an hour has elapsed. sub seed_run { my ($dir, %params) = @_; my $old = time - 3600; record($dir, queue_run => {run_id => 'run-1'}, stamp => $old); record($dir, start_run => 'run-1', stamp => $old); record($dir, stage_ready => 'default', stamp => $old); for my $t (@{$params{tasks} // []}) { record($dir, queue_task => $t, stamp => $old); } for my $t (@{$params{started} // []}) { record($dir, queue_task => $t, stamp => $old); record( $dir, start_task => { job_id => $t->{job_id}, stage => 'default', res => {args => [], env_vars => {}, record => {}}, }, stamp => $params{start_stamp} // $old, ); } return; } sub detector { my ($dir, %params) = @_; return $CLASS->new( workdir => $dir, job_count => 4, strong => $params{strong} // 600, loose => $params{loose} // 1200, ); } # These pids feed kill() directly, so a mistake here aims a fatal signal at the # wrong process. SIGUSR1's default action is to terminate. subtest pids_for_the_signal_whitelist => sub { my $dir = new_workdir(); my $old = time - 3600; record($dir, queue_run => {run_id => 'run-1'}, stamp => $old, pid => 111); record($dir, queue_task => task(), stamp => $old, pid => 111); record($dir, start_run => 'run-1', stamp => $old, pid => 222); record($dir, stage_ready => 'default', stamp => $old, pid => 333); record($dir, queue_task => task(), stamp => $old, pid => 111); my $one = detector($dir); $one->check(); is($one->stage_pids, {default => 333}, "stage pid from stage_ready"); my $found = detector($dir)->check; ok($found, "reported") or return; is($found->{scheduler_pid}, 222, "scheduler pid from start_run, not the main process's queue_run"); }; subtest a_stage_that_goes_down_leaves_the_whitelist => sub { my $dir = new_workdir(); my $old = time - 3600; record($dir, queue_run => {run_id => 'run-1'}, stamp => $old); record($dir, start_run => 'run-1', stamp => $old); record($dir, stage_ready => 'default', stamp => $old, pid => 333); record($dir, stage_ready => 'other', stamp => $old, pid => 444); record($dir, queue_task => task(), stamp => $old); record($dir, stage_down => 'other', stamp => $old, pid => 444); my $detector = detector($dir); $detector->check(); # A dead stage's pid can be recycled, and signalling a process that never # installed the handler kills it. is($detector->stage_pids, {default => 333}, "the downed stage is gone"); }; subtest a_replay_that_keeps_failing_gives_up => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task()]); # start_task for a job that was never queued makes State's handler die. record($dir, start_task => {job_id => 'nope', stage => 'default', res => {args => [], env_vars => {}, record => {}}}); my $detector = detector($dir); my @warnings; local $SIG{__WARN__} = sub { push @warnings => @_ }; for (1 .. 6) { $detector->{+Test2::Harness::Stall::Detector::LAST_CHECK()} = 0; $detector->check(); } # Re-reading a large dispatch file every second for the rest of the run, # warning each time, would be worse than not reporting at all. ok(@warnings <= 4, "stopped warning") or diag(scalar @warnings); like($warnings[-1], qr/disabled/, "said it gave up"); }; subtest parse_spec => sub { is([$CLASS->parse_spec('600:1200')], [strong => 600, loose => 1200], "pair"); is([$CLASS->parse_spec('600')], [strong => 600, loose => 600], "single value sets both"); is([$CLASS->parse_spec('0')], [], "zero disables"); # STRONG:0 means "report only when nothing is running" and is enabled. # It is also the case a caller loses by testing parse_spec in boolean # context, since a list return yields its last value there. is([$CLASS->parse_spec('600:0')], [strong => 600, loose => 0], "strong only"); is([$CLASS->parse_spec('0:1200')], [strong => 0, loose => 1200], "loose only"); my %strong_only = $CLASS->parse_spec('600:0'); ok(%strong_only, "strong-only is enabled when the result is used as a list"); is([$CLASS->parse_spec(undef)], [], "undef disables"); is([$CLASS->parse_spec('')], [], "empty disables"); # An opt-in diagnostic that silently disables itself on a typo is a trap. like(dies { $CLASS->parse_spec('abc') }, qr/Invalid --stall-report/, "non-numeric croaks"); like(dies { $CLASS->parse_spec('600:abc') }, qr/Invalid --stall-report/, "bad second field croaks"); }; subtest the_option_default_is_off_and_bare_means_sensible => sub { require App::Yath::Options::Runner; my ($opt) = grep { $_->field eq 'stall_report' } @{App::Yath::Options::Runner->options->all}; ok($opt, "found the option") or return; # Given alone the option fills in a usable pair; not given at all it stays # off. Both matter: this is opt-in, and nobody should have to know numbers # to turn it on. is($opt->type, 'd', "takes an optional value"); is($opt->autofill, '600:1200', "bare --stall-report means a sensible pair"); is($opt->default, 0, "off unless asked for"); is([$CLASS->parse_spec($opt->autofill)], [strong => 600, loose => 1200], "the autofill parses"); is([$CLASS->parse_spec($opt->default)], [], "the default is disabled"); }; subtest no_report_before_a_stage_is_ready => sub { my $dir = new_workdir(); my $old = time - 3600; # The queue is populated by the main process well before any stage comes # up, so during a long preload this looks exactly like a stall. record($dir, queue_run => {run_id => 'run-1'}, stamp => $old); record($dir, start_run => 'run-1', stamp => $old); record($dir, queue_task => task(), stamp => $old); is(detector($dir)->check(), undef, "silent while preloading"); }; subtest strong_tier_when_nothing_is_running => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task(), task()]); my $got = detector($dir)->check(); ok($got, "reported") or return; is($got->{tier}, 'strong', "strong tier"); is($got->{running}, 0, "nothing running"); is($got->{pending}, 2, "counted the pending tests"); }; subtest loose_tier_when_something_is_running => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task()], started => [task()]); my $got = detector($dir)->check(); ok($got, "reported") or return; is($got->{tier}, 'loose', "loose tier"); is($got->{running}, 1, "one test running"); }; subtest loose_threshold_is_not_the_strong_one => sub { my $dir = new_workdir(); # 900 seconds idle: past a 600s strong threshold, short of a 1200s loose # one. With a test running, only the loose threshold applies. seed_run($dir, tasks => [task()], started => [task()], start_stamp => time - 900); is(detector($dir)->check(), undef, "waits for the loose threshold"); }; subtest isolation_tail_is_not_a_stall => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task(category => 'isolation')], started => [task()]); is(detector($dir)->check(), undef, "isolation cannot start while a test runs"); }; subtest conflict_blocked_is_not_a_stall => sub { my $dir = new_workdir(); my $running = task(conflicts => ['db']); seed_run($dir, tasks => [task(conflicts => ['db'])], started => [$running]); is(detector($dir)->check(), undef, "pending test conflicts with a running one"); }; # These mirror the rejections State::_next makes for shared locks. Getting them # wrong means reporting a stall against a scheduler waiting exactly as it # should. subtest an_exclusive_claim_waits_on_a_shared_holder => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task(conflicts => ['db'])], started => [task(shares => ['db'])]); is(detector($dir)->check(), undef, "exclusive claim blocked by a running share"); }; subtest a_shared_claim_waits_on_an_exclusive_holder => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task(shares => ['db'])], started => [task(conflicts => ['db'])]); is(detector($dir)->check(), undef, "shared claim blocked by a running exclusive"); }; subtest two_shared_claims_do_not_block_each_other => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task(shares => ['db'])], started => [task(shares => ['db'])]); ok(detector($dir)->check(), "a share does not block another share, so this is a stall"); }; subtest one_unblocked_pending_test_is_enough => sub { my $dir = new_workdir(); seed_run( $dir, tasks => [task(category => 'isolation'), task()], started => [task()], ); ok(detector($dir)->check(), "reports when any pending test could have started"); }; subtest nothing_pending_is_not_a_stall => sub { my $dir = new_workdir(); seed_run($dir, started => [task()]); is(detector($dir)->check(), undef, "no pending tests, nothing to report"); }; subtest disabled_by_zero => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task()]); is(detector($dir, strong => 0, loose => 0)->check(), undef, "no report when disabled"); }; subtest repeat_is_rate_limited_and_capped => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task()]); my $one = detector($dir); ok($one->check(), "first report"); $one->{+Test2::Harness::Stall::Detector::LAST_CHECK()} = 0; is($one->check(), undef, "second report held back"); my $two = detector($dir); $two->{+Test2::Harness::Stall::Detector::REPORTS()} = [map { time - 10_000 } 1 .. 5]; is($two->check(), undef, "stops after the cap"); }; subtest a_torn_trailing_line_is_ignored => sub { my $dir = new_workdir(); seed_run($dir, tasks => [task()]); open(my $fh, '>>', File::Spec->catfile($dir, 'dispatch.jsonl')) or die "Could not open queue: $!"; print $fh '{"action":"queue_task","item":'; # no newline close($fh); ok(detector($dir)->check(), "still reported despite the partial record"); }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������File������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22262� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util�����������������������������������������������������������������������������������������������������������������������JSON.t����������������������������������������������������������������������������������������������100644��001750��001750�� 1130�15267772575� 23353� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util/File������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::JSON'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); my $one = $CLASS->new(name => 'fake'); is($one->decode('{"a":1}'), {a => 1}, "decode will decode json"); is($one->encode({}), "{}", "encode will encode json"); like( dies { $one->reset }, qr/line reading is disabled for json files/, "Got expected exception for reset()" ); like( dies { $one->read_line }, qr/line reading is disabled for json files/, "Got expected exception for read_line()" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������badplan.tx������������������������������������������������������������������������������������������100644��001750��001750�� 124�15267772575� 24326� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������print <<EOT; 1..2 ok foo ok bar EOT print "ok baz\n" unless $ENV{FAILURE_DO_PASS}; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������dupnums.tx������������������������������������������������������������������������������������������100644��001750��001750�� 243�15267772575� 24422� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������my $out = <<EOT; ok 1 - foo ok 2 - bar ok 3 - baz EOT print $out; print $out unless $ENV{FAILURE_DO_PASS}; print "1.." . ($ENV{FAILURE_DO_PASS} ? 3 : 6) . "\n"; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������subtest.tx������������������������������������������������������������������������������������������100644��001750��001750�� 143�15267772575� 24417� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::V0; subtest foo => sub { ok($ENV{FAILURE_DO_PASS}, "check env"); }; done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������timeout.tx������������������������������������������������������������������������������������������100644��001750��001750�� 126�15267772575� 24415� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::Tools::Tiny; sleep 60 unless $ENV{FAILURE_DO_PASS}; ok(1); done_testing; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ArrayrefHook.pm�������������������������������������������������������������������������������������100644��001750��001750�� 125�15267772575� 24267� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/inc_hook��������������������������������������������������������������������������������������������������������������������������package ArrayrefHook; use strict; use warnings; unshift @INC, [sub { return }]; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21312� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke�����������������������������������������������������������������������������������������������������������������������������SmokePlugin.pm��������������������������������������������������������������������������������������100644��001750��001750�� 425�15267772575� 24226� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/smoke/lib�������������������������������������������������������������������������������������������������������������������������package SmokePlugin; use strict; use warnings; use parent 'App::Yath::Plugin'; sub munge_files { my $self = shift; my ($tests, $settings) = @_; for my $test (@$tests) { next unless $test->relative =~ m/[aceg]\.tx$/; $test->set_smoke; } } 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Auditor���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22075� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������Watcher.t�������������������������������������������������������������������������������������������100644��001750��001750�� 5205�15267772575� 24021� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Auditor��������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Auditor::Watcher'; use Test2::Harness::Collector::TapParser qw/parse_stdout_tap/; use Test2::Harness::Event; my $EVENT_ID = 1; sub harness_event { my ($facet_data) = @_; return Test2::Harness::Event->new( run_id => 'run', job_id => 'job', job_try => 0, event_id => 'event-' . $EVENT_ID++, facet_data => $facet_data, ); } sub harness_output_event { my ($line, $tag) = @_; return harness_event({info => [{details => $line, tag => $tag, debug => $tag eq 'STDERR' ? 1 : 0}]}); } # A pair of nested streamed subtests, as a test that does not use the event # stream writes them. my @TAP = ( '# Subtest: foo', ' # Subtest: bar', ' ok 1 - baz', ' 1..1', ' ok 1 - bar', ' 1..1', 'ok 1 - foo', '1..1', ); sub watch { my (%params) = @_; my $watcher = $CLASS->new(job => {job_id => 'job'}, try => 0); for my $idx (0 .. $#TAP) { $watcher->process(harness_output_event($params{noise}, $params{tag} || 'STDERR')) if defined($params{noise_at}) && $params{noise_at} == $idx; $watcher->process(harness_event(parse_stdout_tap($TAP[$idx]))); } return $watcher; } subtest clean_run => sub { my $watcher = watch(); ok($watcher->pass, "Nested subtests passed"); is($watcher->assertion_count, 1, "Counted the top level assertion"); }; subtest output_does_not_close_subtests => sub { # A module warning (Test2::Util::UUID does this when it falls back to # UUID::Tiny) lands in the middle of the subtest TAP. It is not indented, # but it is not TAP either, so it must not end the subtest. for my $idx (0 .. $#TAP) { for my $tag (qw/STDERR STDOUT/) { my $watcher = watch(noise_at => $idx, noise => 'noise from a module', tag => $tag); ok($watcher->pass, "$tag before TAP line $idx did not fail the job") or diag(join "\n" => map { $_->{details} } $watcher->fail_error_facet_list); is($watcher->assertion_count, 1, "$tag before TAP line $idx left the assertion count alone"); } } }; subtest tap_still_closes_subtests => sub { my $watcher = $CLASS->new(job => {job_id => 'job'}, try => 0); # The inner subtest never gets its plan or its result line, the outer one # closes it. $watcher->process(harness_event(parse_stdout_tap($_))) for ( '# Subtest: foo', ' # Subtest: bar', ' ok 1 - baz', ' 1..2', 'ok 1 - foo', '1..1', ); ok($watcher->fail, "Incomplete subtest was caught"); }; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Settings��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22266� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness����������������������������������������������������������������������������������������������������������������������������Prefix.t��������������������������������������������������������������������������������������������100644��001750��001750�� 2540�15267772575� 24051� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Settings�������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Settings::Prefix'; my $one = $CLASS->new(); isa_ok($one, [$CLASS], "Created an instance"); ref_ok($one, 'REF', "Hash is slightly obscured by an extra deref"); like( dies { $one->foo }, qr/The 'foo' field does not exist/, "Must use a valid field" ); ref_ok($one->vivify_field('foo'), 'SCALAR', "vivify returns a ref"); is($one->foo, undef, "Not set yet"); $one->foo('bar'); is($one->foo, 'bar', "Set value"); if ("$]" >= 5.016) { $one->foo = 'baz'; is($one->foo, 'baz', "Set via lvalue"); } else { $one->field(foo => 'baz'); } is($one->field('foo'), 'baz', "Got via field"); $one->field('foo', 'xxx'); is($one->field('foo'), 'xxx', "Set via field"); like( dies { $one->field('foo', 'bar', 'baz') }, qr/Too many arguments for field\(\)/, "Field only takes 2 args" ); like( dies { $CLASS->foo }, qr/Method foo\(\) must be called on a blessed instance/, "Autload does not work on class" ); is( $one->TO_JSON, { foo => 'xxx' }, "JSON structure" ); { $INC{'TheThing.pm'} = 1; package TheThing; use Test2::Harness::Util::HashBase qw/foo bar/; } my $res = $one->build('TheThing', bar => 'yyy'); isa_ok($res, ['TheThing'], "Created an instance"); is( $res, { foo => 'xxx', bar => 'yyy', }, "Created with args" ); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������JSONL.t���������������������������������������������������������������������������������������������100644��001750��001750�� 576�15267772575� 23464� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util/File������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::JSONL'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); isa_ok($CLASS, 'Test2::Harness::Util::File::Stream'); is($CLASS->decode('{"a":1}'), {a => 1}, "decode will decode json"); is($CLASS->encode({}), "{}\n", "encode will encode json and append a newline"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������Value.t���������������������������������������������������������������������������������������������100644��001750��001750�� 752�15267772575� 23647� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util/File������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Value'; # HARNESS-DURATION-SHORT use ok $CLASS; isa_ok($CLASS, 'Test2::Harness::Util::File'); my $one = $CLASS->new(name => __FILE__); my $val = $one->read; chomp(my $no_tail = $val); is($val, $no_tail, "trailing newline was removed from the value"); $val = $one->read_line; is( $val, "use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Value';", "got line, no newline" ); done_testing; ����������������������Renderer��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 21560� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������Formatter.pm����������������������������������������������������������������������������������������100644��001750��001750�� 12610�15267772575� 24241� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Renderer����������������������������������������������������������������������������������������������������������������������package Test2::Harness::Renderer::Formatter; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use File::Spec; use Storable qw/dclone/; use Test2::Harness::Util qw/fqmod mod2file/; use Test2::Harness::Util::JSON qw/encode_pretty_json/; BEGIN { require Test2::Harness::Renderer; our @ISA = ('Test2::Harness::Renderer') } use Test2::Harness::Util::HashBase qw{ -io -io_err -formatter -show_run_info -show_job_info -show_job_launch -show_job_end -do_step -interactive }; sub init { my $self = shift; my $settings = $self->{+SETTINGS}; my $formatter = $self->{+FORMATTER} //= 'Test2'; my $f_class = fqmod('Test2::Formatter', $formatter); my $f_file = mod2file($f_class); require $f_file; my $io = $self->{+IO} || $self->{output} || \*STDOUT; unless (ref $io) { open(my $fh, '>', $io) or die "Could not open file '$io' for writing: $!"; $self->{+IO} = $fh; } my $io_err = $self->{+IO_ERR} || $self->{output} || \*STDERR; unless (ref $io_err) { open(my $fh, '>', $io_err) or die "Could not open file '$io_err' for writing: $!"; $self->{+IO_ERR} = $fh; } $self->{+INTERACTIVE} = 1 if $settings->debug->interactive; $self->{+INTERACTIVE} //= 1 if $ENV{YATH_INTERACTIVE}; $self->{+FORMATTER} = $f_class->new( io => $self->{+IO}, progress => $self->{+PROGRESS}, handles => [$self->{+IO}, $self->{+IO_ERR}, $self->{+IO}], verbose => $settings->display->verbose, color => $settings->display->color, no_wrap => $settings->display->no_wrap, interactive => $self->{+INTERACTIVE}, is_persistent => $self->{+COMMAND_CLASS}->group eq 'persist' ? 1 : 0, ); $self->{+DO_STEP} = $self->{+FORMATTER}->can('step') ? 1 : 0; $self->{+SHOW_JOB_END} = 1 unless defined $self->{+SHOW_JOB_END}; } sub step { my $self = shift; return unless $self->{+DO_STEP}; $self->{+FORMATTER}->step; } sub render_event { my $self = shift; my ($event) = @_; # We modify the event, which would be bad if there were multiple renderers, # so we deep clone it. $event = dclone($event); my $settings = $self->{+SETTINGS}; my $f = $event->{facet_data}; # Optimization $f->{harness} = {%$event}; delete $f->{harness}->{facet_data}; if ($self->{+SHOW_RUN_INFO} && $f->{harness_run}) { my $run = $f->{harness_run}; push @{$f->{info}} => { tag => 'RUN INFO', details => encode_pretty_json($run), }; } if ($f->{harness_job_launch}) { my $job = $f->{harness_job}; $f->{harness}->{job_id} ||= $job->{job_id}; if ($self->{+SHOW_JOB_LAUNCH}) { push @{$f->{info}} => { tag => $f->{harness_job_launch}->{retry} ? 'RETRY' : 'LAUNCH', debug => 0, important => 1, details => File::Spec->abs2rel($job->{file}), }; } if ($self->{+SHOW_JOB_INFO}) { push @{$f->{info}} => { tag => 'JOB INFO', details => encode_pretty_json($job), }; } } if ($f->{harness_job_end}) { my $job = $f->{harness_job}; my $skip = $f->{harness_job_end}->{skip}; my $fail = $f->{harness_job_end}->{fail}; my $file = $f->{harness_job_end}->{file}; my $retry = $f->{harness_job_end}->{retry}; my $job_id = $f->{harness}->{job_id} ||= $job->{job_id}; # Make the times important if they were requested if ($settings->display->show_times && $f->{info}) { for my $info (@{$f->{info}}) { next unless $info->{tag} eq 'TIME'; $info->{important} = 1; } } if ($self->{+SHOW_JOB_END}) { my $name = File::Spec->abs2rel($file); $name .= " - $skip" if $skip; my $tag = 'PASSED'; $tag = 'SKIPPED' if $skip; $tag = 'FAILED' if $fail; $tag = 'TO RETRY' if $retry; unshift @{$f->{info}} => { tag => $tag, debug => $fail, important => 1, details => $name, }; } } my $num = $f->{assert} && $f->{assert}->{number} ? $f->{assert}->{number} : undef; $self->{+FORMATTER}->write($event, $num, $f); } sub finish { my $self = shift; $self->{+FORMATTER}->finalize(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Renderer::Formatter - Renderer that uses any Test2::Formatter for rendering. =head1 DESCRIPTION This renderer simply acts as a communication layer between the harness and any Test2 formatter that you wish to use to display results. Not all formatters will produce useful output for harness events. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23023� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude���������������������������������������������������������������������������������������������������������������������Keep.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 101�15267772575� 24355� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/lib�����������������������������������������������������������������������������������������������������������������package Keep; use strict; use warnings; sub keep { 'keep' } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������symlink.tl������������������������������������������������������������������������������������������100644��001750��001750�� 1152�15267772575� 24630� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/retry-symlinks��������������������������������������������������������������������������������������������������������������������# HARNESS-DURATION-SHORT use strict; use warnings; use Test2::V0; use Test2::API qw/test2_formatter/; ok(1, "Minimal result"); sub { my $ctx = context(); diag "Formatter: " . test2_formatter(); $ctx->release; }->(); $ENV{T2_HARNESS_JOB_IS_TRY} //= 0; $ENV{FAIL_ONCE} //= 0; $ENV{FAIL_ALWAYS} //= 0; diag "JOB_IS_TRY = $ENV{T2_HARNESS_JOB_IS_TRY}"; diag "FAIL_ONCE = $ENV{FAIL_ONCE}"; diag "FAIL_ALWAYS = $ENV{FAIL_ALWAYS}"; ok(0, "Should fail once") if $ENV{FAIL_ONCE} && $ENV{T2_HARNESS_JOB_IS_TRY} < 1; ok(0, "Should fail always") if $ENV{FAIL_ALWAYS}; done_testing(); ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-durations��������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22413� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������fast-01.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24241� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fast-02.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24242� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fast-03.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24243� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fast-04.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24244� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������slow-01.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24270� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������slow-02.tx������������������������������������������������������������������������������������������100644��001750��001750�� 53�15267772575� 24271� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-durations��������������������������������������������������������������������������������������������������������������������use Test2::V0; ok 1, "$0"; done_testing; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������DepTracer.t�����������������������������������������������������������������������������������������100644��001750��001750�� 5306�15267772575� 24141� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner���������������������������������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::DepTracer'; # HARNESS-NO-PRELOAD BEGIN { skip_all 'TODO' } use ok $CLASS; unshift @INC => 't/lib'; subtest require_hook => sub { my $one = $CLASS->new; isa_ok($one, [$CLASS], "Made a new instance"); ok(!$one->real_require, "Did not find an existing require hook"); my $two = $CLASS->new; ref_is($one->my_require, $two->real_require, "Found the existing require hook"); require xxx; is($one->loaded, {}, "Nothing tracked yet"); $one->start; # use eval so we do not pre-bind the require eval qq(#line ${ \__LINE__ } "${ \__FILE__ }"\nrequire baz; 1) or die $@; is($one->loaded, {map { $_ => T } qw/baz.pm foo.pm bar.pm/}, "Loaded 3 modules"); is( $one->dep_map, { 'baz.pm' => [['main', 't/Test2/Harness/Runner/DepTracer.t']], 'foo.pm' => [['baz', 't/lib/baz.pm'], ['bar', 't/lib/bar.pm']], 'bar.pm' => [['baz', 't/lib/baz.pm']], }, "Built dep-map" ); $one->stop; eval "require Data::Dumper; 1" or die $@; is($one->loaded, {map { $_ => T } qw/baz.pm foo.pm bar.pm/}, "Did not track Data::Dumper"); $one->clear_loaded; $one->start; eval "use 5.8.9; 1" or die $@; is($one->loaded, {}, "Did not track from version import"); }; subtest inc_hook => sub { my $one = $CLASS->new; isa_ok($one, [$CLASS], "Made a new instance"); ok($one->real_require, "Did find an existing require hook"); my $two = $CLASS->new; ref_is($one->my_require, $two->real_require, "Found the existing require hook"); require xxx; is($one->loaded, {}, "Nothing tracked yet"); $one->start; # use eval so we do not pre-bind the require eval qq(#line ${ \__LINE__ } "${ \__FILE__ }"\nCORE::require('baz_core.pm'); 1) or die $@; is($one->loaded, {map { $_ => T } qw/baz_core.pm foo_core.pm bar_core.pm/}, "Loaded 3 modules"); is( $one->dep_map, { 'baz_core.pm' => [['main', 't/Test2/Harness/Runner/DepTracer.t']], # The @INC hook is limited, it can catch hidden loads for watching, # but it cannot trace deps when a thing is loaded more than once. 'foo_core.pm' => [['baz_core', 't/lib/baz_core.pm']], #, ['bar', 't/lib/bar_core.pm']], 'bar_core.pm' => [['baz_core', 't/lib/baz_core.pm']], }, "Built dep-map" ); $one->stop; eval "CORE::require('yyy.pm'); 1" or die $@; is($one->loaded, {map { $_ => T } qw/baz_core.pm foo_core.pm bar_core.pm/}, "Did not track yyy"); $one->clear_loaded; $one->start; eval "use 5.8.9; 1" or die $@; is($one->loaded, {}, "Did not track from version import"); }; done_testing; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Stream.t��������������������������������������������������������������������������������������������100644��001750��001750�� 4174�15267772575� 24050� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Util/File������������������������������������������������������������������������������������������������������������������use Test2::Bundle::Extended -target => 'Test2::Harness::Util::File::Stream'; use File::Temp qw/tempfile/; # HARNESS-DURATION-SHORT use ok $CLASS; my ($wh, $filename) = tempfile("test-$$-XXXXXXXX", TMPDIR => 1); print $wh ""; close($wh); ok(my $one = $CLASS->new(name => $filename), "New instance"); $one->write("line1\n"); $one->write("line2\n"); $one->write("line3\n"); $one->write("line"); my $fh = $one->open_file('<'); is( [<$fh>], ["line1\n", "line2\n", "line3\n", "line"], "file written as expected" ); is($one->read_line, "line1\n", "got first line"); is( [$one->poll], [ "line2\n", "line3\n", ], "Got unseen completed lines, but not incomplete line" ); is($one->read_line, undef, "no new lines are ready"); is( [$one->read], [ "line1\n", "line2\n", "line3\n", ], "Read gets lines" ); $one->write("4\n"); $one->write("line5"); is( [$one->read], [ "line1\n", "line2\n", "line3\n", "line4\n", ], "Read sees the new lines" ); is([$one->poll], ["line4\n"], "Poll sees new line after a read"); $one->write("\nline6"); is($one->read_line, "line5\n", "read_line moves to the next line"); is($one->read_line, undef, "no new lines are ready"); is([$one->poll], [], "no new lines are ready"); $one->set_done(1); is([$one->poll], ["line6"], "got unterminated line after 'done' was set"); $one->reset; is( [$one->read], [ "line1\n", "line2\n", "line3\n", "line4\n", "line5\n", ], "read all lines but the last unterminated one" ); is( [$one->poll], [ "line1\n", "line2\n", "line3\n", "line4\n", "line5\n", ], "poll all lines but the last unterminated one" ); $one->set_done(1); is([$one->poll], ["line6"], "got unterminated line after 'done' was set"); $one = undef; $one = $CLASS->new(name => $filename); $one->seek(6); is( [$one->poll], [ "line2\n", "line3\n", "line4\n", "line5\n", ], "Was able to seek past the first item", ); unlink($filename); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TimeTracker.pm��������������������������������������������������������������������������������������100644��001750��001750�� 21015�15267772575� 24350� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Auditor�����������������������������������������������������������������������������������������������������������������������package Test2::Harness::Auditor::TimeTracker; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util qw/hub_truth/; use Test2::Util::Times qw/render_duration/; use Test2::Harness::Util::HashBase qw{ -start -start_id -stop -stop_id -first -first_id -last -last_id -complete_id -_source -_totals }; sub process { my $self = shift; my ($event, $f, $assertion_count) = @_; # Invalidate cache delete $self->{+_TOTALS}; delete $self->{+_SOURCE}; my $stamp = $event->{stamp} or return; my $id = $event->{event_id} // 'N/A'; $f //= $event->{facet_data}; if ($f->{harness_job_exit}) { $self->{+STOP} = $stamp; $self->{+STOP_ID} = $id; } return if $self->{+COMPLETE_ID}; if ($f->{harness_job_start}) { $self->{+START} = $stamp; $self->{+START_ID} = $id; } # These events absolutely end the events phase, and do not count as part of # it. $self->{+COMPLETE_ID} //= $event->{event_id} if $f->{harness_job_exit}; $self->{+COMPLETE_ID} //= $event->{event_id} if $f->{control} && $f->{control}->{phase} && $f->{control}->{phase} eq 'END'; return if $self->{+COMPLETE_ID}; # Plan still counts as 'event' phase, so do not return if we are setting this now $self->{+COMPLETE_ID} //= $event->{event_id} if $assertion_count && $f->{plan} && !$f->{plan}->{none}; return unless $f->{trace}; # Events with traces are "event" phase. # Always replace the last, if we got this far. $self->{+LAST} = $stamp; $self->{+LAST_ID} = $id; # Only set the first one once return if $self->{+FIRST}; $self->{+FIRST} = $stamp; $self->{+FIRST_ID} = $id; return; } sub useful { my $self = shift; my @got = grep { defined $self->{$_} } START, FIRST, LAST, STOP; return @got > 1; } my @TOTAL_FIELDS = qw/startup events cleanup total/; my %TOTAL_SOURCES = ( startup => [FIRST, START], events => [LAST, FIRST], cleanup => [STOP, LAST], total => [STOP, START] ); my %TOTAL_DESC = ( startup => "Time from launch to first test event.", events => "Time spent generating test events.", cleanup => "Time from last test event to test exit.", total => "Total time", ); sub totals { my $self = shift; return $self->{+_TOTALS} if $self->{+_TOTALS}; my $out = {}; for my $field (@TOTAL_FIELDS) { my $sources = $TOTAL_SOURCES{$field} or die "Invalid field: $field"; my @vals = @{$self}{@$sources}; next unless defined($vals[0]) && defined($vals[1]); my $delta = $vals[0] - $vals[1]; $out->{$field} = $delta; $out->{"h_$field"} = render_duration($delta); } return $self->{+_TOTALS} = $out; } sub source { my $self = shift; return $self->{+_SOURCE} if $self->{+_SOURCE}; my @fields = ( START, START_ID, STOP, STOP_ID, FIRST, FIRST_ID, LAST, LAST_ID, COMPLETE_ID, ); my %out; @out{@fields} = @{$self}{@fields}; return $self->{+_SOURCE} = \%out; } sub data_dump { my $self = shift; return { totals => $self->totals, source => $self->source, }; } sub summary { my $self = shift; my $totals = $self->totals; my $summary = ""; for my $field (@TOTAL_FIELDS) { my $hval = $totals->{"h_$field"} // next; my $title = ucfirst($field); $summary .= " | " if $summary; $summary .= "$title: $hval"; } return $summary; } sub table { my $self = shift; my $totals = $self->totals; my $table = { header => ["Phase", "Time", "Raw", "Explanation"], rows => [], }; for my $field (@TOTAL_FIELDS) { my $val = $totals->{$field} // next; my $hval = $totals->{"h_$field"}; my $title = ucfirst($field); push @{$table->{rows}} => [$title, $hval, $val, $TOTAL_DESC{$field}]; } return $table; } sub job_fields { my $self = shift; my $totals = $self->totals; my @out; for my $field (@TOTAL_FIELDS) { my $val = $totals->{$field} // next; my $hval = $totals->{"h_$field"}; my $data = {}; my $sources = $TOTAL_SOURCES{$field}; for my $source (@$sources) { $data->{$source} = { stamp => $self->{$source}, event_id => $self->{"${source}_id"}, }; } push @out => {name => "time_$field", details => $hval, raw => $val, data => $data}; } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Auditor::TimeTracker - Module that tracks timing data while an event stream is processed. =head1 DESCRIPTION The timetracker module tracks timing data of an event stream. All events for a given job should be run through a timetracker, which can then give data on how long the test took in each of several stages. =over 4 =item startup - Time from launch to first test event. =item events - Time spent generating test events. =item cleanup - Time from last test event to test exit. =item total - Total time. =back =head1 SYNOPSIS use Test2::Harness::Auditor::TimeTracker; my $tracker = Test2::Harness::Auditor::TimeTracker->new(); my $assert_count = 0; for my $event (@events) { my $facet_data = $events->facet_data; $assert_count++ if $facet_data->{assert}; $tracker->process($event, $facet_data, $assert_count); } print $tracker->summary; # Startup: 0.00708s | Events: 0.00000s | Cleanup: 0.10390s | Total: 0.11098s =head1 METHODS =over 4 =item $tracker->process($event, $facet_data, $assert_count) =item $tracker->process($event, undef, $assert_count) TimeTracker builds its state from multiple events, each event should be processed by this method. The second argument is optional, if no facet_data is provided it will pull the facet_data from the event itself. This is mainly a micro-optimization to avoid calling the C<facet_data()> method on the event multiple times if you have already called it. =item $bool = $tracker->useful() Returns true if there is any useful data to display. =item $totals = $tracker->totals() Returns the totals like this: { # Raw numbers startup => ..., events => ..., cleanup => ..., total => ..., # Human friendly versions h_startup => ..., h_events => ..., h_cleanup => ..., h_total => ..., } =item $source = $tracker->source() This method returns the data from which the totals are derived. { start => ..., # timestamp of the job starting stop => ..., # timestamp of the job ending first => ..., # timestamp of the first non-harness event last => ..., # timestamp of the last non-harness event # These are event_id's of the events that provided the above stamps. start_id => ..., stop_id => ..., first_id => ..., last_id => ..., complete_id => ..., } =item $data = $tracker->data_dump This dumps the totals and source data: { totals => $tracker->totals, source => $tracker->source, } =item $string = $tracker->summary This produces a summary string of the totals data: Startup: 0.00708s | Events: 0.00000s | Cleanup: 0.10390s | Total: 0.11098s Fields that have no data will be omitted from the string. =item $table = $tracker->table Returns this structure that is good for use in L<Term::Table>. { header => ["Phase", "Time", "Raw", "Explanation"], rows => [ ['startup', $human_readible, $raw, "Time from launch to first test event."], ['events', $human_radible, $raw, 'Time spent generating test events.'], ['cleanup', $human_radible, $raw, 'Time from last test event to test exit.'], ['total', $human_radible, $raw, 'Total time.'], ], } =item @items = $tracker->job_fields() This is used to obtain extra data to attach to the job completion event. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TapParser.pm����������������������������������������������������������������������������������������100644��001750��001750�� 21125�15267772575� 24360� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Collector���������������������������������������������������������������������������������������������������������������������package Test2::Harness::Collector::TapParser; use strict; use warnings; our $VERSION = '1.000182'; use Importer 'Importer' => 'import'; our @EXPORT_OK = qw{ parse_stdout_tap parse_stderr_tap parse_tap_line }; sub parse_stdout_tap { my ($line) = @_; my $facet_data = __PACKAGE__->_parse_tap_line($line) or return undef; $facet_data->{from_tap} = { source => 'STDOUT', details => $line }; return $facet_data; } sub parse_stderr_tap { my ($line) = @_; # STDERR only has comments return unless $line =~ m/^\s*#/; my $facet_data = __PACKAGE__->_parse_tap_line($line) or return undef; $facet_data->{info}->[-1]->{tag} = 'DIAG'; $facet_data->{info}->[-1]->{debug} = 1; $facet_data->{from_tap} = { source => 'STDERR', details => $line }; return $facet_data; } sub parse_tap_line { my ($line) = @_; return __PACKAGE__->_parse_tap_line($line); } sub _parse_tap_line { my $class = shift; my ($line) = @_; chomp($line); my ($lead, $lead_len, $nest, $str) = ('', 0, 0, $line); if ($line =~ m/^(\s+)\S/) { $lead = $1; $str =~ s/^\Q$lead\E//mg; $lead =~ s/\t/ /g; $lead_len = length($lead); # indentation other than 0 or a multiple of 4 spaces... not an event return undef if $lead_len % 4; $nest = $lead_len / 4; } my @types = qw/buffered_subtest comment plan bail version/; for my $type (@types) { my $sub = "parse_tap_$type"; my $facet_data = $class->$sub($str) or next; $facet_data->{trace}->{nested} = $nest; $facet_data->{hubs}->[0]->{nested} = $nest; return $facet_data; } return undef; } sub parse_tap_buffered_subtest { my $class = shift; my ($line) = @_; # End of a buffered subtest. return {parent => {}, harness => {subtest_end => 1}} if $line =~ m/^\}\s*$/; my $facet_data = $class->parse_tap_ok($line) or return undef; return $facet_data unless $facet_data->{assert}->{details} =~ s/\s*\{\s*$//g; $facet_data->{parent} = { details => $facet_data->{assert}->{details}, }; $facet_data->{harness}->{subtest_start} = 1; return $facet_data; } sub parse_tap_ok { my $class = shift; my ($line) = @_; my ($pass, $todo, $skip, $num, @errors); return undef unless $line =~ s/^(not )?ok\b//; $pass = !$1; push @errors => "'ok' is not immediately followed by a space." if $line && !($line =~ m/^ /); if ($line =~ s/^(\s*)(\d+)\b//) { my $space = $1; $num = $2; push @errors => "Extra space after 'ok'" if length($space) > 1; } # Not strictly compliant, but compliant with what Test-Simple does... # Standard does not have a todo & skip. if ($line =~ s/#\s*(todo & skip|todo|skip)(.*)$//i) { my ($directive, $reason) = ($1, $2); push @errors => "No space before the '#' for the '$directive' directive." unless $line =~ s/\s+$//; push @errors => "No space between '$directive' directive and reason." if $reason && !($reason =~ s/^\s+//); $skip = $reason if $directive =~ m/skip/i; $todo = $reason if $directive =~ m/todo/i; } # Standard says that everything after the ok (except the number) is part of # the name. Most things add a dash between them, and I am deviating from # standards by stripping it and surrounding whitespace. $line =~ s/\s*-\s*//; $line =~ s/^\s+//; $line =~ s/\s+$//; my $is_subtest = ($line =~ m/^Subtest:\s*(.*)$/) ? ($1 or 1) : undef; my $facet_data = { assert => { pass => $pass, no_debug => 1, details => $line, defined $num ? (number => $num) : (), }, }; $facet_data->{parent} = { details => $is_subtest, } if defined $is_subtest; push @{$facet_data->{amnesty}} => { tag => 'SKIP', details => $skip, } if defined $skip; push @{$facet_data->{amnesty}} => { tag => 'TODO', details => $todo, } if defined $todo; push @{$facet_data->{info}} => { details => $_, debug => 1, tag => 'PARSER', } for @errors; return $facet_data; } sub parse_tap_version { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^TAP version\s/; return { about => { details => $line, }, info => [ { tag => 'INFO', debug => 0, details => $line, } ], }; } sub parse_tap_plan { my $class = shift; my ($line) = @_; return undef unless $line =~ s/^1\.\.(\d+)//; my $max = $1; my ($directive, $reason) = ("", ""); if ($max == 0) { if ($line =~ s/^\s*#\s*//) { if ($line =~ s/^(skip)\S*\s*//i) { $directive = uc($1); $reason = $line; $line = ""; } } $directive ||= "SKIP"; $reason ||= "no reason given"; } my $facet_data = { plan => { count => $max, skip => ($directive eq 'SKIP') ? 1 : 0, details => $reason, } }; push @{$facet_data->{info}} => { details => 'Extra characters after plan.', debug => 1, tag => 'PARSER', } if $line =~ m/\S/; return $facet_data; } sub parse_tap_bail { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^Bail out!\s*(.*)$/; return { control => { halt => 1, details => $1, } }; } sub parse_tap_comment { my $class = shift; my ($line) = @_; return undef unless $line =~ m/^\s*#/; $line =~ s/^\s*# ?//msg; return { info => [ { details => $line, tag => 'NOTE', debug => 0, } ] }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Collector::TapParser - Produce EventFacets from a line of TAP. =head1 DESCRIPTION This module is responsible for reading and processing any TAP output from tests. Lines of TAP output are processed into L<Test2::Event> facet data. Note that C<< Test2 -> TAP -> Test2 >> is lossy at the C<< Test2 -> TAP >> step. =head1 SYNOPSIS use Test2::Harness::Collector::TapParser qw/parse_tap_line/; my $facet_data = parse_tap_line("1..1"); is( $facet_data, { trace => {nested => 0}, hubs => [{nested => 0}], plan => { details => '', count => 1, skip => 0, }, }, "Parsed the plan" ); $facet_data = parse_tap_line("# foo"); is( $facet_data, { trace => { nested => 0 }, hubs => [ { nested => 0 } ], info => [ { tag => 'NOTE', details => 'foo', debug => 0, }, ], }, "Parsed the note" ); $facet_data = parse_tap_line("ok 1"); is( $facet_data, { trace => {nested => 0}, hubs => [{nested => 0}], assert => { no_debug => 1, pass => 1, number => '1', details => '', }, }, "Parsed the assertion" ); =head1 EXPORTS =over 4 =item $facet_data = parse_tap_line($line) Parse a line of TAP. It is assumed to be STDOUT thus all comments are turned into notes. Using this export will B<NOT> add the usual C<from_tap> facet. It is better to use one of the other 2 exports. =item $facet_data = parse_stdout_tap($line) Parse a line of TAP from stdout. =item $facet_data = parse_stderr_tap($line) Parse a line of TAP from stderr. This will B<ONLY> parse comment lines (ones that start with a C<#>, which may be indented). All comments will be treated as diag's, all other lines will be ignored. =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fail_on_resource_skip�������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23772� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 113�15267772575� 24702� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/fail_on_resource_skip�������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "This test should not actually run"); done_testing; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������b.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 122�15267772575� 24703� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/fail_on_resource_skip�������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "This test should not actually run either"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TestPreload.pm��������������������������������������������������������������������������������������100644��001750��001750�� 2532�15267772575� 24550� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package TestPreload; use strict; use warnings; use Time::HiRes qw/sleep time/; use File::Temp qw/tempdir/; use File::Spec; use Test2::Harness::Runner::Preload; my $dir = tempdir(CLEANUP => 1); my $TRIGGER = File::Spec->catfile($dir, 'trigger'); file_stage sub { my ($file) = @_; return uc($1) if $file =~ m/(AAA|BBB)\.tx$/i; return; }; stage AAA => sub { preload 'AAA'; stage BBB => sub { preload 'BBB'; }; }; our %HOOKS; stage CCC => sub { $HOOKS{INIT} = [time(), $$]; pre_fork sub { $HOOKS{PRE_FORK} = [time(), $$] }; post_fork sub { $HOOKS{POST_FORK} = [time(), $$] }; pre_launch sub { $HOOKS{PRE_LAUNCH} = [time(), $$] }; preload 'CCC'; }; stage FAST => sub { eager; default; preload 'FAST'; preload sub { eval <<" EOT" or die $@; #line ${ \__LINE__ } "${ \__FILE__ }" END { return unless \$0 =~ m/slow\.tx/; open(my \$fh, '>', "$TRIGGER") or die "XXX"; print \$fh "\n"; close(\$fh); } 1; EOT }; stage SLOW => sub { preload sub { print "$0 pending...\n"; use Carp qw/cluck/; local $SIG{ALRM} = sub { cluck "oops"; exit 255 }; alarm 60; until (-f $TRIGGER) { print "$0 Waiting...\n"; sleep 0.2 } }; }; }; 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������not_verbose.tx��������������������������������������������������������������������������������������100644��001750��001750�� 202�15267772575� 24757� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/verbose_env�����������������������������������������������������������������������������������������������������������������������use Test2::V0; is($ENV{T2_HARNESS_IS_VERBOSE}, 0, "Not verbose"); is($ENV{HARNESS_IS_VERBOSE}, 0, "Not verbose"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Preload���������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 22651� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������Stage.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 7042�15267772575� 24415� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Preload����������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Preload::Stage; use strict; use warnings; our $VERSION = '1.000182'; use Carp qw/croak/; use Test2::Harness::Util::HashBase qw{ <name <frame <children <pre_fork_callbacks <post_fork_callbacks <pre_launch_callbacks <load_sequence <watches eager reload_remove_check reload_inplace_check }; sub init { my $self = shift; $self->{+FRAME} //= [caller(1)]; croak "'name' is a required attribute" unless $self->{+NAME}; croak "Stage name 'base' is reserved, pick another name" if $self->{+NAME} eq 'base'; croak "Stage name 'NOPRELOAD' is reserved, pick another name" if $self->{+NAME} eq 'NOPRELOAD'; $self->{+CHILDREN} //= []; $self->{+PRE_FORK_CALLBACKS} //= []; $self->{+POST_FORK_CALLBACKS} //= []; $self->{+PRE_LAUNCH_CALLBACKS} //= []; $self->{+LOAD_SEQUENCE} //= []; $self->{+WATCHES} //= {}; } sub watch { my $self = shift; my ($file, $callback) = @_; croak "The first argument must be a file" unless $file && -f $file; croak "The callback argument is required" unless $callback && ref($callback) eq 'CODE'; croak "There is already a watch on file '$file'" if $self->{+WATCHES}->{$file}; $self->{+WATCHES}->{$file} = $callback; return; } sub all_children { my $self = shift; my @out = @{$self->{+CHILDREN}}; for (my $i = 0; $i < @out; $i++) { my $it = $out[$i]; push @out => @{$it->children}; } return \@out; } sub add_child { my $self = shift; my ($stage) = @_; push @{$self->{+CHILDREN}} => $stage; } sub add_pre_fork_callback { my $self = shift; my ($cb) = @_; croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; push @{$self->{+PRE_FORK_CALLBACKS}} => $cb; } sub add_post_fork_callback { my $self = shift; my ($cb) = @_; croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; push @{$self->{+POST_FORK_CALLBACKS}} => $cb; } sub add_pre_launch_callback { my $self = shift; my ($cb) = @_; croak "Callback must be a coderef" unless ref($cb) eq 'CODE'; push @{$self->{+PRE_LAUNCH_CALLBACKS}} => $cb; } sub add_to_load_sequence { my $self = shift; for my $item (@_) { croak "Item '$item' is not a valid preload, must be a module name (scalar) or a coderef" unless ref($item) eq 'CODE' || !ref($item); push @{$self->{+LOAD_SEQUENCE}} => $item; } return @_; } sub do_pre_fork { my $self = shift; $_->(@_) for @{$self->{+PRE_FORK_CALLBACKS}} } sub do_post_fork { my $self = shift; $_->(@_) for @{$self->{+POST_FORK_CALLBACKS}} } sub do_pre_launch { my $self = shift; $_->(@_) for @{$self->{+PRE_LAUNCH_CALLBACKS}} } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preload::Stage - Abstraction of a preload stage. =head1 DESCRIPTION This is an implementation detail. You are not intended to directly use/modify instances of this class. See L<Test2::Harness::Runner::Preload> for documentation on how to write a custom preload library. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������deps2�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23272� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude���������������������������������������������������������������������������������������������������������������������Dep2.pm���������������������������������������������������������������������������������������������100644��001750��001750�� 101�15267772575� 24532� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/deps2���������������������������������������������������������������������������������������������������������������package Dep2; use strict; use warnings; sub dep2 { 'dep2' } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Churn.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 1066�15267772575� 24610� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::Churn; our $counter; $counter //= 0; die "Counter incremented!" if $counter; $counter++; # HARNESS-CHURN-START our $counter2; $counter2 //= 0; print "$$ $0 - Churn 1\n"; $counter2++; my $foo = "foo $counter2"; sub foo { $foo } print "$$ $0 - FOO: " . Preload::Churn->foo . "\n"; # HARNESS-CHURN-STOP # HARNESS-CHURN-START print "$$ $0 - Churn 2\n"; # HARNESS-CHURN-STOP # HARNESS-CHURN-START our $counter3; $counter3 //= 0; die "$$ $0 - Died on count $counter3\n" if $counter3++; print "$$ $0 - Churn 3\n"; $counter3++; # HARNESS-CHURN-STOP 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nonperl1��������������������������������������������������������������������������������������������100644��001750��001750�� 3�15267772575� 24562� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nonperl2��������������������������������������������������������������������������������������������100644��001750��001750�� 3�15267772575� 24563� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������2; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������test-broken-symlinks��������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23532� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������keepme����������������������������������������������������������������������������������������������100644��001750��001750�� 2�15267772575� 24773� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-broken-symlinks��������������������������������������������������������������������������������������������������������������1 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������missingnums.tx��������������������������������������������������������������������������������������100644��001750��001750�� 166�15267772575� 25307� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������my $i = 1; print "ok " . $i++ . "\n"; $i++ unless $ENV{FAILURE_DO_PASS}; print "ok " . $i++ . "\n"; print "1..2\n"; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������parse_error.tx��������������������������������������������������������������������������������������100644��001750��001750�� 226�15267772575� 25253� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::V0; use goto::file( $ENV{FAILURE_DO_PASS} ? ['ok(1); done_testing;'] : ['ok(; done_testing;'] ); die "Should not see this!"; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������pass.tx���������������������������������������������������������������������������������������������100644��001750��001750�� 56�15267772575� 25156� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-broken-symlinks��������������������������������������������������������������������������������������������������������������use Test2::V0; ok(1, "Pass"); done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Log�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 20533� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness�������������������������������������������������������������������������������������������������������������������������������CoverageAggregator.pm�������������������������������������������������������������������������������100644��001750��001750�� 25553�15267772575� 25021� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Log���������������������������������������������������������������������������������������������������������������������������package Test2::Harness::Log::CoverageAggregator; use strict; use warnings; our $VERSION = '1.000182'; use File::Find qw/find/; use Test2::Harness::Util qw/clean_path/; use Test2::Harness::Util::HashBase qw/<touched <job_map +can_touch +can_start_test +can_stop_test +can_record_coverage <file +io <encode/; sub init { my $self = shift; $self->{+TOUCHED} //= {}; $self->{+JOB_MAP} //= {}; $self->{+CAN_TOUCH} = !!$self->can('touch'); $self->{+CAN_START_TEST} = !!$self->can('start_test'); $self->{+CAN_STOP_TEST} = !!$self->can('stop_test'); $self->{+CAN_RECORD_COVERAGE} = !!$self->can('record_coverage'); if (my $file = $self->{+FILE}) { open(my $fh, '>', $file) or die "Could not open file '$file' for writing: $!"; $self->{+IO} = $fh; } } sub flush { } sub finalize { $_[0]->write } sub record_metrics { } sub write { my $self = shift; my $list = $self->flush() or return; my $io = $self->{+IO} or return $list; my $encode = $self->{+ENCODE}; for my $item (@$list) { my $encoded = $encode ? $encode->($item) : $item; print $io $encoded; } return $list; } sub process_event { my $self = shift; my ($e) = @_; return unless $e; return unless keys %$e; my $job_map = $self->{+JOB_MAP} //= {}; my $job_id = $e->{job_id} // 0; my $test = $job_map->{$job_id}; if (my $start = $e->{facet_data}->{harness_job_start}) { $test //= $start->{rel_file}; $self->start_test($test, $e) if $self->{+CAN_START_TEST}; } if (my $end = $e->{facet_data}->{harness_job_end}) { $test //= $end->{rel_file}; $self->stop_test($test, $e) if $self->{+CAN_STOP_TEST}; } $job_map->{$job_id} //= $test if $test; if (my $c = $e->{facet_data}->{coverage}) { die "Got coverage data before test start! (Weird event order?)" unless $test; $self->_touch_coverage($test, $c, $e); $self->record_coverage($test, $c, $e) if $self->{+CAN_RECORD_COVERAGE}; } return $self->write(); } sub _touch_coverage { my $self = shift; my ($test, $data, $e) = @_; if (my $new = $data->{files}) { for my $file (keys %$new) { my $ndata = $new->{$file} // next; for my $sub (keys %$ndata) { $self->{+TOUCHED}->{$file}->{$sub}++; next unless $self->{+CAN_TOUCH}; $self->touch(source => $file, sub => $sub, test => $test, manager_data => $ndata->{$sub}, event => $e); } } } } my %PERL_TYPES = ( pl => 1, pm => 1, t => 1, tx => 1, t2 => 1, pmc => 1, ); sub build_metrics { my $self = shift; my %params = @_; my $private = $params{exclude_private}; my $dirs = $params{dirs} // ['lib']; my $types = $params{types} // ['pm', 'pl']; my $touched = $self->{+TOUCHED} //= {}; my $exclude = [map { clean_path($_) } @{$params{exclude_dirs} // []}]; my $metrics = { files => {total => 0, tested => 0}, subs => {total => 0, tested => 0}, untested => {files => [], subs => {}}, }; my $untested = $metrics->{untested}; my %type_check = map { m/\.?([^\.]+)$/g; (lc($1) => 1) } @$types; my $raw_untested = {}; find( { no_chdir => 1, wanted => sub { if ($self->_excluded($File::Find::name, $exclude)) { $File::Find::prune = 1; return; } my $type = lc($_); $type =~ s/^.*\.([^\.]+)$/$1/; return unless $type_check{$type}; $metrics->{files}->{total}++; my $file = $File::Find::name; my $cfile = $touched->{$file}; if ($cfile) { $metrics->{files}->{tested}++ } else { push @{$untested->{files}} => $file; } for my $sub ($PERL_TYPES{$type} ? $self->scan_subs($file) : ('<>')) { next if $sub =~ m/^_/ && $private; my $special_sub = $sub !~ m/^\w/; $metrics->{subs}->{total}++ unless $special_sub; if ($cfile && $cfile->{$sub}) { $metrics->{subs}->{tested}++ unless $special_sub; } else { $raw_untested->{$file}->{$sub} = 1; } } }, }, @$dirs ); for my $file (keys %$raw_untested) { my @val = keys %{$raw_untested->{$file}}; next unless @val; if (@val == 1 && $val[0] eq '<>') { push @{$untested->{files}} => $file; } else { $untested->{subs}->{$file} = [sort @val]; } } my %seen; @{$untested->{files}} = sort grep { !$seen{$_}++ } @{$untested->{files}}; $self->record_metrics($metrics); return $metrics; } # File coverage drops these paths before the event is sent, so counting them # here would report an excluded tree as untested source. sub _excluded { my $self = shift; my ($file, $exclude) = @_; return 0 unless @$exclude; my $path = clean_path($file); for my $root (@$exclude) { return 1 if $path eq $root; return 1 if index($path, "$root/") == 0; } return 0; } sub scan_subs { my $self = shift; my ($file) = @_; my @subs; my $fh; unless (open($fh, '<', $file)) { warn "Could not open file '$file': $!"; return; } my $in_pod = 0; while (my $line = <$fh>) { $in_pod = 1 if $line =~ m/^=\w/; if ($in_pod) { next unless $line =~ m/^=cut/i; $in_pod = 0; next; } last if $line =~ m/^__(END|DATA)__$/; next unless $line =~ m/^\s*sub\s+(\w+)/; push @subs => $1; } return @subs; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator - Module for aggregating coverage data from a stream of events. =head1 DESCRIPTION This module takes a stream of events and produces aggregated coverage data. =head1 SYNOPSIS use Test2::Harness::Log::CoverageAggregator; my $agg = Test2::Harness::Log::CoverageAggregator->new(); while (my $e = $log->next_event) { $agg->process_event($e); } # Get a structure like { source_file => { source_method => $touched_count, ... }, ...} my $touched_source = $agg->touched; # Get a structure like # { # files => {total => 5, tested => 2}, # subs => {total => 20, tested => 12}, # untested => {files => \@file_list, subs => {file => \@sub_list, ...}}, # } my $metrics = $agg->metrics; =head1 METHODS =head2 IMPLEMENTABLE IN SUBCLASSES If you implement these in a subclass they will be called for you at the proper times, making subclassing much easier. In most cases you can avoid overriding process_event(). =over 4 =item $agg->start_test($test, $event) This is called once per test when it starts. B<Note:> If a test is run more than once (re-run) it will start and stop again for each re-run. The event is also provided as an argument so that you can check for a try-id or similar in the event that re-runs matter to you. =item $agg->stop_test($test, $event) This is called once per test when it stops. B<Note:> If a test is run more than once (re-run) it will start and stop again for each re-run. The event is also provided as an argument so that you can check for a try-id or similar in the event that re-runs matter to you. =item $agg->record_coverage($test, $coverage_data, $event) This is called once per coverage event (there can be several in a test, specially if it forks or uses threads). In most cases you probably want to leave this unimplemented and implement the C<touch()> method instead of iterating over the coverage structure yourself. =item $agg->touch(source => $file, sub => $sub, test => $test, manager_data => $mdata, event => $event) Every touch applied to a source file (and sub) will trigger this method call. =over 4 =item source => $file The source file that was touched =item sub => $sub The source subroutine that was touched. B<Note:> This may be '<>' if the source file was opened via C<open()> or '*' if code outside of a subroutine was executed by the test. =item test => $test The test file that did the touching. =item manager_data => $mdata If the test file makes use of a source manager to attach extra data to coverage, this is where that data will be. A good example would be test suites that use tools similar to Test::Class or Test::Class::Moose where all tests are run in methods and you want to track what test method does the touching. Please note that this level of coverage tracking is not automatic. =item event => $event The full event being processed. =back =back =head2 PUBLIC API =over 4 =item $agg->process_event($event) Process the event, aggregating any coverage info it may contain. =item $touched = $add->touched() Returns the following structure, which tells you how many times a specific source file's subroutines were called. There are also "special" subroutines '<>' and '*' which mean "file was opened via open" and "code outside of a subroutine". { source_file => { source_method => $touched_count, ... }, ... } =item $metrics = $agg->build_metrics() =item $metrics = $agg->build_metrics(exclude_private => $BOOL) =item $metrics = $agg->build_metrics(exclude_dirs => \@paths) Will build metrics, and include them in the output from C<< $agg->coverage() >> next time it is called. The C<exclude_private> option, when set to true, will exclude any method that begins with an underscore from the coverage metrics and untested sub list. The C<exclude_dirs> option takes an arrayref of directories to leave out. A file at one of those paths, or under one at any depth, is counted in neither the totals nor the untested lists. Paths are resolved before they are compared, so they may be given relative to the current directory. Metrics: { files => {total => 20, tested => 18}, subs => {total => 80, tested => 70}, untested => { files => \@file_list, subs => { file => \@sub_list, ... } }, } =back =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������Preloader�������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23200� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������Stage.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 2252�15267772575� 24742� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Preloader��������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Preloader::Stage; use strict; use warnings; our $VERSION = '1.000182'; use parent 'Test2::Harness::IPC::Process'; use Test2::Harness::Util::HashBase qw{ <name eager }; sub category { $_[0]->{+CATEGORY} //= 'stage' } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Preloader::Stage - Representation of a persistent stage process. =head1 DESCRIPTION This module is responsible for preloading libraries for a specific stage before running tests. This entire module is considered an "Implementation Detail". Please do not rely on it always staying the same, or even existing in the future. Do not use this directly. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23756� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/deps����������������������������������������������������������������������������������������������������������������Dep.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 76�15267772575� 25127� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/deps/lib������������������������������������������������������������������������������������������������������������package Dep; use strict; use warnings; sub dep { 'dep' } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TestBadPreload.pm�����������������������������������������������������������������������������������100644��001750��001750�� 265�15267772575� 25140� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package TestBadPreload; use strict; use warnings; use Test2::Harness::Runner::Preload; stage BAD => sub { default; preload "Test2::Harness::Preload::Does::Not::Exist"; }; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������vendor����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23552� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude���������������������������������������������������������������������������������������������������������������������Vendor.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 107�15267772575� 25463� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/vendor��������������������������������������������������������������������������������������������������������������package Vendor; use strict; use warnings; sub vendor { 'vendor' } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������cover_exclude_out_of_band���������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 24614� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration�����������������������������������������������������������������������������������������������������������������������������������a.tx������������������������������������������������������������������������������������������������100644��001750��001750�� 2733�15267772575� 25556� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band���������������������������������������������������������������������������������������������������������use Test2::V0; use File::Temp qw/tempdir/; require OOBKeep; OOBKeep::keep(); my $dir = __FILE__; $dir =~ s{[^/]+$}{}; # Descendants yath never launched: each loads the coverage plugin itself, so # none of them sees the exclusions, and every report lands in this job's event # stream. They must all start before this test's first assertion, since the # stream environment they inherit is withdrawn once the test's own formatter # initializes. my %exit; # Measured against the run root, like this test. $exit{plain} = system($^X, "-I${dir}deps", '-MTest2::Plugin::Cover', '-e', 'require OOBDep; OOBDep::dep(); 1;'); # Measured against the fixture directory, so its paths are relative to that # and only the root it names says which files they are. $exit{rekey} = system( $^X, '-e', "chdir q{$dir} or die \$!; exec \$^X, '-Ilib', '-Ideps', '-MTest2::Plugin::Cover', '-e', q{require OOBRekey; OOBRekey::rekey(); require OOBDep; OOBDep::dep(); 1;}", ); # Measured against a directory outside the project entirely. my $tmp = tempdir(CLEANUP => 1); open(my $fh, '>', "$tmp/OOBOutside.pm") or die "Could not write '$tmp/OOBOutside.pm': $!"; print $fh "package OOBOutside; sub out { 1 } 1;\n"; close($fh) or die "Could not close '$tmp/OOBOutside.pm': $!"; $exit{outside} = system($^X, '-e', "chdir q{$tmp} or die \$!; exec \$^X, '-I.', '-MTest2::Plugin::Cover', '-e', q{require OOBOutside; OOBOutside::out(); 1;}"); is($exit{$_}, 0, "descendant '$_' ran") for sort keys %exit; done_testing; �������������������������������������WarningA.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 363�15267772575� 25216� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::WarningA; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::WA //= 0; warn "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::WA++; } sub WA { $PRELOAD::WA } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WarningB.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 363�15267772575� 25217� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::WarningB; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::WB //= 0; warn "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::WB++; } sub WB { $PRELOAD::WB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Resource��������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 23052� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner������������������������������������������������������������������������������������������������������������������������JobCount.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 6542�15267772575� 25302� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Resource���������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Resource::JobCount; use strict; use warnings; our $VERSION = '1.000182'; use parent 'Test2::Harness::Runner::Resource'; use Test2::Harness::Util::HashBase qw/<settings <job_count <used <free/; use Time::HiRes qw/time/; use List::Util qw/min/; sub job_limiter { 1 } sub new { my $class = shift; my $self = bless {@_}, $class; $self->init(); return $self; } sub init { my $self = shift; my $settings = $self->{+SETTINGS}; $self->{+JOB_COUNT} //= $settings ? $settings->runner->job_count // 1 : 1; $self->{+USED} //= {}; $self->{+FREE} //= [1 .. $self->{+JOB_COUNT}]; } sub job_limiter_max { my $self = shift; return $self->{+JOB_COUNT}; } sub job_limiter_at_max { my $self = shift; return 0 if @{$self->{+FREE}}; return 1; } sub available { my $self = shift; my ($task) = @_; my $rmin = $self->settings->runner->slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; return -1 if $self->{+JOB_COUNT} < $tmin; return -1 if $rmin < $tmin; my $concurrency = min(grep { $_ } $tmax, $rmin); $concurrency ||= 1; return 1 if @{$self->{+FREE}} >= $concurrency; return 0; } sub assign { my $self = shift; my ($task, $state) = @_; my $rmin = $self->settings->runner->slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; my $concurrency = min(grep { $_ } $tmax, $rmin); $concurrency ||= 1; $state->{record} = { count => $concurrency, file => $task->{rel_file}, stamp => time, }; $state->{env_vars}->{T2_HARNESS_MY_JOB_CONCURRENCY} = $concurrency; } sub record { my $self = shift; my ($job_id, $info) = @_; my $count = $info->{count}; my @use = splice @{$self->{+FREE}}, 0, $count; $info->{slots} = \@use; $self->{+USED}->{$job_id} = $info; } sub release { my $self = shift; my ($job_id) = @_; # Could be a free with no used slot. my $info = delete $self->{+USED}->{$job_id} or return; my $slots = $info->{slots}; push @{$self->{+FREE}} => @$slots; } sub status_data { my $self = shift; my @rows; my $time = time; for my $info (sort { $a->{stamp} <=> $b->{stamp} } values %{$self->{+USED}}) { my $count = @{$info->{slots} || []}; push @rows => [$time - $info->{stamp}, $count, $info->{file}]; } push @rows => [undef, scalar(@{$self->{+FREE}}), '** FREE **']; return [ { tables => [ { headers => [qw/Runtime Slots Name/], format => ['duration'], rows => \@rows, }, ], }, ], } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::JobCount - limit the job count (-j) =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������nested_subtest.tx�����������������������������������������������������������������������������������100644��001750��001750�� 263�15267772575� 25764� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::V0; subtest foo => sub { subtest bar => sub { subtest baz => sub { ok($ENV{FAILURE_DO_PASS}, "check env"); }; }; }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ExporterA.pm����������������������������������������������������������������������������������������100644��001750��001750�� 351�15267772575� 25416� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::ExporterA; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::EA //= 0; $PRELOAD::EA++; } use parent 'Exporter'; our @EXPORT_OK = 'EA'; sub EA { $PRELOAD::EA } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ExporterB.pm����������������������������������������������������������������������������������������100644��001750��001750�� 347�15267772575� 25424� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::ExporterB; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::EB //= 0; $PRELOAD::EB++; } our @EXPORT_OK = ('EB'); sub import { 1 } sub EB { $PRELOAD::EB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������IncChange.pm����������������������������������������������������������������������������������������100644��001750��001750�� 165�15267772575� 25327� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::IncChange; use strict; use warnings; BEGIN { print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TestSimplePreload.pm��������������������������������������������������������������������������������100644��001750��001750�� 37�15267772575� 25660� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/preload/lib�����������������������������������������������������������������������������������������������������������������������package TestSimplePreload; 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ExceptionA.pm���������������������������������������������������������������������������������������100644��001750��001750�� 370�15267772575� 25545� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::ExceptionA; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::ExA //= 0; die "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::ExA++; } sub ExA { $PRELOAD::ExA } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ExceptionB.pm���������������������������������������������������������������������������������������100644��001750��001750�� 371�15267772575� 25547� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/reload/lib/Preload����������������������������������������������������������������������������������������������������������������package Preload::ExceptionB; use strict; use warnings; BEGIN { local $.; print "$$ $0 - Loaded ${ \__PACKAGE__ }\n"; $PRELOAD::ExB //= 0; die "Loaded ${ \__PACKAGE__ } again.\n" if $PRELOAD::ExB++; } sub ExB { $PRELOAD::ExB } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������BlockingResource.pm���������������������������������������������������������������������������������100644��001750��001750�� 4431�15267772575� 26100� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stall_report����������������������������������������������������������������������������������������������������������������������package BlockingResource; use strict; use warnings; use Time::HiRes qw/sleep time/; use parent 'Test2::Harness::Runner::Resource'; # Longest to block for. Bounded on purpose: killing a stalled run is out of # scope, so an unbounded block would leave the run for App::Yath::Tester's own # timeout to kill, and that kill lands in stop() -> poll() -> release() and # hangs the test process itself. A run that expects a stack trace out of this # raises the bound, because it stops blocking the moment the trace is taken. sub block_for { $ENV{BLOCKING_RESOURCE_MAX} || 8 } sub available { my $self = shift; my ($task) = @_; # Resources are constructed in several processes. Only the scheduler is # being wedged here; blocking the others proves nothing and hangs the run. return 1 unless $0 =~ m/scheduler/; # Let one test through so the run gets going and a stage comes up. return 1 unless $self->{_started}; # Block once, then let everything through so the run finishes on its own. # Nothing ends a stalled run -- reporting never kills -- so a fixture that # blocks forever would sit until App::Yath::Tester's own timeout, and that # kill lands in stop() -> poll() -> release() and hangs the test process. return 1 if $self->{_done_blocking}; $self->{_blocked_at} //= time; # Stop blocking once this process has been asked for its stack, so the # trace is taken while the scheduler really is stuck here however slow the # machine is. The harness installed the handler that writes the trace; # this only notices that it ran. my $traced = 0; my $handler = $SIG{USR1}; local $SIG{USR1} = sub { $traced++; return unless $handler && ref($handler) eq 'CODE'; $handler->(@_); }; # A loop of short sleeps, not one long one: the detector sends SIGUSR1 and # a single sleep would be cut short by it, un-wedging the fixture early. my $block_for = $self->block_for; while (!$traced && time - $self->{_blocked_at} < $block_for) { sleep 0.2; } $self->{_done_blocking} = 1; return 1; } sub assign { my $self = shift; my ($task, $state) = @_; $state->{record} = 1; } sub record { my $self = shift; my ($job_id, $val) = @_; $self->{_started}++; } sub release { } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������symlink_to_base.xt����������������������������������������������������������������������������������100644��001750��001750�� 246�15267772575� 26135� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/test-symlinks���������������������������������������������������������������������������������������������������������������������use Test2::V0; skip_all( "Do Not Run on the Main base.t" ) if $0 =~ m{\Q/_base.xt\E$}; like $0, qr{symlink_to_base\.xt}, q[symlink preserved in $0]; done_testing; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������post_exit_timeout.tx��������������������������������������������������������������������������������100644��001750��001750�� 127�15267772575� 26514� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������print <<EOT; 1..2 ok foo EOT exit(0) unless $ENV{FAILURE_DO_PASS}; print "ok bar\n"; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CoverageAggregator����������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 24271� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Log���������������������������������������������������������������������������������������������������������������������������ByRun.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 12423�15267772575� 26050� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Log/CoverageAggregator��������������������������������������������������������������������������������������������������������package Test2::Harness::Log::CoverageAggregator::ByRun; use strict; use warnings; our $VERSION = '1.000182'; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use parent 'Test2::Harness::Log::CoverageAggregator'; use Test2::Harness::Util::HashBase qw/<coverage <finalized/; sub init_coverage { my $self = shift; return $self->{+COVERAGE} //= {aggregator => blessed($self)}; } sub record_coverage { my $self = shift; my ($test, $data) = @_; my $coverage = $self->{+COVERAGE} // $self->init_coverage; my $files = $coverage->{files} //= {}; my $alltestmeta = $coverage->{testmeta} //= {}; my $testmeta = $alltestmeta->{$test} //= {type => 'flat'}; if (my $type = $data->{test_type}) { $testmeta->{type} = $type; } if (my $manager = $data->{from_manager}) { $testmeta->{manager} = $manager; } } sub touch { my $self = shift; my %params = @_; my $file = $params{source}; my $sub = $params{sub}; my $test = $params{test}; my $mdata = $params{manager_data}; my $coverage = $self->{+COVERAGE} // $self->init_coverage; my $files = $coverage->{files} //= {}; my $set = $files->{$file}->{$sub}->{$test} //= []; return unless $mdata; my $type = ref $mdata; if ($type eq 'ARRAY') { my %seen; @$set = grep { !$seen{$_}++ } @$set, @$mdata; } else { push @$set => $mdata; } } sub record_metrics { my $self = shift; my ($metrics) = @_; my $coverage = $self->{+COVERAGE} // $self->init_coverage; $coverage->{untested} = $metrics->{untested}; $coverage->{metrics} = {files => $metrics->{files}, subs => $metrics->{subs}}; } sub flush { my $self = shift; return unless $self->{+FINALIZED}; return [ $self->{+COVERAGE} // $self->init_coverage ]; } sub finalize { my $self = shift; $self->{+FINALIZED} = 1; $self->SUPER::finalize(); } sub get_coverage_tests { my $class = shift; my ($settings, $changes, $coverage_data) = @_; my $filemap = $coverage_data->{files} // {}; my $testmeta = $coverage_data->{testmeta} // {}; my ($changes_exclude_loads, $changes_exclude_opens); if ($settings->check_prefix('finder')) { my $finder = $settings->finder; $changes_exclude_loads = $finder->changes_exclude_loads; $changes_exclude_opens = $finder->changes_exclude_opens; } my %tests; for my $file (keys %$changes) { my $parts_map = $changes->{$file}; my $parts_list = [keys %$parts_map]; my $use_parts; if (!@$parts_list || $parts_map->{'*'}) { $use_parts = [keys %{$filemap->{$file}}]; } else { $use_parts = $parts_list; } my %seen; for my $part (@$use_parts) { next if $seen{$part}++; my $ctests = $filemap->{$file}->{$part} or next; for my $test (keys %$ctests) { push @{$tests{$test}->{subs}} => @{$ctests->{$test}}; } } unless ($changes_exclude_opens) { if (my $ltests = $filemap->{$file}->{'*'}) { for my $test (keys %$ltests) { push @{$tests{$test}->{loads}} => @{$ltests->{$test}}; } } } unless ($changes_exclude_loads) { if (my $otests = $filemap->{$file}->{'<>'}) { for my $test (keys %$otests) { push @{$tests{$test}->{opens}} => @{$otests->{$test}}; } } } } my @out; for my $test (sort keys %tests) { my $meta = $testmeta->{$test} // {type => 'flat'}; my $type = $meta->{type}; my $manager = $meta->{manager}; # In these cases we have no choice but to run the entire file if ($type eq 'flat' || !$manager) { push @out => $test; next; } die "Invalid test type: $type" unless $type eq 'split'; my $froms = $tests{$test} // []; my $ok = eval { require(mod2file($manager)); my $specs = $manager->test_parameters($test, $froms, $changes, $coverage_data, $settings); $specs = { run => $specs } unless ref $specs; push @out => [$test, $specs] unless defined $specs->{run} && !$specs->{run}; # Intentional skip 1; }; my $err = $@; next if $ok; warn "Error processing coverage data for '$test' using manager '$manager'. Running entire test to be safe.\nError:\n====\n$@\n====\n"; push @out => $test; } return @out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator::ByRun - Aggregate test data by run =head1 DESCRIPTION =head1 SYNOPSIS =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������StalledResource.pm����������������������������������������������������������������������������������100644��001750��001750�� 1011�15267772575� 26612� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/resource_timeout������������������������������������������������������������������������������������������������������������������package StalledResource; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; sub available { my $self = shift; my ($task) = @_; # Allow the first task through, block everything after return 0 if $self->{_started}; return 1; } sub assign { my $self = shift; my ($task, $state) = @_; $state->{record} = 1; } sub record { my $self = shift; my ($job_id, $val) = @_; $self->{_started}++; } sub release { my $self = shift; my ($job_id) = @_; } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ByTest.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 11214�15267772575� 26220� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Log/CoverageAggregator��������������������������������������������������������������������������������������������������������package Test2::Harness::Log::CoverageAggregator::ByTest; use strict; use warnings; our $VERSION = '1.000182'; use Scalar::Util qw/blessed/; use Test2::Harness::Util qw/mod2file/; use parent 'Test2::Harness::Log::CoverageAggregator'; use Test2::Harness::Util::HashBase qw/<in_progress <completed/; sub init { my $self = shift; $self->SUPER::init(); $self->{+IN_PROGRESS} //= {}; $self->{+COMPLETED} //= []; } sub start_test { my $self = shift; my ($test) = @_; $self->{+IN_PROGRESS}->{$test} //= {test => $test, files => {}, aggregator => blessed($self)}; } sub stop_test { my $self = shift; my ($test) = @_; push @{$self->{+COMPLETED}} => delete $self->{+IN_PROGRESS}->{$test}; } sub record_coverage { my $self = shift; my ($test, $data) = @_; if (my $manager = $data->{from_manager}) { $self->{+IN_PROGRESS}->{$test}->{manager} = $manager; } } sub touch { my $self = shift; my %params = @_; my $file = $params{source}; my $sub = $params{sub}; my $test = $params{test}; my $mdata = $params{manager_data}; my $set = $self->{+IN_PROGRESS}->{$test}->{files}->{$file}->{$sub} //= []; return unless $mdata; my $type = ref $mdata; if ($type eq 'ARRAY') { if (@$set) { my %seen; @$set = grep { !$seen{$_}++ } @$set, @$mdata; } else { push @$set => @$mdata; } } else { push @$set => $mdata; } } sub flush { my $self = shift; my $data = $self->{+COMPLETED} //= []; return unless @$data; $self->{+COMPLETED} = []; return $data; } sub finalize { my $self = shift; my $ip = $self->{+IN_PROGRESS}; my $cm = $self->{+COMPLETED} //= []; push @{$cm} => {$_ => delete $ip->{$_}} for keys %$ip; $self->SUPER::finalize(); } sub get_coverage_tests { my $class = shift; my ($settings, $changes, $coverage_data) = @_; my $test = $coverage_data->{test} // return; my $filemap = $coverage_data->{files} // {}; my $manager = $coverage_data->{manager} // undef; my ($changes_exclude_loads, $changes_exclude_opens); if ($settings->check_prefix('finder')) { my $finder = $settings->finder; $changes_exclude_loads = $finder->changes_exclude_loads; $changes_exclude_opens = $finder->changes_exclude_opens; } my %froms; for my $file (keys %$changes) { my $parts_map = $changes->{$file}; my $parts_list = [keys %$parts_map]; my $use_parts; if (!@$parts_list || $parts_map->{'*'}) { $use_parts = [keys %{$filemap->{$file}}]; } else { $use_parts = $parts_list; } my %seen; for my $part (@$use_parts) { next if $seen{$part}++; my $cfroms = $filemap->{$file}->{$part} or next; push @{$froms{subs}} => @{$cfroms}; } unless ($changes_exclude_loads) { if (my $lfroms = $filemap->{$file}->{'*'}) { push @{$froms{loads}} => @{$lfroms}; } } unless ($changes_exclude_opens) { if (my $ofroms = $filemap->{$file}->{'<>'}) { push @{$froms{opens}} => @{$ofroms}; } } } # Nothing to do for this test return unless keys %froms; # In these cases we have no choice but to run the entire file return ($test) unless $manager; my @out; my $ok = eval { require(mod2file($manager)); my $specs = $manager->test_parameters($test, \%froms, $changes, $coverage_data, $settings); $specs = { run => $specs } unless ref $specs; push @out => [$test, $specs] unless defined $specs->{run} && !$specs->{run}; # Intentional skip 1; }; my $err = $@; return @out if $ok; warn "Error processing coverage data for '$test' using manager '$manager'. Running entire test to be safe.\nError:\n====\n$@\n====\n"; return ($test); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Log::CoverageAggregator::ByTest - Aggregate coverage by test =head1 DESCRIPTION =head1 SYNOPSIS =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SharedJobSlots.pm�����������������������������������������������������������������������������������100644��001750��001750�� 26373�15267772575� 26471� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Resource���������������������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Resource::SharedJobSlots; use strict; use warnings; our $VERSION = '1.000182'; use YAML::Tiny; use Test2::Harness::Runner::Resource::SharedJobSlots::State; use Test2::Harness::Runner::Resource::SharedJobSlots::Config; use Time::HiRes qw/time/; use List::Util qw/min/; use Carp qw/confess/; use parent 'Test2::Harness::Runner::Resource'; use Test2::Harness::Util::HashBase qw{ <settings <state <config <runner_id <runner_pid <job_limiter_max <observe }; sub job_limiter { 1 } sub scope_host { 1 } sub new { my $class = shift; my $self = bless {@_}, $class; $self->init(); return $self; } sub init { my $self = shift; my $settings = $self->{+SETTINGS}; my $sconf = Test2::Harness::Runner::Resource::SharedJobSlots::Config->find(settings => $settings); die "Could not find shared jobs config.\n" unless $sconf; my $runner_id; $runner_id = $self->{+RUNNER_ID} //= $settings->runner->runner_id if $settings->check_prefix('runner'); my $runner_pid = $self->{+RUNNER_PID} //= $Test2::Harness::Runner::RUNNER_PID // $App::Yath::Command::runner::RUNNER_PID; my $prefix = $settings->debug->procname_prefix // ''; my $name = $settings->harness->project // ''; my $dir; if (my $path = $settings->harness->config_file) { if ($path =~ m{^(.*)/[^/]+$}) { $dir = $1; } } $dir //= $settings->harness->cwd; unless ($name) { $name = $dir; $name =~ s{^.*/}{}; } $name = "$prefix-$name" if $prefix; $self->{+JOB_LIMITER_MAX} = min(grep { $_ } $sconf->max_slots_per_run, $settings->runner->job_count); $self->{+STATE} = Test2::Harness::Runner::Resource::SharedJobSlots::State->new( dir => $dir, name => $name, runner_id => $runner_id, runner_pid => $runner_pid, state_umask => $sconf->state_umask, state_file => $sconf->state_file, algorithm => $sconf->algorithm, max_slots => $sconf->max_slots, max_slots_per_job => $sconf->max_slots_per_job, max_slots_per_run => $sconf->max_slots_per_run, min_slots_per_run => $sconf->min_slots_per_run, default_slots_per_run => $sconf->default_slots_per_run, default_slots_per_job => $sconf->default_slots_per_job, my_max_slots => min($self->settings->runner->job_count, $sconf->max_slots), my_max_slots_per_job => min($self->settings->runner->slots_per_job, $sconf->max_slots_per_job), ); $self->{+CONFIG} = $sconf; return; } # Disable this short-circuit otherwise we may never queue a request! sub job_limiter_at_max { 0 } sub refresh { $_[0]->{+STATE}->update_registration } sub _job_concurrency { my $self = shift; my ($task) = @_; my $rmax = $self->settings->runner->job_count; my $jmax = $self->settings->runner->slots_per_job; my $srmax = $self->{+CONFIG}->max_slots_per_run; my $sjmax = $self->{+CONFIG}->max_slots_per_job; my $tmin = $task->{min_slots} // 1; my $tmax = $task->{max_slots} // $tmin; my $max = min($tmax, $sjmax, $srmax, $jmax, $rmax); # Invalid condition, minimum is more than our maximim return if $tmin > $max; $max = $tmin if $max < $tmin; return [$tmin, $max]; } sub available { my $self = shift; my ($task) = @_; my $con = $self->_job_concurrency($task); return -1 unless $con; my $granted = $self->{+STATE}->allocate_slots(con => $con, job_id => $task->{job_id}); return unless $granted; return $granted } sub assign { my $self = shift; my ($task, $state) = @_; return if $self->{+OBSERVE}; my $info = $self->{+STATE}->assign_slots( job => { job_id => $task->{job_id}, file => $task->{rel_file} // $task->{file} // $task->{job_name}, }, ); $state->{env_vars}->{T2_HARNESS_MY_JOB_CONCURRENCY} = $info->{count}; return $info; } sub record { } # NOOP sub release { my $self = shift; my ($job_id) = @_; return if $self->{+OBSERVE}; $self->{+STATE}->release_slots(job_id => $job_id); return; } sub status_data { my $self = shift; my @groups; my $runners = $self->state->state->{runners}; my $global_status = { todo => 0, allotted => 0, assigned => 0, pending => 0, }; my $time = time; for my $runner (sort { $a->{added} <=> $b->{added} } values %$runners) { my $run_status = { todo => $runner->{todo}, allotted => $runner->{allotment}, assigned => 0, pending => 0, }; my $job_table = { header => [qw/Runtime Slots Name/], format => ['duration', undef, undef], rows => [], }; for my $job (sort { $a->{started} <=> $b->{started} } values %{$runner->{assigned}}) { $run_status->{assigned} += $job->{count}; my $stamp = $job->{started}; my $slots = $job->{count}; push @{$job_table->{rows}} => [$time - $stamp, $slots, $job->{file} // $job->{job_id}]; } $run_status->{pending} = $runner->{allotment} - $run_status->{assigned}; $global_status->{$_} += $run_status->{$_} for keys %$global_status; my $run_table = { header => [qw/Todo Allotted Assigned Pending/], rows => [[$run_status->{todo}, $run_status->{allotted}, $run_status->{assigned}, $run_status->{pending}]], }; push @groups => { title => "$runner->{user} - $runner->{name} - $runner->{runner_id}", tables => [ $run_table, $job_table, ], }; } $global_status->{total} = $self->state->{max_slots}; $global_status->{free} = $global_status->{total} - ($global_status->{assigned} + $global_status->{pending}); $global_status->{free} = "$global_status->{free} (Minimum per-run overrides max slot count in some cases)" if $global_status->{free} < 0; unshift @groups => { title => 'System Wide Summary', tables => [ { header => ['Todo', 'Total Shared Slots', 'Allotted Shared Slots', 'Assigned Shared Slots', 'Pending Shared Slots', 'Free Shared Slots'], rows => [[ @{$global_status}{qw/todo total allotted assigned pending free/} ]], } ], }; return \@groups; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots - limit the job count (-j) per machine =head1 SYNOPSIS B<This synopsis is not about using this in code, but rather how to use it on the command line.> In order to use SharedJobSlots you must ether create the C<.sharedjobslots.yml> file, or provide the C<--shared-jobs-config PATH> argument on the command line. The C<PATH> must be a path to a yaml file with configuration specifications for job sharing. =head1 CONFIG FILE Config files for shared slots must be yaml file, they must also be parsable by L<YAML::Tiny>, which implements a subset of yaml. Here is an example config file: --- DEFAULT: state_file: /tmp/yath-slot-state max_slots: 8 max_slots_per_job: 2 max_slots_per_run: 6 myhostname: state_file: /tmp/myhostname-slot-state max_slots: 16 max_slots_per_job: 4 max_slots_per_run: 12 =head2 TOP LEVEL KEYS (HOSTNAMES) All top level keys are hostnames. When the config is read the settings for the current hostname will be used. If the hostname is not defined then the C<DEFAULT> host will be read. If there is no C<DEFAULT> host defined an exception will be thrown. =head2 CONFIG OPTIONS Each option must be specified under a hostname, none of these are valid on their own. =over 4 =item state_file: /path/to/shared/state/file B<REQUIRED> This specifies the path to the shared state file. All yath processes by all users who are sharing slots need read+write access to this file. =item state_umask: 0007 Defaults to C<0007>. Used to set the umask of the state file as well as the lock file. =item max_slots: 8 Max slots system-wide for all users to share. =item max_slots_per_run: 4 Max slots a specific test run can use. =item min_slots_per_run: 0 Minimum slots per run. Set this if you want to make sure that all runs get at least N slots, B<EVEN IF IT MEANS GOING OVER THE SYSTEM-WIDE MAXIMUM!>. This defaults to 0. =item max_slots_per_job: 2 Max slots a specific test job (test file) can use. =item default_slots_per_run: 4 If the user does not specify a number of slots, use this as the default. =item default_slots_per_job: 2 If the user does not specify a number of job slots, use this as the default. =item algorithm: fair =item algorithm: first =item algorithm: Fully::Qualified::Module::function_name Algorithm to use when assigning slots. 'fair' is the default. =back =head3 ALGORITHMS These are algorithms that are used to decide which test runs get which slots. =over 4 =item fair B<DEFAULT> This algorithm tries to balance slots so that all runs share an equal fraction of available slots. If there are not enough slots to go around then priority goes to oldest runs, followed by oldest requests. =item first Priority goes to the oldest run, followed by the next oldest, etc. If the run age is not sufficient to sort requests this will fall back to 'fair'. This is mainly useful for CI systems or batched test boxes. This will give priority to the first test run started, so additional test runs will not consume slots the first run wants to use, but if the first run is winding down and does not need all the slots, the second test run can start using only the spare slots. Use this with ordered test runs where you do not want a purely serial run order. =item Fully::Qualified::Module::function_name You can specify custom algorithms by giving fully qualified subroutine names. =back Example custom algorithm: sub custom_sort { my ($state_object, $state_data, $a, $b) = @_; return 1 if a_should_come_first($a, $b); return -1 if b_should_come_first($a, $b); return 0 if both_have_same_priority($a, $b); # *shrug* return 0; } Ultimately this is used in a C<sort()> call, usual rules apply, return should be 1, 0, or -1. $a and $b are the 2 items being compared. $state_object is an instance of C<Test2::Harness::Runner::Resource::SharedJobSlots::State>. $state_data is a hashref like you get from C<< $state_object->state() >> which is useful if you want to know how many slots each runner is using for a 'fair' style algorithm. Take a look at the C<request_sort_XXX> methods on C<Test2::Harness::Runner::Resource::SharedJobSlots::State> which implement the 3 original sorting methods. =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2022 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CoverExcludePreload.pm������������������������������������������������������������������������������100644��001750��001750�� 73�15267772575� 27360� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude/lib�����������������������������������������������������������������������������������������������������������������package CoverExcludePreload; use strict; use warnings; 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������deps������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 25547� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band���������������������������������������������������������������������������������������������������������OOBDep.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 75�15267772575� 27257� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band/deps����������������������������������������������������������������������������������������������������package OOBDep; use strict; use warnings; sub dep { 1 } 1; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������lib�������������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 25362� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band���������������������������������������������������������������������������������������������������������OOBKeep.pm������������������������������������������������������������������������������������������100644��001750��001750�� 77�15267772575� 27250� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band/lib�����������������������������������������������������������������������������������������������������package OOBKeep; use strict; use warnings; sub keep { 1 } 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 24355� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin/lib/App/Yath���������������������������������������������������������������������������������������������������������������TestPlugin.pm���������������������������������������������������������������������������������������100644��001750��001750�� 10370�15267772575� 27172� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/plugin/lib/App/Yath/Plugin��������������������������������������������������������������������������������������������������������package App::Yath::Plugin::TestPlugin; use strict; use warnings; use Test2::Harness::Util::HashBase qw/-foo/; use Test2::Harness::Util::JSON qw/encode_json/; use Scalar::Util qw/blessed/; use parent 'App::Yath::Plugin'; print "TEST PLUGIN: Loaded Plugin\n"; sub duration_data { my $self = shift; print "TEST PLUGIN: duration_data\n"; return { 't/integration/plugin/a.tx' => 'short', 't/integration/plugin/b.tx' => 'medium', 't/integration/plugin/c.tx' => 'medium', 't/integration/plugin/d.tx' => 'medium', 't/integration/plugin/test.tx' => 'long', }; } sub get_coverage_tests { my $self = shift; my ($settings, $changes) = @_; my $stype = ref($settings); my $type = ref($changes); my $count = keys %$changes; print "TEST PLUGIN: get_coverage_tests($stype, $type($count))\n"; return [ 't/integration/plugin/a.tx', 't/integration/plugin/b.tx', 't/integration/plugin/c.tx', 't/integration/plugin/d.tx', 't/integration/plugin/test.tx', ]; } sub changed_files { my $self = shift; my ($settings) = @_; my $type = ref($settings); print "TEST PLUGIN: changed_files($type)\n"; return ( 't/integration/plugin/a.tx', 't/integration/plugin/b.tx', 't/integration/plugin/c.tx', 't/integration/plugin/d.tx', 't/integration/plugin/test.tx', ); } sub sort_files_2 { my $self = shift; my %params = @_; die "self is not an instance! ($self)" unless blessed($self); my $settings = $params{settings} or die "NO SETTINGS!"; my $files = $params{files}; my %rank = ( test => 1, c => 2, b => 3, a => 4, d => 5, ); my @files = sort { my $an = $a->file; my $bn = $b->file; $an =~ s/^.*\W(\w+)\.tx$/$1/; $bn =~ s/^.*\W(\w+)\.tx$/$1/; $rank{$an} <=> $rank{$bn}; } @$files; return @files; }; sub munge_files { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); print "TEST PLUGIN: munge_files\n"; return; } sub munge_search { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($search, $default_search) = @_; print "TEST PLUGIN: munge_search\n"; @$search = (); my $path = __FILE__; $path =~ s{lib.{1,2}App.{1,2}Yath.{1,2}Plugin.{1,2}TestPlugin\.pm$}{}g; @$default_search = ($path); return; } sub claim_file { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($file) = @_; print "TEST PLUGIN: claim_file $file\n"; if ($file =~ /\.tx/) { require Test2::Harness::TestFile; return Test2::Harness::TestFile->new(file => $file); } return; } sub inject_run_data { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my %params = @_; print "TEST PLUGIN: inject_run_data\n"; my $fields = $params{fields}; push @$fields => {name => 'test_plugin', details => 'foo', raw => 'bar', data => 'baz'}; return; } my $seen = 0; sub handle_event { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($event) = @_; print "TEST PLUGIN: handle_event\n" unless $seen++; if(my $run = $event->facet_data->{harness_run}) { print "FIELDS: " . encode_json($run->{fields}) . "\n"; } return; } sub finish { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my %args = @_; print "TEST PLUGIN: finish " . join(', ' => map { "$_ => " . (ref($args{$_}) || $args{$_} // '?') } sort keys %args) . "\n"; return; } sub setup { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($settings) = @_; print "TEST PLUGIN: setup " . ref($settings) . "\n"; $self->shellcall( $settings, 'testplug', $^X, '-e', 'print STDERR "STDERR WRITE\n"; print STDOUT "STDOUT WRITE\n";', ); return; } sub teardown { my $self = shift; die "self is not an instance! ($self)" unless blessed($self); my ($settings) = @_; print "TEST PLUGIN: teardown " . ref($settings) . "\n"; return; } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Plugin����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 24366� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stamps/lib/App/Yath���������������������������������������������������������������������������������������������������������������TestPlugin.pm���������������������������������������������������������������������������������������100644��001750��001750�� 426�15267772575� 27144� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/stamps/lib/App/Yath/Plugin��������������������������������������������������������������������������������������������������������package App::Yath::Plugin::TestPlugin; use strict; use warnings; use Test2::Harness::Util::JSON qw/encode_json/; use parent 'App::Yath::Plugin'; sub handle_event { my $self = shift; my ($event) = @_; die "Event did not have a stamp!" unless $event->stamp; } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������OOBRekey.pm�����������������������������������������������������������������������������������������100644��001750��001750�� 101�15267772575� 27447� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band/lib�����������������������������������������������������������������������������������������������������package OOBRekey; use strict; use warnings; sub rekey { 1 } 1; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������nested_subtest_exception.tx�������������������������������������������������������������������������100644��001750��001750�� 1321�15267772575� 30056� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use Test2::V0; use Test2::API qw/context/; { $INC{'My/Event.pm'} = 1; package My::Event; use parent 'Test2::Event'; use Test2::Util::Facets2Legacy ':ALL'; sub facet_data { my $self = shift; my $out = $self->common_facet_data; $out->{errors} = [ { tag => 'OOPS', fail => !$ENV{FAILURE_DO_PASS}, details => "An error occured" } ]; return $out; } } subtest foo => sub { subtest bar => sub { subtest baz => sub { ok(1, "pass"); sub { my $ctx = context; $ctx->send_event('+My::Event'); $ctx->release; }->(); }; }; }; done_testing; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SchedulerKillerResource.pm��������������������������������������������������������������������������100644��001750��001750�� 1646�15267772575� 30047� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/scheduler_death�������������������������������������������������������������������������������������������������������������������package SchedulerKillerResource; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; use POSIX(); sub available { 1 } sub assign { my $self = shift; my ($task, $state) = @_; $state->{record} = 1; } sub record { my $self = shift; $self->{_task_started}++; } sub release { } sub tick { my $self = shift; return unless $self->{_task_started}; my $mode = $ENV{SCHEDULER_DEATH_MODE} || return; if ($mode eq 'crash') { die "Intentional scheduler crash for testing\n"; } elsif ($mode eq 'exit') { POSIX::_exit(0); } elsif ($mode eq 'recover') { # Throw a few times then stop, simulating a transient error $self->{_error_count} //= 0; if ($self->{_error_count}++ < 2) { die "Transient scheduler error for testing\n"; } # After 2 errors, stop throwing — scheduler should recover } } 1; ������������������������������������������������������������������������������������������SharedJobSlots��������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 25740� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Resource���������������������������������������������������������������������������������������������������������������State.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 35073�15267772575� 27546� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Resource/SharedJobSlots������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Resource::SharedJobSlots::State; use strict; use warnings; our $VERSION = '1.000182'; use Test2::Harness::Util::File::JSON; use Scalar::Util qw/weaken/; use Time::HiRes qw/time/; use List::Util qw/first min sum0 max/; use Carp qw/croak confess carp/; use Fcntl qw/:flock SEEK_END/; use Errno qw/EINTR EAGAIN ESRCH/; use Test2::Harness::Util::HashBase qw{ <state_file <state_fh <state_umask <runner_id <name <dir <runner_pid <max_slots <max_slots_per_job <max_slots_per_run <min_slots_per_run <default_slots_per_job <default_slots_per_run <my_max_slots <my_max_slots_per_job <algorithm <ready_assignments +transaction <registered <unregistered }; BEGIN { for my $term (qw/runners local/) { my $val = "$term"; my $const = uc($term); no strict 'refs'; *{$const} = sub() { $val }; } } sub TIMEOUT() { 300 } # Timeout runs if they do not update at least every 5 min sub init { my $self = shift; croak "'state_file' is a required attribute" unless $self->{+STATE_FILE}; croak "'max_slots' is a required attribute" unless $self->{+MAX_SLOTS}; croak "'max_slots_per_job' is a required attribute" unless $self->{+MAX_SLOTS_PER_JOB}; croak "'max_slots_per_run' is a required attribute" unless $self->{+MAX_SLOTS_PER_RUN}; $self->{+MY_MAX_SLOTS} //= $self->{+MAX_SLOTS}; $self->{+MY_MAX_SLOTS_PER_JOB} //= $self->{+MAX_SLOTS_PER_JOB}; $self->{+MIN_SLOTS_PER_RUN} //= 0; $self->{+STATE_UMASK} //= 0007; $self->{+NAME} //= $self->{+RUNNER_ID}; $self->{+ALGORITHM} //= '_redistribute_fair'; } sub init_state { my $self = shift; return { RUNNERS() => {} }; } sub state { shift->transaction('r') } sub transaction { my $self = shift; my ($mode, $cb, @args) = @_; $mode //= 'r'; my $write = $mode eq 'w' || $mode eq 'rw'; my $read = $mode eq 'ro' || $mode eq 'r'; croak "mode must be 'w', 'rw', 'r', or 'ro', got '$mode'" unless $write || $read; confess "Write mode requires a 'runner_id'" if $write && !$self->{+RUNNER_ID}; confess "Write mode requires a 'runner_pid'" if $write && !$self->{+RUNNER_PID}; my ($lock, $state, $local); if ($state = $self->{+TRANSACTION}) { $local = $state->{+LOCAL}; confess "Attempted a 'write' transaction inside of a read-only transaction" if $write && !$local->{write}; } else { my $oldmask = umask($self->{+STATE_UMASK}); my $ok = eval { my $lockf = "$self->{+STATE_FILE}.LOCK"; open($lock, '>>', $lockf) or die "Could not open lock file '$lockf': $!"; while (1) { last if flock($lock, $write ? LOCK_EX : LOCK_SH); next if $! == EINTR || $! == EAGAIN; warn "Could not get lock: $!"; } $state = $self->_read_state(); $local = $state->{+LOCAL} = { lock => $lock, mode => $mode, write => $write, stack => [{cb => $cb, args => \@args}], }; weaken($state->{+LOCAL}->{lock}); 1; }; my $err = $@; umask($oldmask); die $err unless $ok; } local @{$local}{qw/write mode stack/} = ($write, $mode, [@{$local->{stack}}, {cb => $cb, args => \@args}]) if $self->{+TRANSACTION}; local $self->{+TRANSACTION} = $state; if ($write) { if ($self->{+REGISTERED}) { $self->_verify_registration($state); } else { $self->_update_registration($state); } } $self->_clear_old_registrations($state); my $out; my $ok = eval { $out = $cb ? $self->$cb($state, @args) : $state; 1 }; my $err = $@; if ($ok && $write) { $self->_clear_old_registrations($state); $self->_update_registration($state) unless $self->{+UNREGISTERED}; $self->_write_state($state); } if ($lock) { flock($lock, LOCK_UN) or die "Could not release lock: $!"; } die $err unless $ok; return $out; } sub _read_state { my $self = shift; return $self->init_state unless -e $self->{+STATE_FILE}; my $file = Test2::Harness::Util::File::JSON->new(name => $self->{+STATE_FILE}); my ($ok, $err); for (1 .. 5) { my $state; $ok = eval { $state = $file->maybe_read(); 1}; $err = $@; return $state ||= $self->init_state if $ok; sleep 0.2; } warn "Corrupted state? Resetting state to initial. Error that caused this was:\n======\n$err\n======\n"; return $self->init_state; } sub _write_state { my $self = shift; my ($state) = @_; my $state_copy = {%$state}; my $local = delete $state_copy->{+LOCAL}; confess "Attempted write with no lock" unless $local->{lock}; confess "Attempted write with a read-only lock" unless $local->{write}; my $oldmask = umask($self->{+STATE_UMASK}); my $ok = eval { my $file = Test2::Harness::Util::File::JSON->new(name => $self->{+STATE_FILE}); $file->rewrite($state_copy); 1; }; my $err = $@; umask($oldmask); die $err unless $ok; } sub update_registration { $_[0]->transaction(rw => '_update_registration') } sub remove_registration { $_[0]->transaction(rw => '_update_registration', remove => 1) } sub _update_registration { my $self = shift; my ($state, %params) = @_; my $runner_id = $self->{+RUNNER_ID}; my $runner_pid = $self->{+RUNNER_PID}; my $entry = $state->{runners}->{$runner_id} //= $state->{runners}->{$runner_id} = { runner_id => $runner_id, runner_pid => $runner_pid, name => $self->{+NAME}, dir => $self->{+DIR}, user => $ENV{USER}, added => time, todo => 0, allocated => 0, allotment => 0, assigned => {}, max_slots => $self->{+MY_MAX_SLOTS}, max_slots_per_job => $self->{+MY_MAX_SLOTS_PER_JOB}, }; # Update our last checking time $entry->{seen} = time; $self->{+REGISTERED} = 1; return $state unless $params{remove}; $self->{+UNREGISTERED} = 1; $entry->{remove} = 1; return $state; } sub _verify_registration { my $self = shift; my ($state) = @_; return unless $self->{+REGISTERED}; my $runner_id = $self->{+RUNNER_ID}; my $entry = $state->{+RUNNERS}->{$runner_id}; # Do not allow for a new expiration. If the state has already expired us we will see it. $entry->{seen} = time if $entry; return unless $self->{+UNREGISTERED} //= $self->_entry_expired($entry); confess "Shared slot registration expired"; } sub _entry_expired { my $self = shift; my ($entry) = @_; return 1 unless $entry; return 1 if $entry->{remove}; if (my $pid = $entry->{runner_pid}) { my $ret = kill(0, $pid); my $err = $!; return 1 if $ret == 0 && $! == ESRCH; } my $seen = $entry->{seen} or return 1; my $delta = time - $seen; return 1 if $delta > TIMEOUT(); return 0; } sub _clear_old_registrations { my $self = shift; my ($state) = @_; my $runners = $state->{+RUNNERS} //= {}; my (%removed); for my $entry (values %$runners) { $entry->{remove} = 1 if $self->_entry_expired($entry); next unless $entry->{remove}; my $runner_id = $entry->{runner_id}; $self->{+UNREGISTERED} = 1 if $runner_id eq $self->{+RUNNER_ID}; delete $runners->{$runner_id}; $removed{$runner_id}++; } return \%removed; } sub allocate_slots { my $self = shift; my (%params) = @_; my $con = $params{con} or croak "'con' is required"; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_allocate_slots', con => $con, job_id => $job_id); } sub assign_slots { my $self = shift; my (%params) = @_; my $job = $params{job} or croak "'job' is required"; return $self->transaction(rw => '_assign_slots', job => $job); } sub release_slots { my $self = shift; my (%params) = @_; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_release_slots', job_id => $job_id); } sub _allocate_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job_id = $params{job_id}; my $con = $params{con}; my ($min, $max) = @$con; $self->_runner_todo($entry, $job_id => $max); my $allocated = $entry->{allocated}; # We have what we need already allocated return $entry->{allocated} = $max if $max <= $allocated; return $entry->{allocated} if $entry->{allocated} >= $min; # Our allocation, if any, is not big enough, free it so we do not have a # deadlock with all runner holding an insufficient allocation. $allocated = $entry->{allocated} = 0; my $calcs = $self->_runner_calcs($entry); for (0 .. 1) { $self->_redistribute($state) if $_; # Only run on second loop # Cannot do anything if we have no allotment or no available slots. # This will go to the next loop for a redistribution, or end the loop. my $allotment = $entry->{allotment} or next; my $available = $allotment - $calcs->{assigned} or next; # If we get here we have an allotment (not 0) but it does not mean the # minimum, so we have to skip the test. return -1 if $allotment < $min; next unless $available >= $min; return $entry->{allocated} = min($available, $max); } return 0; } sub _assign_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job = $params{job}; my $job_id = $job->{job_id}; my $allocated = $entry->{allocated}; $self->_runner_todo($entry, $job_id => -1); $job->{count} = $allocated; $job->{started} = time; $entry->{allocated} = 0; $entry->{assigned}->{$job->{job_id}} = $job; return $job; } sub _release_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; my $job_id = $params{job_id}; delete $entry->{assigned}->{$job_id}; delete $entry->{_calc_cache}; $self->_runner_todo($entry, $job_id => -1); # Reduce our allotment if it makes sense to do so. my $calcs = $self->_runner_calcs($entry); $entry->{allotment} = $calcs->{total} if $entry->{allotment} > $calcs->{total}; } sub _runner_todo { my $sef = shift; my ($entry, $job_id, $count) = @_; my $jobs = $entry->{jobs} //= {}; if ($count) { if ($count < 0) { $count = delete $jobs->{$job_id}; } else { $jobs->{$job_id} = $count; } } elsif ($job_id) { $count = $jobs->{$job_id}; } $entry->{todo} = sum0(values %$jobs); return $count; } sub _runner_calcs { my $self = shift; my ($runner) = @_; return $runner->{_calc_cache} if $runner->{_calc_cache}; my $max = min(grep {$_} $self->{+MAX_SLOTS_PER_RUN}, $runner->{max_slots}); my $assigned = sum0(map { $_->{count} } values %{$runner->{assigned} //= {}}); my $active = $runner->{allocated} + $assigned; my $total = $runner->{todo} + $active; my $wants = ($total >= $max) ? max($max, $active) : max($total, $active); return $runner->{_calc_cache} = { max => $max, assigned => $assigned, active => $active, total => $total, wants => $wants, }; } sub _redistribute { my $self = shift; my ($state) = @_; my $max_run = $self->{+MAX_SLOTS_PER_RUN}; my $wanted = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); $runner->{allotment} = $calcs->{wants}; $wanted += $calcs->{wants}; } # Everyone gets what they want! my $max = $self->{+MAX_SLOTS}; return if $wanted <= $max; my $meth = $self->{+ALGORITHM}; return $self->$meth($state); } sub _redistribute_first { my $self = shift; my ($state) = @_; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $max = $self->{+MAX_SLOTS}; my $c = 0; for my $runner (sort { $a->{added} <=> $b->{added} } values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); my $wants = $calcs->{wants}; if ($max >= $wants) { $runner->{allotment} = $wants; } else { $runner->{allotment} = max($max, $min, 0); } $max -= $runner->{allotment}; $c++; } return; } sub _redistribute_fair { my $self = shift; my ($state) = @_; my $runs = scalar keys %{$state->{+RUNNERS}}; # Avoid a divide by 0 below. return unless $runs; my $total = $self->{+MAX_SLOTS}; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $used = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); # We never want less than the 'active' number my $set = $calcs->{active}; # If min is greater than the active number and there are todo tests, we # use the min instead. $set = $min if $set < $min && $runner->{todo}; $runner->{allotment} = $set; $used += $set; } my $free = $total - $used; return unless $free >= 1; # Is there a more efficient way to do this? Yikes! my @runners = values %{$state->{+RUNNERS}}; while ($free > 0) { @runners = sort { $a->{allotment} <=> $b->{allotment} || $a->{added} <=> $b->{added} } grep { my $c = $self->_runner_calcs($_); $c->{wants} > $_->{allotment} } @runners; $free--; $runners[0]->{allotment}++; } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots::State - shared state for job slots =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2022 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Config.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 12427�15267772575� 27671� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/lib/Test2/Harness/Runner/Resource/SharedJobSlots������������������������������������������������������������������������������������������������package Test2::Harness::Runner::Resource::SharedJobSlots::Config; use strict; use warnings; our $VERSION = '1.000182'; use YAML::Tiny; use Sys::Hostname qw/hostname/; use App::Yath::Util qw/find_in_updir/; use Test2::Harness::Util::HashBase qw{ <config_file <config_raw <host <common_conf <host_conf +state_file +state_umask +algorithm +max_slots +max_slots_per_job +max_slots_per_run +min_slots_per_run +default_slots_per_job +default_slots_per_run +disabled }; sub find { my $class = shift; my (%opts) = @_; my $base_name = delete $opts{base_name}; my $settings = delete $opts{settings}; my $config_file = delete $opts{config_file}; unless ($config_file) { $base_name //= ($settings && $settings->check_prefix('runner')) ? $settings->runner->shared_jobs_config : '.sharedjobslots.yml'; $config_file = ($base_name =~ m{(/|\\)} || -e $base_name) ? $base_name : find_in_updir($base_name); } return unless $config_file && -e $config_file; return $class->new(%opts, config_file => $config_file); } sub init { my $self = shift; my $config_file = $self->{+CONFIG_FILE}; my $config = YAML::Tiny->read($config_file) or die "Could not read '$config_file'"; $config = $self->{+CONFIG_RAW} = $config->[0]; # First doc only my $host = $self->{+HOST} //= hostname(); # Normalize an empty host config section to a hashref $config->{$host} ||= {} if exists $config->{$host}; unless ($self->{+HOST_CONF} = $config->{$host}) { if ($self->{+HOST_CONF} = $config->{DEFAULT}) { $self->{+HOST} = 'DEFAULT'; } else { die "Could not find '$host' or 'DEFAULT' settings in '$config_file'.\n"; } warn <<" EOT" unless $self->{+HOST_CONF}->{no_warning}; Using the 'DEFAULT' shared-slots host config. You may want to add the current host to the config file. To silence this warning, set the 'no_warning' key to true in the DEFAULT host config. Config File: $config_file Current Host: $host EOT } if ($self->{+HOST_CONF}->{use_common} //= 1) { $self->{+COMMON_CONF} = $config->{'COMMON'} // {}; } $self->{+COMMON_CONF} //= {}; #sanity check $self->max_slots; return; } sub state_umask { $_[0]->{+STATE_UMASK} //= $_[0]->_get_config_option(+STATE_UMASK, default => 0007) } sub state_file { $_[0]->{+STATE_FILE} //= $_[0]->_get_config_option(+STATE_FILE, require => 1) } sub max_slots { $_[0]->{+MAX_SLOTS} //= $_[0]->_get_config_option(+MAX_SLOTS, required => 1) } sub min_slots_per_run { $_[0]->{+MIN_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+MIN_SLOTS_PER_RUN, default => 0) } sub max_slots_per_job { $_[0]->{+MAX_SLOTS_PER_JOB} //= $_[0]->_get_config_option(+MAX_SLOTS_PER_JOB, default => $_[0]->max_slots) } sub max_slots_per_run { $_[0]->{+MAX_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+MAX_SLOTS_PER_RUN, default => $_[0]->max_slots) } sub default_slots_per_job { $_[0]->{+DEFAULT_SLOTS_PER_JOB} //= $_[0]->_get_config_option(+DEFAULT_SLOTS_PER_JOB, default => $_[0]->max_slots_per_job) } sub default_slots_per_run { $_[0]->{+DEFAULT_SLOTS_PER_RUN} //= $_[0]->_get_config_option(+DEFAULT_SLOTS_PER_RUN, default => $_[0]->max_slots_per_run) } sub disabled { $_[0]->{+DISABLED} //= $_[0]->_get_config_option(+DISABLED, default => 0) } sub _get_config_option { my $self = shift; my ($field, %opts) = @_; my $val = $self->{+HOST_CONF}->{$field} // $self->{+COMMON_CONF}->{$field} // $opts{default}; die "'$field' not set in '$self->{+CONFIG_FILE}' for host '$self->{+HOST}' or under 'COMMON' config.\n" if $opts{required} && !defined($val); return $val; } sub algorithm { my $self = shift; return $self->{+ALGORITHM} if $self->{+ALGORITHM}; my $algorithm = $self->_get_config_option(+ALGORITHM, default => 'fair'); if ($algorithm =~ m/^(.*)::([^:]+)$/) { my ($mod, $sub) = ($1, $2); require(mod2file($mod)); } else { require Test2::Harness::Runner::Resource::SharedJobSlots::State; my $short = $algorithm; $algorithm = "_redistribute_$algorithm"; die "'$short' is not a valid algorithm (in file '$self->{+CONFIG_FILE}' under host '$self->{+HOST}' key 'algorithm'). Must be 'fair', 'first', or a Fully::Qualified::Module::function_name." unless Test2::Harness::Runner::Resource::SharedJobSlots::State->can($algorithm); } return $self->{+ALGORITHM} = $algorithm; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::Runner::Resource::SharedJobSlots::Config - Config for shared job slots =head1 SOURCE The source code repository for Test2-Harness can be found at F<http://github.com/Test-More/Test2-Harness/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist7@gmail.comE<gt> =back =head1 COPYRIGHT Copyright 2022 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������UnavailableResource.pm������������������������������������������������������������������������������100644��001750��001750�� 436�15267772575� 30406� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/fail_on_resource_skip�������������������������������������������������������������������������������������������������������������package UnavailableResource; use strict; use warnings; use parent 'Test2::Harness::Runner::Resource'; sub available { my $self = shift; my ($task) = @_; # Resource is permanently unavailable for all tests. return -1; } sub assign {} sub record {} sub release {} 1; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������buffered_subtest_abrupt_end.tx����������������������������������������������������������������������100644��001750��001750�� 232�15267772575� 30463� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use strict; use warnings; my $end = $ENV{FAILURE_DO_PASS} ? "}\n" : ""; print <<EOT; ok - foo { ok - pass 1..1 ${end}ok - bar 1..2 EOT exit 0; ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������SharedJobSlots��������������������������������������������������������������������������������������000755��001750��001750�� 0�15267772575� 26414� 5����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner/Resource������������������������������������������������������������������������������������������������������������State.t���������������������������������������������������������������������������������������������100644��001750��001750�� 45414�15267772575� 30051� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots���������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::Resource::SharedJobSlots::State'; use File::Temp qw/tempfile/; use ok $CLASS; sub inst { my %params = @_; my $state_file = $params{state_file}; unless ($state_file) { my $fh; ($fh, $state_file) = tempfile(UNLINK => 1); close($fh); } return $CLASS->new( state_file => $state_file, max_slots => 10, max_slots_per_job => 3, max_slots_per_run => 9, runner_pid => $$, %params, ); } subtest init_checks => sub { for my $field (qw/state_file max_slots max_slots_per_job max_slots_per_run/) { my %proto = ( state_file => '/dev/null', max_slots => 100, max_slots_per_job => 5, max_slots_per_run => 50, ); # Remove the field we are testing for. delete $proto{$field}; like( dies { $CLASS->new(%proto) }, qr/'$field' is a required attribute/, "Require '$field' be provided" ); } my $one = inst(); isa_ok($one, [$CLASS], "Created an instance"); }; subtest init_state => sub { my $one = inst(runner_id => 'one'); my $state = $one->transaction('w'); like( $state, { runners => { one => {runner_id => 'one'}, # The runner added for our transacton }, }, "Got initial state" ); # Remove the local data (not stored) my $local = delete $state->{local}; like( $local, { lock => FDNE, # The lock should not be present anymore (it is weakened inside the transaction, gone after) write => T, # This was a write transaction }, "Local data is as expected", ); my $stored = Test2::Harness::Util::File::JSON->new(name => $one->state_file)->read; is($state, $stored, "state and stored match"); }; subtest transaction => sub { my $one = inst(runner_id => 'one'); my $end_state = $one->transaction( w => sub { my ($the_one, $state, @args) = @_; ref_is($the_one, $one, "Got the instance first"); ref_ok($state, 'HASH', "got a hash"); is(\@args, [qw/arg1 arg2/], "Got additional args"); my $local_check = { lock => T(), write => T(), mode => 'w', stack => [ {cb => T(), args => ['arg1', 'arg2']}, ] }; is($state->{local}, $local_check, "Got accurate state"); subtest nested_transaction => sub { $one->transaction( 'r' => sub { my ($also_the_one, $also_state) = @_; ref_is($also_the_one, $one, "got the same instance"); ref_is($also_state, $state, "Got the same state object"); is( $state->{local}, { lock => T(), write => F(), mode => 'r', stack => [ {cb => T(), args => ['arg1', 'arg2']}, {cb => T(), args => []}, ] }, "State temporarily modified" ); }, ); }; is($one->transaction(), $state, "transaction with no callback returns state"); is($state->{local}, $local_check, "State restored"); return $state; }, 'arg1', 'arg2' ); like( $end_state, { local => {lock => FDNE}, # Lock released runners => { one => { # Added runner user => $ENV{USER}, seen => T(), added => T(), runner_id => 'one', }, }, }, "Got correct end state" ); my $two = inst(runner_id => 'two', state_file => $one->{state_file}); my $state = $two->update_registration; ok($state->{runners}->{two}, "Got registration"); $two->transaction( rw => sub { my ($me, $state) = @_; $state->{runners}->{two}->{remove} = 1; } ); $state = $one->transaction( ro => sub { my ($me, $state) = @_; ok(!$state->{runners}->{two}, "Two is not registered anymore"); } ); like( dies { $two->transaction('rw') }, qr/Shared slot registration expired/, "Cannot proceed if our registration expired", ); my $three = inst(runner_id => 'three', state_file => $one->{state_file}); $state = $three->update_registration; ok($state->{runners}->{three}, "Got registration"); $one->transaction( rw => sub { my ($me, $state) = @_; $state->{runners}->{three}->{seen} = 1; # Very long time ago. } ); # Make sure RO mode is aware, even though it does not write the update $state = $one->transaction( ro => sub { my ($me, $state) = @_; ok(!$state->{runners}->{three}, "Three is not registered anymore (timed out)"); ok(!$state->{runners}->{two}, "Two is not registered anymore"); } ); $state = $one->transaction( rw => sub { my ($me, $state) = @_; ok(!$state->{runners}->{three}, "Three is not registered anymore (timed out)"); ok(!$state->{runners}->{two}, "Two is not registered anymore"); return $state; } ); delete $state->{local}; my $stored = Test2::Harness::Util::File::JSON->new(name => $one->state_file)->read; is($state, $stored, "state and stored match"); }; sub consistent_state { my ($insts, $state_check) = @_; my $ctx = context(); my $state; subtest "consistent state" => sub { my $base = $state = shift(@$insts); my $state = $base->state; my $idx = 1; while (my $i = shift @$insts) { my $st2 = $i->state; is($st2, $state, "state [" . $idx++ . "] matches state [0]"); } use Data::Dumper; is($state, $state_check, "State matches expectations", Dumper($state)) if $state_check; }; $ctx->release; return $state; } subtest registration => sub { my $one = inst(runner_id => 'one'); my $two = inst(runner_id => 'two', state_file => $one->{state_file}); my $three = inst(runner_id => 'three', state_file => $one->{state_file}); $one->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), }; etc; }, ); $two->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => T(), }; etc; }, ); $three->update_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => T(), three => T(), }; etc; }, ); $two->remove_registration; consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => DNE(), three => T(), }; etc; }, ); # Emulate 'three' timing out. my $file = Test2::Harness::Util::File::JSON->new(name => $one->{state_file}); my $data = $file->read; $data->{runners}->{three}->{seen} -= 100 + $one->TIMEOUT; $file->write($data); consistent_state( [$one, $two, $three], hash { field runners => { one => T(), two => DNE(), three => DNE(), }; etc; }, ); like( dies { $three->update_registration }, qr/Shared slot registration expired/, "Cannot write after timing out" ); }; subtest _entry_expired => sub { my $one = inst(runner_id => 'one'); ok($one->_entry_expired(undef), "Invalid entry is expired"); ok($one->_entry_expired({remove => 1}), "Entry to be removed is expired"); ok($one->_entry_expired({}), "no 'seen' field expired"); ok(!$one->_entry_expired({seen => time}), "Recently seen, not expired"); ok($one->_entry_expired({seen => (time - (10 + $one->TIMEOUT))}), "Old is expired"); }; subtest runner_todo => sub { my $one = inst(runner_id => 'one'); my $entry = {}; is($one->_runner_todo($entry), undef, "Nothing to do"); is($one->_runner_todo($entry, 'j1'), undef, "Nothing to do"); is($one->_runner_todo($entry, j1 => 2), 2, "Got job count"); is($entry->{todo}, 2, "todo is set"); is($one->_runner_todo($entry, j2 => 3), 3, "Got job count"); is($entry->{todo}, 5, "todo is set"); is($one->_runner_todo($entry, j3 => 1), 1, "Got job count"); is($entry->{todo}, 6, "todo is set"); is($one->_runner_todo($entry, 'j2'), 3, "Got job count"); is($entry->{todo}, 6, "todo is set"); is($one->_runner_todo($entry, j2 => -1), 3, "Got job count"); is($entry->{todo}, 3, "todo is set"); }; subtest _runner_calcs => sub { my $one = inst(runner_id => 'one'); my $r = { _calc_cache => "cache!", max_slots => 100, assigned => {1 => {count => 1}, 2 => {count => 2}}, allocated => 3, todo => 101, }; is($one->_runner_calcs($r), "cache!", "Get cache if it is present"); delete $r->{_calc_cache}; is( $one->_runner_calcs($r), { max => 9, # Use the global max as runner max is too high assigned => 3, active => 6, # Assigned + Allocated total => 107, # Active + TODO wants => 9, # We have more tests than slots, so we want the max }, "Calculated data", ); ok($r->{_calc_cache}, "Have a cache"); is($one->_runner_calcs($r), $r->{_calc_cache}, "Result matches cache"); $r->{_calc_cache}->{xxx} = 'added'; is($one->_runner_calcs($r), $r->{_calc_cache}, "Result matches cache"); is($one->_runner_calcs($r)->{xxx}, 'added', "Extra cache key found"); $r = { max_slots => 5, assigned => {1 => {count => 2}, 2 => {count => 2}}, allocated => 0, todo => 101, }; is( $one->_runner_calcs($r), { max => 5, # Use our max, less than the global assigned => 4, active => 4, # Assigned + Allocated total => 105, # Active + TODO wants => 5, # We want our max }, "Calculated data", ); $r = { assigned => {1 => {count => 5}, 2 => {count => 5}}, allocated => 2, todo => 101, }; is( $one->_runner_calcs($r), { max => 9, assigned => 10, active => 12, # Assigned + Allocated total => 113, # Active + TODO wants => 12, # We want what we are already using, even though it is higher than max. }, "Calculated data", ); }; subtest allocate_slots => sub { my $one = inst(runner_id => 'one'); like(dies { $one->allocate_slots(todo => 1) }, qr/'con' is required/, "con must be specified"); $one->{max_slots_per_job} = 10; $one->{my_max_slots_per_job} = 11; $one->{max_slots} = 11; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(10 || 11 || 11\)\)/, "Cannot exceed slot limits A" ); $one->{max_slots_per_job} = 11; $one->{my_max_slots_per_job} = 10; $one->{max_slots} = 11; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(11 || 10 || 11\)\)/, "Cannot exceed slot limits B" ); $one->{max_slots_per_job} = 11; $one->{my_max_slots_per_job} = 11; $one->{max_slots} = 10; like( dies { $one->allocate_slots(con => [11, 11], todo => 100) }, qr/Slot request exceeds max slots per job \(11 vs \(11 || 11 || 10\)\)/, "Cannot exceed slot limits C" ); $one->transaction(rw => sub { my ($self, $state) = @_; # Make sure we have an allocation so we do not trigger a redistribute. $state->{runners}->{one}->{allocated} = 5; $state->{runners}->{one}->{allotment} = 2; # Do calcs and cache them so we can verify they get cleared. my $calcs = $self->_runner_calcs($state->{runners}->{one}); $calcs->{CACHED} = 1; }); ok($one->state->{runners}->{one}->{_calc_cache}->{CACHED}, "runner calc cache is as expected", $one->state->{runners}->{one}->{_calc_cache}); is($one->state->{runners}->{one}->{allocated}, 5, "Allocation is 5"); is($one->allocate_slots(con => [4, 4], job_id => '123'), 4, "We got 4 slots!"); ok(!$one->state->{runners}->{one}->{_calc_cache}->{CACHED}, "Allocating slots reset runner calc cache", $one->state->{runners}->{one}->{_calc_cache}); is($one->state->{runners}->{one}->{allocated}, 4, "Allocation updated to 4"); }; done_testing; __END__ TODO do more testing on this sub _allocate_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $count = $params{count}; my $job_id = $params{job_id}; $self->_runner_todo($entry, $job_id => $count); my $allocated = $entry->{allocated}; # We have what we need already allocated return $entry->{allocated} = $count if $count <= $allocated; # Our allocation, if any, is not big enough, free it so we do not have a # deadlock with all runner holding an insufficient allocation. $allocated = $entry->{allocated} = 0; my $calcs = $self->_runner_calcs($entry); for (0 .. 1) { $self->_redistribute($state) if $_; # Only run on second loop # Cannot do anything if we have no allotment or no available slots. # This will go to the next loop for a redistribution, or end the loop. my $allotment = $entry->{allotment} or next; my $available = $allotment - $calcs->{assigned} or next; # If our allotment is lower than the count we may end up never getting # enough, so we forcefully reduce the count. # We do this for busy systems where the pool is too small to meet the # request. But we do not reduce the count to the available level, # availability can change to match the allotment. my $c = min($allotment, $count); next unless $available >= $c; return $entry->{allocated} = $c; } return 0; } sub assign_slots { my $self = shift; my (%params) = @_; my $job = $params{job} or croak "'job' is required"; return $self->transaction(rw => '_assign_slots', job => $job); } sub _assign_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; delete $entry->{_calc_cache}; my $job = $params{job}; my $job_id = $job->{job_id}; my $allocated = $entry->{allocated}; my $count = $self->_runner_todo($entry, $job_id => -1); $job->{count} = $count; $job->{started} = time; $entry->{allocated} = 0; $entry->{assigned}->{$job->{job_id}} = $job; return $job; } sub release_slots { my $self = shift; my (%params) = @_; my $job_id = $params{job_id} or croak "'job_id' is required"; return $self->transaction(rw => '_release_slots', job_id => $job_id); } sub _release_slots { my $self = shift; my ($state, %params) = @_; my $entry = $state->{runners}->{$self->{+RUNNER_ID}}; my $job_id = $params{job_id}; delete $entry->{assigned}->{$job_id}; delete $entry->{_calc_cache}; $self->_runner_todo($entry, $job_id => -1); # Reduce our allotment if it makes sense to do so. my $calcs = $self->_runner_calcs($entry); $entry->{allotment} = $calcs->{total} if $entry->{allotment} > $calcs->{total}; } sub _redistribute { my $self = shift; my ($state) = @_; my $max_run = $self->{+MAX_SLOTS_PER_RUN}; my $wanted = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); $runner->{allotment} = $calcs->{wants}; $wanted += $calcs->{wants}; } # Everyone gets what they want! my $max = $self->{+MAX_SLOTS}; return if $wanted <= $max; my $meth = $self->{+ALGORITHM}; return $self->$meth($state); } sub _redistribute_first { my $self = shift; my ($state) = @_; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $max = $self->{+MAX_SLOTS}; my $c = 0; for my $runner (sort { $a->{added} <=> $b->{added} } values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); my $wants = $calcs->{wants}; if ($max >= $wants) { $runner->{allotment} = $wants; } else { $runner->{allotment} = max($max, $min, 0); } $max -= $runner->{allotment}; $c++; } return; } sub _redistribute_fair { my $self = shift; my ($state) = @_; my $runs = scalar keys %{$state->{+RUNNERS}}; # Avoid a divide by 0 below. return unless $runs; my $total = $self->{+MAX_SLOTS}; my $min = $self->{+MIN_SLOTS_PER_RUN}; my $used = 0; for my $runner (values %{$state->{+RUNNERS}}) { my $calcs = $self->_runner_calcs($runner); # We never want less than the 'active' number my $set = $calcs->{active}; # If min is greater than the active number and there are todo tests, we # use the min instead. $set = $min if $set < $min && $runner->todo; $runner->{allotment} = $set; $used += $set; } my $free = $total - $used; return unless $free >= 1; # Is there a more efficient way to do this? Yikes! my @runners = values %{$state->{+RUNNERS}}; while ($free > 0) { @runners = sort { $a->{allotment} <=> $b->{allotment} || $a->{added} <=> $b->{added} } grep { my $c = $self->_runner_calcs($_); $c->{wants} > $_->{allotment} } @runners; $free--; $runners[0]->{allotment}++; } return; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Config.t��������������������������������������������������������������������������������������������100644��001750��001750�� 10672�15267772575� 30174� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots���������������������������������������������������������������������������������������������use Test2::V0 -target => 'Test2::Harness::Runner::Resource::SharedJobSlots::Config'; use Test2::Harness::Runner::Resource::SharedJobSlots::Config; my $dir = __FILE__; $dir =~ s{Config\.t$}{}g; chdir($dir) or die "Could not chdir ($dir): $!"; sub CONFIG { return { DEFAULT => { default_slots_per_run => 1, default_slots_per_job => 1, }, COMMON => { algorithm => 'fair', state_file => '/tmp/yath-state-config-test', max_slots => 4, max_slots_per_run => 4, max_slots_per_job => 2, default_slots_per_run => 2, default_slots_per_job => 2, }, foo => { max_slots => 13, max_slots_per_run => 13, max_slots_per_job => 5, default_slots_per_run => 3, default_slots_per_job => 2, }, bar => { max_slots => 8, max_slots_per_run => 6, max_slots_per_job => 2, default_slots_per_run => 4, default_slots_per_job => 2, state_umask => '0077', }, baz => { algorithm => 'first', max_slots => 64, max_slots_per_run => 64, max_slots_per_job => 32, default_slots_per_run => 64, default_slots_per_job => 32, }, bat => undef, ban => { use_common => '0', }, baf => { use_common => 0, max_slots => 7, }, }; } my $one = $CLASS->find(host => 'foo'); like( $one, hash { field host => 'foo'; field common_conf => CONFIG()->{COMMON}; field host_conf => CONFIG()->{foo}; field config_file => '.sharedjobslots.yml'; field config_raw => CONFIG(); etc; }, "Found the config file, loaded options" ); is($one->state_umask, 0007, "Got default umask"); is($one->state_file, '/tmp/yath-state-config-test', "Got state file from common"); is($one->algorithm, '_redistribute_fair', "got algorithm from common"); is($one->max_slots, 13, "got max slots from host"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 5, "got max slots per job from host"); is($one->max_slots_per_run, 13, "got max slots per run from host"); is($one->default_slots_per_job, 2, "got default slots per job from host"); is($one->default_slots_per_run, 3, "got default slots per run from host"); $one = $CLASS->find(host => 'bar'); is($one->state_umask, '0077', "Got host umask"); $one = $CLASS->find(host => 'bat'); is($one->algorithm, '_redistribute_fair', "got algorithm from common"); is($one->max_slots, 4, "got max slots from common"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 2, "got max slots per job from common"); is($one->max_slots_per_run, 4, "got max slots per run from common"); is($one->default_slots_per_job, 2, "got default slots per job from common"); is($one->default_slots_per_run, 2, "got default slots per run from common"); $one = $CLASS->find(host => 'baf'); is($one->algorithm, '_redistribute_fair', "got algorithm from default"); is($one->max_slots, 7, "got max slots from host"); is($one->min_slots_per_run, 0, "default min slots per run at 0"); is($one->max_slots_per_job, 7, "got max slots per job from default"); is($one->max_slots_per_run, 7, "got max slots per run from default"); is($one->default_slots_per_job, 7, "got default slots per job from default"); is($one->default_slots_per_run, 7, "got default slots per run from default"); is( dies { $one = $CLASS->find(host => 'ban') }, "'max_slots' not set in '\.sharedjobslots\.yml' for host 'ban' or under 'COMMON' config.\n", "Need a value for max slots" ); done_testing; ����������������������������������������������������������������������CoverExcludePeek.pm���������������������������������������������������������������������������������100644��001750��001750�� 567�15267772575� 31245� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/cover_exclude_out_of_band/lib�����������������������������������������������������������������������������������������������������package CoverExcludePeek; use strict; use warnings; use parent 'App::Yath::Plugin'; sub handle_event { my $self = shift; my ($e, $settings) = @_; my $coverage = $e->{facet_data}->{coverage} or return; print "COVERAGE FACET: files=" . (ref($coverage->{files}) || 'SCALAR') . " file_count=" . ($coverage->{file_count} // 'undef') . "\n"; return; } 1; �����������������������������������������������������������������������������������������������������������������������������������������buffered_subtest_abrupt_end_nested.tx���������������������������������������������������������������100644��001750��001750�� 306�15267772575� 32027� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/integration/failure_cases���������������������������������������������������������������������������������������������������������������������use strict; use warnings; my $end = $ENV{FAILURE_DO_PASS} ? "}\n " : ""; print <<EOT; ok - outer { ok - foo { ok - pass 1..1 ${end}ok - bar 1..2 } 1..1 EOT exit 0; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.sharedjobslots.yml���������������������������������������������������������������������������������100644��001750��001750�� 1332�15267772575� 32402� 0����������������������������������������������������������������������������������������������������ustar�00exodist�������������������������exodist�������������������������000000��000000��Test2-Harness-1.000182/t/unit/Test2/Harness/Runner/Resource/SharedJobSlots���������������������������������������������������������������������������������������������--- COMMON: state_file: /tmp/yath-state-config-test algorithm: fair max_slots: 4 max_slots_per_job: 2 max_slots_per_run: 4 default_slots_per_run: 2 default_slots_per_job: 2 DEFAULT: default_slots_per_run: 1 default_slots_per_job: 1 foo: max_slots: 13 max_slots_per_job: 5 max_slots_per_run: 13 default_slots_per_run: 3 default_slots_per_job: 2 bar: max_slots: 8 max_slots_per_job: 2 max_slots_per_run: 6 default_slots_per_run: 4 default_slots_per_job: 2 state_umask: 0077 baz: max_slots: 64 max_slots_per_job: 32 max_slots_per_run: 64 default_slots_per_run: 64 default_slots_per_job: 32 algorithm: first bat: ban: use_common: 0 baf: max_slots: 7 use_common: 0 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������