?????????? ????????? - ??????????????? - /home/agenciai/public_html/cd38d8/Builder.tar
???????
IO/Scalar.pm 0000644 00000032510 15126675734 0006637 0 ustar 00 package Test::Builder::IO::Scalar; =head1 NAME Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder =head1 DESCRIPTION This is a copy of L<IO::Scalar> which ships with L<Test::Builder> to support scalar references as filehandles on Perl 5.6. Newer versions of Perl simply use C<open()>'s built in support. L<Test::Builder> can not have dependencies on other modules without careful consideration, so its simply been copied into the distribution. =head1 COPYRIGHT and LICENSE This file came from the "IO-stringy" Perl5 toolkit. Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # This is copied code, I don't care. ##no critic use Carp; use strict; use vars qw($VERSION @ISA); use IO::Handle; use 5.005; ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = "2.114"; ### Inheritance: @ISA = qw(IO::Handle); #============================== =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I<Class method.> Return a new, unattached scalar handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [SCALARREF] I<Instance method.> Open the scalar handle on a new scalar, pointed to by SCALARREF. If no SCALARREF is given, a "private" scalar is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $sref) = @_; ### Sanity: defined($sref) or do {my $s = ''; $sref = \$s}; (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; ### Setup: *$self->{Pos} = 0; ### seek position *$self->{SR} = $sref; ### scalar reference $self; } #------------------------------ =item opened I<Instance method.> Is the scalar handle opened on something? =cut sub opened { *{shift()}->{SR}; } #------------------------------ =item close I<Instance method.> Disassociate the scalar handle from its underlying scalar. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I<Instance method.> No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item getc I<Instance method.> Return the next character, or undef if none remain. =cut sub getc { my $self = shift; ### Return undef right away if at EOF; else, move pos forward: return undef if $self->eof; substr(${*$self->{SR}}, *$self->{Pos}++, 1); } #------------------------------ =item getline I<Instance method.> Return the next line, or undef on end of string. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; ### Return undef right away if at EOF: return undef if $self->eof; ### Get next line: my $sr = *$self->{SR}; my $i = *$self->{Pos}; ### Start matching at this point. ### Minimal impact implementation! ### We do the fast fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { *$self->{Pos} = length $$sr; return substr($$sr, $i); } ### Case 2: $/ is "\n": zoom zoom zoom... elsif ($/ eq "\012") { ### Seek ahead for "\n"... yes, this really is faster than regexps. my $len = length($$sr); for (; $i < $len; ++$i) { last if ord (substr ($$sr, $i, 1)) == 10; } ### Extract the line: my $line; if ($i < $len) { ### We found a "\n": $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); *$self->{Pos} = $i+1; ### Remember where we finished up. } else { ### No "\n"; slurp the remainder: $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); *$self->{Pos} = $len; } return $line; } ### Case 3: $/ is ref to int. Do fixed-size records. ### (Thanks to Dominique Quatravaux.) elsif (ref($/)) { my $len = length($$sr); my $i = ${$/} + 0; my $line = substr ($$sr, *$self->{Pos}, $i); *$self->{Pos} += $i; *$self->{Pos} = $len if (*$self->{Pos} > $len); return $line; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### This is Graham's general-purpose stuff, which might be ### a tad slower than Case 2 for typical data, because ### of the regexps. else { pos($$sr) = $i; ### If in paragraph mode, skip leading lines (and update i!): length($/) or (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); ### If we see the separator in the buffer ahead... if (length($/) ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! : $$sr =~ m,\n\n,g ### (a paragraph) ) { *$self->{Pos} = pos $$sr; return substr($$sr, $i, *$self->{Pos}-$i); } ### Else if no separator remains, just slurp the rest: else { *$self->{Pos} = length $$sr; return substr($$sr, $i); } } } #------------------------------ =item getlines I<Instance method.> Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I<Instance method.> Print ARGS to the underlying scalar. B<Warning:> this continues to always cause a seek to the end of the string, but if you perform seek()s and tell()s, it is still safer to explicitly seek-to-end before subsequent print()s. =cut sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); 1; } sub _unsafe_print { my $self = shift; my $append = join('', @_) . $\; ${*$self->{SR}} .= $append; *$self->{Pos} += length($append); 1; } sub _old_print { my $self = shift; ${*$self->{SR}} .= join('', @_) . $\; *$self->{Pos} = length(${*$self->{SR}}); 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET] I<Instance method.> Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); $n = length($read); *$self->{Pos} += $n; ($off ? substr($_[1], $off) : $_[1]) = $read; return $n; } #------------------------------ =item write BUF, NBYTES, [OFFSET] I<Instance method.> Write some bytes to the scalar. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } #------------------------------ =item sysread BUF, LEN, [OFFSET] I<Instance method.> Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub sysread { my $self = shift; $self->read(@_); } #------------------------------ =item syswrite BUF, NBYTES, [OFFSET] I<Instance method.> Write some bytes to the scalar. =cut sub syswrite { my $self = shift; $self->write(@_); } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I<Instance method.> No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I<Instance method.> No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I<Instance method.> Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I<Instance method.> Are we at end of file? =cut sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } #------------------------------ =item seek OFFSET, WHENCE I<Instance method.> Seek to a given position in the stream. =cut sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); ### Seek: if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END else { croak "bad seek whence ($whence)" } ### Fixup: if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } return 1; } #------------------------------ =item sysseek OFFSET, WHENCE I<Instance method.> Identical to C<seek OFFSET, WHENCE>, I<q.v.> =cut sub sysseek { my $self = shift; $self->seek (@_); } #------------------------------ =item tell I<Instance method.> Return the current position in the stream, as a numeric offset. =cut sub tell { *{shift()}->{Pos} } #------------------------------ =item use_RS [YESNO] I<Instance method.> B<Deprecated and ignored.> Obey the current setting of $/, like IO::Handle does? Default is false in 1.x, but cold-welded true in 2.x and later. =cut sub use_RS { my ($self, $yesno) = @_; carp "use_RS is deprecated and ignored; \$/ is always consulted\n"; } #------------------------------ =item setpos POS I<Instance method.> Set the current position, using the opaque value returned by C<getpos()>. =cut sub setpos { shift->seek($_[0],0) } #------------------------------ =item getpos I<Instance method.> Return the current position in the string, as an opaque object. =cut *getpos = \&tell; #------------------------------ =item sref I<Instance method.> Return a reference to the underlying scalar. =cut sub sref { *{shift()}->{SR} } #------------------------------ # Tied handle methods... #------------------------------ # Conventional tiehandle interface: sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__)) ? $_[1] : shift->new(@_)); } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } sub FILENO { -1 } #------------------------------------------------------------ 1; __END__ =back =cut =head1 WARNINGS Perl's TIEHANDLE spec was incomplete prior to 5.005_57; it was missing support for C<seek()>, C<tell()>, and C<eof()>. Attempting to use these functions with an IO::Scalar will not work prior to 5.005_57. IO::Scalar will not have the relevant methods invoked; and even worse, this kind of bug can lie dormant for a while. If you turn warnings on (via C<$^W> or C<perl -w>), and you see something like this... attempt to seek on unopened filehandle ...then you are probably trying to use one of these functions on an IO::Scalar with an old Perl. The remedy is to simply use the OO version; e.g.: $SH->seek(0,0); ### GOOD: will work on any 5.005 seek($SH,0,0); ### WARNING: will only work on 5.005_57 and beyond =head1 VERSION $Id: Scalar.pm,v 1.6 2005/02/10 21:21:53 dfs Exp $ =head1 AUTHORS =head2 Primary Maintainer David F. Skoll (F<dfs@roaringpenguin.com>). =head2 Principal author Eryq (F<eryq@zeegee.com>). President, ZeeGee Software Inc (F<http://www.zeegee.com>). =head2 Other contributors The full set of contributors always includes the folks mentioned in L<IO::Stringy/"CHANGE LOG">. But just the same, special thanks to the following individuals for their invaluable contributions (if I've forgotten or misspelled your name, please email me!): I<Andy Glew,> for contributing C<getc()>. I<Brandon Browning,> for suggesting C<opened()>. I<David Richter,> for finding and fixing the bug in C<PRINTF()>. I<Eric L. Brine,> for his offset-using read() and write() implementations. I<Richard Jones,> for his patches to massively improve the performance of C<getline()> and add C<sysread> and C<syswrite>. I<B. K. Oxley (binkley),> for stringification and inheritance improvements, and sundry good ideas. I<Doug Wilson,> for the IO::Handle inheritance and automatic tie-ing. =head1 SEE ALSO L<IO::String>, which is quite similar but which was designed more-recently and with an IO::Handle-like interface in mind, so you could mix OO- and native-filehandle usage without using tied(). I<Note:> as of version 2.x, these classes all work like their IO::Handle counterparts, so we have comparable functionality to IO::String. =cut Tester.pm 0000644 00000043163 15126675734 0006377 0 ustar 00 package Test::Builder::Tester; use strict; our $VERSION = '1.302183'; use Test::Builder; use Symbol; use Carp; =head1 NAME Test::Builder::Tester - test testsuites that have been built with Test::Builder =head1 SYNOPSIS use Test::Builder::Tester tests => 1; use Test::More; test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =head1 DESCRIPTION A module that helps you test testing modules that are built with L<Test::Builder>. The testing system is designed to be used by performing a three step process for each test you wish to test. This process starts with using C<test_out> and C<test_err> in advance to declare what the testsuite you are testing will output with L<Test::Builder> to stdout and stderr. You then can run the test(s) from your test suite that call L<Test::Builder>. At this point the output of L<Test::Builder> is safely captured by L<Test::Builder::Tester> rather than being interpreted as real test output. The final stage is to call C<test_test> that will simply compare what you predeclared to what L<Test::Builder> actually outputted, and report the results back with a "ok" or "not ok" (with debugging) to the normal output. =cut #### # set up testing #### my $t = Test::Builder->new; ### # make us an exporter ### use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); sub import { my $class = shift; my(@plan) = @_; my $caller = caller; $t->exported_to($caller); $t->plan(@plan); my @imports = (); foreach my $idx ( 0 .. $#plan ) { if( $plan[$idx] eq 'import' ) { @imports = @{ $plan[ $idx + 1 ] }; last; } } __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports ); } ### # set up file handles ### # create some private file handles my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; #### # exported functions #### # for remembering that we're testing and where we're testing at my $testing = 0; my $testing_num; my $original_is_passing; # remembering where the file handles were originally connected my $original_output_handle; my $original_failure_handle; my $original_todo_handle; my $original_formatter; my $original_harness_env; # function that starts testing and redirects the filehandles for now sub _start_testing { # Hack for things that conditioned on Test-Stream being loaded $INC{'Test/Stream.pm'} ||= 'fake' if $INC{'Test/Moose/More.pm'}; # even if we're running under Test::Harness pretend we're not # for now. This needed so Test::Builder doesn't add extra spaces $original_harness_env = $ENV{HARNESS_ACTIVE} || 0; $ENV{HARNESS_ACTIVE} = 0; my $hub = $t->{Hub} || ($t->{Stack} ? $t->{Stack}->top : Test2::API::test2_stack->top); $original_formatter = $hub->format; unless ($original_formatter && $original_formatter->isa('Test::Builder::Formatter')) { my $fmt = Test::Builder::Formatter->new; $hub->format($fmt); } # remember what the handles were set to $original_output_handle = $t->output(); $original_failure_handle = $t->failure_output(); $original_todo_handle = $t->todo_output(); # switch out to our own handles $t->output($output_handle); $t->failure_output($error_handle); $t->todo_output($output_handle); # clear the expected list $out->reset(); $err->reset(); # remember that we're testing $testing = 1; $testing_num = $t->current_test; $t->current_test(0); $original_is_passing = $t->is_passing; $t->is_passing(1); # look, we shouldn't do the ending stuff $t->no_ending(1); } =head2 Functions These are the six methods that are exported as default. =over 4 =item test_out =item test_err Procedures for predeclaring the output that your test suite is expected to produce until C<test_test> is called. These procedures automatically assume that each line terminates with "\n". So test_out("ok 1","ok 2"); is the same as test_out("ok 1\nok 2"); which is even the same as test_out("ok 1"); test_out("ok 2"); Once C<test_out> or C<test_err> (or C<test_fail> or C<test_diag>) have been called, all further output from L<Test::Builder> will be captured by L<Test::Builder::Tester>. This means that you will not be able perform further tests to the normal output in the normal way until you call C<test_test> (well, unless you manually meddle with the output filehandles) =cut sub test_out { # do we need to do any setup? _start_testing() unless $testing; $out->expect(@_); } sub test_err { # do we need to do any setup? _start_testing() unless $testing; $err->expect(@_); } =item test_fail Because the standard failure message that L<Test::Builder> produces whenever a test fails will be a common occurrence in your test error output, and because it has changed between Test::Builder versions, rather than forcing you to call C<test_err> with the string all the time like so test_err("# Failed test ($0 at line ".line_num(+1).")"); C<test_fail> exists as a convenience function that can be called instead. It takes one argument, the offset from the current line that the line that causes the fail is on. test_fail(+1); This means that the example in the synopsis could be rewritten more simply as: test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =cut sub test_fail { # do we need to do any setup? _start_testing() unless $testing; # work out what line we should be on my( $package, $filename, $line ) = caller; $line = $line + ( shift() || 0 ); # prevent warnings # expect that on stderr $err->expect("# Failed test ($filename at line $line)"); } =item test_diag As most of the remaining expected output to the error stream will be created by L<Test::Builder>'s C<diag> function, L<Test::Builder::Tester> provides a convenience function C<test_diag> that you can use instead of C<test_err>. The C<test_diag> function prepends comment hashes and spacing to the start and newlines to the end of the expected output passed to it and adds it to the list of expected error output. So, instead of writing test_err("# Couldn't open file"); you can write test_diag("Couldn't open file"); Remember that L<Test::Builder>'s diag function will not add newlines to the end of output and test_diag will. So to check Test::Builder->new->diag("foo\n","bar\n"); You would do test_diag("foo","bar") without the newlines. =cut sub test_diag { # do we need to do any setup? _start_testing() unless $testing; # expect the same thing, but prepended with "# " local $_; $err->expect( map { "# $_" } @_ ); } =item test_test Actually performs the output check testing the tests, comparing the data (with C<eq>) that we have captured from L<Test::Builder> against what was declared with C<test_out> and C<test_err>. This takes name/value pairs that effect how the test is run. =over =item title (synonym 'name', 'label') The name of the test that will be displayed after the C<ok> or C<not ok>. =item skip_out Setting this to a true value will cause the test to ignore if the output sent by the test to the output stream does not match that declared with C<test_out>. =item skip_err Setting this to a true value will cause the test to ignore if the output sent by the test to the error stream does not match that declared with C<test_err>. =back As a convenience, if only one argument is passed then this argument is assumed to be the name of the test (as in the above examples.) Once C<test_test> has been run test output will be redirected back to the original filehandles that L<Test::Builder> was connected to (probably STDOUT and STDERR,) meaning any further tests you run will function normally and cause success/errors for L<Test::Harness>. =cut sub test_test { # END the hack delete $INC{'Test/Stream.pm'} if $INC{'Test/Stream.pm'} && $INC{'Test/Stream.pm'} eq 'fake'; # decode the arguments as described in the pod my $mess; my %args; if( @_ == 1 ) { $mess = shift } else { %args = @_; $mess = $args{name} if exists( $args{name} ); $mess = $args{title} if exists( $args{title} ); $mess = $args{label} if exists( $args{label} ); } # er, are we testing? croak "Not testing. You must declare output with a test function first." unless $testing; my $hub = $t->{Hub} || Test2::API::test2_stack->top; $hub->format($original_formatter); # okay, reconnect the test suite back to the saved handles $t->output($original_output_handle); $t->failure_output($original_failure_handle); $t->todo_output($original_todo_handle); # restore the test no, etc, back to the original point $t->current_test($testing_num); $testing = 0; $t->is_passing($original_is_passing); # re-enable the original setting of the harness $ENV{HARNESS_ACTIVE} = $original_harness_env; # check the output we've stashed unless( $t->ok( ( $args{skip_out} || $out->check ) && ( $args{skip_err} || $err->check ), $mess ) ) { # print out the diagnostic information about why this # test failed local $_; $t->diag( map { "$_\n" } $out->complaint ) unless $args{skip_out} || $out->check; $t->diag( map { "$_\n" } $err->complaint ) unless $args{skip_err} || $err->check; } } =item line_num A utility function that returns the line number that the function was called on. You can pass it an offset which will be added to the result. This is very useful for working out the correct text of diagnostic functions that contain line numbers. Essentially this is the same as the C<__LINE__> macro, but the C<line_num(+3)> idiom is arguably nicer. =cut sub line_num { my( $package, $filename, $line ) = caller; return $line + ( shift() || 0 ); # prevent warnings } =back In addition to the six exported functions there exists one function that can only be accessed with a fully qualified function call. =over 4 =item color When C<test_test> is called and the output that your tests generate does not match that which you declared, C<test_test> will print out debug information showing the two conflicting versions. As this output itself is debug information it can be confusing which part of the output is from C<test_test> and which was the original output from your original tests. Also, it may be hard to spot things like extraneous whitespace at the end of lines that may cause your test to fail even though the output looks similar. To assist you C<test_test> can colour the background of the debug information to disambiguate the different types of output. The debug output will have its background coloured green and red. The green part represents the text which is the same between the executed and actual output, the red shows which part differs. The C<color> function determines if colouring should occur or not. Passing it a true or false value will enable or disable colouring respectively, and the function called with no argument will return the current setting. To enable colouring from the command line, you can use the L<Text::Builder::Tester::Color> module like so: perl -Mlib=Text::Builder::Tester::Color test.t Or by including the L<Test::Builder::Tester::Color> module directly in the PERL5LIB. =cut my $color; sub color { $color = shift if @_; $color; } =back =head1 BUGS Test::Builder::Tester does not handle plans well. It has never done anything special with plans. This means that plans from outside Test::Builder::Tester will effect Test::Builder::Tester, worse plans when using Test::Builder::Tester will effect overall testing. At this point there are no plans to fix this bug as people have come to depend on it, and Test::Builder::Tester is now discouraged in favor of C<Test2::API::intercept()>. See L<https://github.com/Test-More/test-more/issues/667> Calls C<< Test::Builder->no_ending >> turning off the ending tests. This is needed as otherwise it will trip out because we've run more tests than we strictly should have and it'll register any failures we had that we were testing for as real failures. The color function doesn't work unless L<Term::ANSIColor> is compatible with your terminal. Additionally, L<Win32::Console::ANSI> must be installed on windows platforms for color output. Bugs (and requests for new features) can be reported to the author though GitHub: L<https://github.com/Test-More/test-more/issues> =head1 AUTHOR Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004. Some code taken from L<Test::More> and L<Test::Catch>, written by Michael G Schwern E<lt>schwern@pobox.comE<gt>. Hence, those parts Copyright Micheal G Schwern 2001. Used and distributed with permission. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 NOTES Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting me use his testing system to try this module out on. =head1 SEE ALSO L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>. =cut 1; #################################################################### # Helper class that is used to remember expected and received data package Test::Builder::Tester::Tie; ## # add line(s) to be expected sub expect { my $self = shift; my @checks = @_; foreach my $check (@checks) { $check = $self->_account_for_subtest($check); $check = $self->_translate_Failed_check($check); push @{ $self->{wanted} }, ref $check ? $check : "$check\n"; } } sub _account_for_subtest { my( $self, $check ) = @_; my $hub = $t->{Stack}->top; my $nesting = $hub->isa('Test2::Hub::Subtest') ? $hub->nested : 0; return ref($check) ? $check : (' ' x $nesting) . $check; } sub _translate_Failed_check { my( $self, $check ) = @_; if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) { $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/"; } return $check; } ## # return true iff the expected data matches the got data sub check { my $self = shift; # turn off warnings as these might be undef local $^W = 0; my @checks = @{ $self->{wanted} }; my $got = $self->{got}; foreach my $check (@checks) { $check = "\Q$check\E" unless( $check =~ s,^/(.*)/$,$1, or ref $check ); return 0 unless $got =~ s/^$check//; } return length $got == 0; } ## # a complaint message about the inputs not matching (to be # used for debugging messages) sub complaint { my $self = shift; my $type = $self->type; my $got = $self->got; my $wanted = join '', @{ $self->wanted }; # are we running in colour mode? if(Test::Builder::Tester::color) { # get color eval { require Term::ANSIColor }; unless($@) { eval { require Win32::Console::ANSI } if 'MSWin32' eq $^O; # support color on windows platforms # colours my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green"); my $red = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_red"); my $reset = Term::ANSIColor::color("reset"); # work out where the two strings start to differ my $char = 0; $char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 ); # get the start string and the two end strings my $start = $green . substr( $wanted, 0, $char ); my $gotend = $red . substr( $got, $char ) . $reset; my $wantedend = $red . substr( $wanted, $char ) . $reset; # make the start turn green on and off $start =~ s/\n/$reset\n$green/g; # make the ends turn red on and off $gotend =~ s/\n/$reset\n$red/g; $wantedend =~ s/\n/$reset\n$red/g; # rebuild the strings $got = $start . $gotend; $wanted = $start . $wantedend; } } my @got = split "\n", $got; my @wanted = split "\n", $wanted; $got = ""; $wanted = ""; while (@got || @wanted) { my $g = shift @got || ""; my $w = shift @wanted || ""; if ($g ne $w) { if($g =~ s/(\s+)$/ |> /g) { $g .= ($_ eq ' ' ? '_' : '\t') for split '', $1; } if($w =~ s/(\s+)$/ |> /g) { $w .= ($_ eq ' ' ? '_' : '\t') for split '', $1; } $g = "> $g"; $w = "> $w"; } else { $g = " $g"; $w = " $w"; } $got = $got ? "$got\n$g" : $g; $wanted = $wanted ? "$wanted\n$w" : $w; } return "$type is:\n" . "$got\nnot:\n$wanted\nas expected"; } ## # forget all expected and got data sub reset { my $self = shift; %$self = ( type => $self->{type}, got => '', wanted => [], ); } sub got { my $self = shift; return $self->{got}; } sub wanted { my $self = shift; return $self->{wanted}; } sub type { my $self = shift; return $self->{type}; } ### # tie interface ### sub PRINT { my $self = shift; $self->{got} .= join '', @_; } sub TIEHANDLE { my( $class, $type ) = @_; my $self = bless { type => $type }, $class; $self->reset; return $self; } sub READ { } sub READLINE { } sub GETC { } sub FILENO { } 1; TodoDiag.pm 0000644 00000002071 15126675734 0006614 0 ustar 00 package Test::Builder::TodoDiag; use strict; use warnings; our $VERSION = '1.302183'; BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) } sub diagnostics { 0 } sub facet_data { my $self = shift; my $out = $self->SUPER::facet_data(); $out->{info}->[0]->{debug} = 0; return $out; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test::Builder::TodoDiag - Test::Builder subclass of Test2::Event::Diag =head1 DESCRIPTION This is used to encapsulate diag messages created inside TODO. =head1 SYNOPSIS You do not need to use this directly. =head1 SOURCE The source code repository for Test2 can be found at F<http://github.com/Test-More/test-more/>. =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 2020 Chad Granum E<lt>exodist@cpan.orgE<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.pm 0000644 00000004112 15126675734 0007063 0 ustar 00 package Test::Builder::Formatter; use strict; use warnings; our $VERSION = '1.302183'; BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) } use Test2::Util::HashBase qw/no_header no_diag/; BEGIN { *OUT_STD = Test2::Formatter::TAP->can('OUT_STD'); *OUT_ERR = Test2::Formatter::TAP->can('OUT_ERR'); my $todo = OUT_ERR() + 1; *OUT_TODO = sub() { $todo }; } sub init { my $self = shift; $self->SUPER::init(@_); $self->{+HANDLES}->[OUT_TODO] = $self->{+HANDLES}->[OUT_STD]; } sub plan_tap { my ($self, $f) = @_; return if $self->{+NO_HEADER}; return $self->SUPER::plan_tap($f); } sub debug_tap { my ($self, $f, $num) = @_; return if $self->{+NO_DIAG}; my @out = $self->SUPER::debug_tap($f, $num); $self->redirect(\@out) if @out && ref $f->{about} && defined $f->{about}->{package} && $f->{about}->{package} eq 'Test::Builder::TodoDiag'; return @out; } sub info_tap { my ($self, $f) = @_; return if $self->{+NO_DIAG}; my @out = $self->SUPER::info_tap($f); $self->redirect(\@out) if @out && ref $f->{about} && defined $f->{about}->{package} && $f->{about}->{package} eq 'Test::Builder::TodoDiag'; return @out; } sub redirect { my ($self, $out) = @_; $_->[0] = OUT_TODO for @$out; } sub no_subtest_space { 1 } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test::Builder::Formatter - Test::Builder subclass of Test2::Formatter::TAP =head1 DESCRIPTION This is what takes events and turns them into TAP. =head1 SYNOPSIS use Test::Builder; # Loads Test::Builder::Formatter for you =head1 SOURCE The source code repository for Test2 can be found at F<http://github.com/Test-More/test-more/>. =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 2020 Chad Granum E<lt>exodist@cpan.orgE<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 Module.pm 0000644 00000007757 15126675734 0006367 0 ustar 00 package Test::Builder::Module; use strict; use Test::Builder; require Exporter; our @ISA = qw(Exporter); our $VERSION = '1.302183'; =head1 NAME Test::Builder::Module - Base class for test modules =head1 SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use parent 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1; =head1 DESCRIPTION This is a superclass for L<Test::Builder>-based modules. It provides a handful of common functionality and a method of getting at the underlying L<Test::Builder> object. =head2 Importing Test::Builder::Module is a subclass of L<Exporter> which means your module is also a subclass of Exporter. @EXPORT, @EXPORT_OK, etc... all act normally. A few methods are provided to do the C<< use Your::Module tests => 23 >> part for you. =head3 import Test::Builder::Module provides an C<import()> method which acts in the same basic way as L<Test::More>'s, setting the plan and controlling exporting of functions and variables. This allows your module to set the plan independent of L<Test::More>. All arguments passed to C<import()> are passed onto C<< Your::Module->builder->plan() >> with the exception of C<< import =>[qw(things to import)] >>. use Your::Module import => [qw(this that)], tests => 23; says to import the functions C<this()> and C<that()> as well as set the plan to be 23 tests. C<import()> also sets the C<exported_to()> attribute of your builder to be the caller of the C<import()> function. Additional behaviors can be added to your C<import()> method by overriding C<import_extra()>. =cut sub import { my($class) = shift; Test2::API::test2_load() unless Test2::API::test2_in_preload(); # Don't run all this when loading ourself. return 1 if $class eq 'Test::Builder::Module'; my $test = $class->builder; my $caller = caller; $test->exported_to($caller); $class->import_extra( \@_ ); my(@imports) = $class->_strip_imports( \@_ ); $test->plan(@_); local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; $class->Exporter::import(@imports); } sub _strip_imports { my $class = shift; my $list = shift; my @imports = (); my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'import' ) { push @imports, @{ $list->[ $idx + 1 ] }; $idx++; } else { push @other, $item; } $idx++; } @$list = @other; return @imports; } =head3 import_extra Your::Module->import_extra(\@import_args); C<import_extra()> is called by C<import()>. It provides an opportunity for you to add behaviors to your module based on its import list. Any extra arguments which shouldn't be passed on to C<plan()> should be stripped off by this method. See L<Test::More> for an example of its use. B<NOTE> This mechanism is I<VERY ALPHA AND LIKELY TO CHANGE> as it feels like a bit of an ugly hack in its current form. =cut sub import_extra { } =head2 Builder Test::Builder::Module provides some methods of getting at the underlying Test::Builder object. =head3 builder my $builder = Your::Class->builder; This method returns the L<Test::Builder> object associated with Your::Class. It is not a constructor so you can call it as often as you like. This is the preferred way to get the L<Test::Builder> object. You should I<not> get it via C<< Test::Builder->new >> as was previously recommended. The object returned by C<builder()> may change at runtime so you should call C<builder()> inside each function rather than store it in a global. sub ok { my $builder = Your::Class->builder; return $builder->ok(@_); } =cut sub builder { return Test::Builder->new; } =head1 SEE ALSO L<< Test2::Manual::Tooling::TestBuilder >> describes the improved options for writing testing modules provided by L<< Test2 >>. =cut 1; Tester/Color.pm 0000644 00000001715 15126675734 0007452 0 ustar 00 package Test::Builder::Tester::Color; use strict; our $VERSION = '1.302183'; require Test::Builder::Tester; =head1 NAME Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester =head1 SYNOPSIS When running a test script perl -MTest::Builder::Tester::Color test.t =head1 DESCRIPTION Importing this module causes the subroutine color in Test::Builder::Tester to be called with a true value causing colour highlighting to be turned on in debug output. The sole purpose of this module is to enable colour highlighting from the command line. =cut sub import { Test::Builder::Tester::color(1); } =head1 AUTHOR Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS This module will have no effect unless Term::ANSIColor is installed. =head1 SEE ALSO L<Test::Builder::Tester>, L<Term::ANSIColor> =cut 1; is_fh.t 0000644 00000001717 15127535424 0006037 0 ustar 00 #!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use strict; use Test::More tests => 11; use TieOut; ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' ); ok( !Test::Builder->is_fh(''), 'empty string' ); ok( !Test::Builder->is_fh(undef), 'undef' ); ok( open(FILE, '>foo') ); END { close FILE; 1 while unlink 'foo' } ok( Test::Builder->is_fh(*FILE) ); ok( Test::Builder->is_fh(\*FILE) ); ok( Test::Builder->is_fh(*FILE{IO}) ); tie *OUT, 'TieOut'; ok( Test::Builder->is_fh(*OUT) ); ok( Test::Builder->is_fh(\*OUT) ); SKIP: { skip "*TIED_HANDLE{IO} doesn't work in this perl", 1 unless defined *OUT{IO}; ok( Test::Builder->is_fh(*OUT{IO}) ); } package Lying::isa; sub isa { my $self = shift; my $parent = shift; return 1 if $parent eq 'IO::Handle'; } ::ok( Test::Builder->is_fh(bless {}, "Lying::isa")); no_ending.t 0000644 00000000555 15127535424 0006706 0 ustar 00 use Test::Builder; # HARNESS-NO-STREAM BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } BEGIN { my $t = Test::Builder->new; $t->no_ending(1); } use Test::More tests => 3; # Normally, Test::More would yell that we ran too few tests, but we # suppressed the ending diagnostics. pass; print "ok 2\n"; print "ok 3\n"; fork_with_new_stdout.t 0000644 00000001474 15127535424 0011216 0 ustar 00 #!perl -w use strict; use warnings; use Test2::Util qw/CAN_FORK/; BEGIN { unless (CAN_FORK) { require Test::More; Test::More->import(skip_all => "fork is not supported"); } } use IO::Pipe; use Test::Builder; use Config; my $b = Test::Builder->new; $b->reset; $b->plan('tests' => 2); my $pipe = IO::Pipe->new; if (my $pid = fork) { $pipe->reader; my ($one, $two) = <$pipe>; $b->like($one, qr/ok 1/, "ok 1 from child"); $b->like($two, qr/1\.\.1/, "1..1 from child"); waitpid($pid, 0); } else { require Test::Builder::Formatter; $b->{Stack}->top->format(Test::Builder::Formatter->new()); $pipe->writer; $b->reset; $b->no_plan; $b->output($pipe); $b->ok(1); $b->done_testing; } =pod #actual 1..2 ok 1 1..1 ok 1 ok 2 #expected 1..2 ok 1 ok 2 =cut is_passing.t 0000644 00000004347 15127535424 0007110 0 ustar 00 #!/usr/bin/perl -w use strict; use lib 't/lib'; # We're going to need to override exit() later BEGIN { require Test2::Hub; no warnings 'redefine'; *Test2::Hub::terminate = sub { my $status = @_ ? 0 : shift; CORE::exit $status; }; } use Test::More; use Test::Builder; use Test::Builder::NoOutput; { my $tb = Test::Builder::NoOutput->create; ok $tb->is_passing, "a fresh TB object is passing"; $tb->ok(1); ok $tb->is_passing, " still passing after a test"; $tb->ok(0); ok !$tb->is_passing, " not passing after a failing test"; $tb->ok(1); ok !$tb->is_passing, " a passing test doesn't resurrect it"; $tb->done_testing(3); ok !$tb->is_passing, " a successful plan doesn't help either"; } # See if is_passing() notices a plan overrun { my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 1 ); $tb->ok(1); ok $tb->is_passing, "Passing with a plan"; $tb->ok(1); ok !$tb->is_passing, " passing test, but it overran the plan"; } # is_passing() vs no_plan { my $tb = Test::Builder::NoOutput->create; $tb->plan( "no_plan" ); ok $tb->is_passing, "Passing with no_plan"; $tb->ok(1); ok $tb->is_passing, " still passing after a test"; $tb->ok(1); ok $tb->is_passing, " and another test"; $tb->_ending; ok $tb->is_passing, " and after the ending"; } # is_passing() vs skip_all { my $tb = Test::Builder::NoOutput->create; { no warnings 'redefine'; local *Test2::Hub::terminate = sub { 1 }; $tb->plan( "skip_all" ); } ok $tb->is_passing, "Passing with skip_all"; } # is_passing() vs done_testing(#) { my $tb = Test::Builder::NoOutput->create; $tb->ok(1); $tb->done_testing(2); ok !$tb->is_passing, "All tests passed but done_testing() does not match"; } # is_passing() with no tests run vs done_testing() { my $tb = Test::Builder::NoOutput->create; $tb->done_testing(); ok !$tb->is_passing, "No tests run with done_testing()"; } # is_passing() with no tests run vs done_testing() { my $tb = Test::Builder::NoOutput->create; $tb->ok(1); $tb->done_testing(); ok $tb->is_passing, "All tests passed with done_testing()"; } done_testing(); current_test_without_plan.t 0000644 00000000351 15127535424 0012256 0 ustar 00 #!/usr/bin/perl -w # Test that current_test() will work without a declared plan. use Test::Builder; my $tb = Test::Builder->new; $tb->current_test(2); print <<'END'; ok 1 ok 2 END $tb->ok(1, "Third test"); $tb->done_testing(3); done_testing_double.t 0000644 00000001752 15127535424 0010762 0 ustar 00 #!/usr/bin/perl -w use strict; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::Builder; use Test::Builder::NoOutput; my $tb = Test::Builder::NoOutput->create; # $tb methods expect to be wrapped in at least 1 sub sub done_testing { $tb->done_testing(@_) } sub ok { $tb->ok(@_) } { # Normalize test output local $ENV{HARNESS_ACTIVE}; ok(1); ok(1); ok(1); #line 24 done_testing(3); done_testing; done_testing; } my $Test = Test::Builder->new; $Test->plan( tests => 1 ); $Test->level(0); $Test->is_eq($tb->read, <<"END", "multiple done_testing"); ok 1 ok 2 ok 3 1..3 not ok 4 - done_testing() was already called at $0 line 24 # Failed test 'done_testing() was already called at $0 line 24' # at $0 line 25. not ok 5 - done_testing() was already called at $0 line 24 # Failed test 'done_testing() was already called at $0 line 24' # at $0 line 26. END current_test.t 0000644 00000000441 15127535424 0007461 0 ustar 00 #!/usr/bin/perl -w # Dave Rolsky found a bug where if current_test() is used and no # tests are run via Test::Builder it will blow up. use strict; use warnings; use Test::Builder; my $TB = Test::Builder->new; $TB->plan(tests => 2); print "ok 1\n"; print "ok 2\n"; $TB->current_test(2); maybe_regex.t 0000644 00000002442 15127535424 0007232 0 ustar 00 #!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use strict; use Test::More tests => 16; use Test::Builder; my $Test = Test::Builder->new; my $r = $Test->maybe_regex(qr/^FOO$/i); ok(defined $r, 'qr// detected'); ok(('foo' =~ /$r/), 'qr// good match'); ok(('bar' !~ /$r/), 'qr// bad match'); SKIP: { skip "blessed regex checker added in 5.10", 3 if $] < 5.010; my $obj = bless qr/foo/, 'Wibble'; my $re = $Test->maybe_regex($obj); ok( defined $re, "blessed regex detected" ); ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' ); ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' ); } { my $r = $Test->maybe_regex('/^BAR$/i'); ok(defined $r, '"//" detected'); ok(('bar' =~ m/$r/), '"//" good match'); ok(('foo' !~ m/$r/), '"//" bad match'); }; { my $r = $Test->maybe_regex('not a regex'); ok(!defined $r, 'non-regex detected'); }; { my $r = $Test->maybe_regex('/0/'); ok(defined $r, 'non-regex detected'); ok(('f00' =~ m/$r/), '"//" good match'); ok(('b4r' !~ m/$r/), '"//" bad match'); }; { my $r = $Test->maybe_regex('m,foo,i'); ok(defined $r, 'm,, detected'); ok(('fOO' =~ m/$r/), '"//" good match'); ok(('bar' !~ m/$r/), '"//" bad match'); }; done_testing_with_plan.t 0000644 00000000231 15127535424 0011464 0 ustar 00 #!/usr/bin/perl -w use strict; use Test::Builder; my $tb = Test::Builder->new; $tb->plan( tests => 2 ); $tb->ok(1); $tb->ok(1); $tb->done_testing(2); done_testing_with_number.t 0000644 00000000354 15127535424 0012030 0 ustar 00 #!/usr/bin/perl -w use strict; use Test::Builder; my $tb = Test::Builder->new; $tb->level(0); $tb->ok(1, "testing done_testing() with no arguments"); $tb->ok(1, " another test so we're not testing just one"); $tb->done_testing(2); output.t 0000644 00000003713 15127535424 0006305 0 ustar 00 #!perl -w use strict; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } chdir 't'; use Test::Builder; # The real Test::Builder my $Test = Test::Builder->new; $Test->plan( tests => 6 ); # The one we're going to test. my $tb = Test::Builder->create(); my $tmpfile = 'foo.tmp'; END { 1 while unlink($tmpfile) } # Test output to a file { my $out = $tb->output($tmpfile); $Test->ok( defined $out ); print $out "hi!\n"; close *$out; undef $out; open(IN, $tmpfile) or die $!; chomp(my $line = <IN>); close IN; $Test->is_eq($line, 'hi!'); } # Test output to a filehandle { open(FOO, ">>$tmpfile") or die $!; my $out = $tb->output(\*FOO); my $old = select *$out; print "Hello!\n"; close *$out; undef $out; select $old; open(IN, $tmpfile) or die $!; my @lines = <IN>; close IN; $Test->like($lines[1], qr/Hello!/); } # Test output to a scalar ref { my $scalar = ''; my $out = $tb->output(\$scalar); print $out "Hey hey hey!\n"; $Test->is_eq($scalar, "Hey hey hey!\n"); } # Test we can output to the same scalar ref { my $scalar = ''; my $out = $tb->output(\$scalar); my $err = $tb->failure_output(\$scalar); print $out "To output "; print $err "and beyond!"; $Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles"); } # Ensure stray newline in name escaping works. { my $fakeout = ''; my $out = $tb->output(\$fakeout); $tb->exported_to(__PACKAGE__); $tb->no_ending(1); $tb->plan(tests => 5); $tb->ok(1, "ok"); $tb->ok(1, "ok\n"); $tb->ok(1, "ok, like\nok"); $tb->skip("wibble\nmoof"); $tb->todo_skip("todo\nskip\n"); $Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout; 1..5 ok 1 - ok ok 2 - ok # ok 3 - ok, like # ok ok 4 # skip wibble # moof not ok 5 # TODO & SKIP todo # skip # OUTPUT } done_testing_plan_mismatch.t 0000644 00000001572 15127535424 0012327 0 ustar 00 #!/usr/bin/perl -w # What if there's a plan and done_testing but they don't match? use strict; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::Builder; use Test::Builder::NoOutput; my $tb = Test::Builder::NoOutput->create; # TB methods expect to be wrapped sub ok { $tb->ok(@_) } sub plan { $tb->plan(@_) } sub done_testing { $tb->done_testing(@_) } { # Normalize test output local $ENV{HARNESS_ACTIVE}; plan( tests => 3 ); ok(1); ok(1); ok(1); #line 24 done_testing(2); } my $Test = Test::Builder->new; $Test->plan( tests => 1 ); $Test->level(0); $Test->is_eq($tb->read, <<"END"); 1..3 ok 1 ok 2 ok 3 not ok 4 - planned to run 3 but done_testing() expects 2 # Failed test 'planned to run 3 but done_testing() expects 2' # at $0 line 24. END Builder.t 0000644 00000001217 15127535424 0006330 0 ustar 00 #!/usr/bin/perl -w # HARNESS-NO-STREAM BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use Test::Builder; my $Test = Test::Builder->new; $Test->plan( tests => 7 ); my $default_lvl = $Test->level; $Test->level(0); $Test->ok( 1, 'compiled and new()' ); $Test->ok( $default_lvl == 1, 'level()' ); $Test->is_eq('foo', 'foo', 'is_eq'); $Test->is_num('23.0', '23', 'is_num'); $Test->is_num( $Test->current_test, 4, 'current_test() get' ); my $test_num = $Test->current_test + 1; $Test->current_test( $test_num ); print "ok $test_num - current_test() set\n"; $Test->ok( 1, 'counter still good' ); no_plan_at_all.t 0000644 00000001322 15127535424 0007701 0 ustar 00 #!/usr/bin/perl -w # Test what happens when no plan is declared and done_testing() is not seen use strict; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::Builder; use Test::Builder::NoOutput; my $Test = Test::Builder->new; $Test->level(0); $Test->plan( tests => 1 ); my $tb = Test::Builder::NoOutput->create; { $tb->level(0); $tb->ok(1, "just a test"); $tb->ok(1, " and another"); $tb->_ending; } $Test->is_eq($tb->read, <<'END', "proper behavior when no plan is seen"); ok 1 - just a test ok 2 - and another # Tests were run but no plan was declared and done_testing() was not seen. END ok_obj.t 0000644 00000000716 15127535424 0006210 0 ustar 00 #!/usr/bin/perl -w # Testing to make sure Test::Builder doesn't accidentally store objects # passed in as test arguments. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use Test::More tests => 4; package Foo; my $destroyed = 0; sub new { bless {}, shift } sub DESTROY { $destroyed++; } package main; for (1..3) { ok(my $foo = Foo->new, 'created Foo object'); } is $destroyed, 3, "DESTROY called 3 times"; reset_outputs.t 0000644 00000001420 15127535424 0007663 0 ustar 00 #!perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::Builder; use Test::More 'no_plan'; { my $tb = Test::Builder->create(); # Store the original output filehandles and change them all. my %original_outputs; open my $fh, ">", "dummy_file.tmp"; END { 1 while unlink "dummy_file.tmp"; } for my $method (qw(output failure_output todo_output)) { $original_outputs{$method} = $tb->$method(); $tb->$method($fh); is $tb->$method(), $fh; } $tb->reset_outputs; for my $method (qw(output failure_output todo_output)) { is $tb->$method(), $original_outputs{$method}, "reset_outputs() resets $method"; } } has_plan2.t 0000644 00000000543 15127535424 0006612 0 ustar 00 #!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use Test::More; BEGIN { if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { plan skip_all => "Won't work with t/TEST"; } } use strict; use Test::Builder; plan 'no_plan'; is(Test::Builder->new->has_plan, 'no_plan', 'has no_plan'); carp.t 0000644 00000001113 15127535424 0005662 0 ustar 00 #!/usr/bin/perl BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use Test::More tests => 3; use Test::Builder; my $tb = Test::Builder->create; sub foo { $tb->croak("foo") } sub bar { $tb->carp("bar") } eval { foo() }; is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; eval { $tb->croak("this") }; is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; { my $warning = ''; local $SIG{__WARN__} = sub { $warning .= join '', @_; }; bar(); is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; } create.t 0000644 00000001462 15127535424 0006207 0 ustar 00 #!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::More tests => 7; use Test::Builder; use Test::Builder::NoOutput; my $more_tb = Test::More->builder; isa_ok $more_tb, 'Test::Builder'; is $more_tb, Test::More->builder, 'create does not interfere with ->builder'; is $more_tb, Test::Builder->new, ' does not interfere with ->new'; { my $new_tb = Test::Builder::NoOutput->create; isa_ok $new_tb, 'Test::Builder'; isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object'; $new_tb->plan(tests => 1); $new_tb->ok(1, "a test"); is $new_tb->read, <<'OUT'; 1..1 ok 1 - a test OUT } pass("Changing output() of new TB doesn't interfere with singleton"); details.t 0000644 00000005776 15127535424 0006405 0 ustar 00 #!/usr/bin/perl -w # HARNESS-NO-STREAM BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::More; use Test::Builder; my $Test = Test::Builder->new; $Test->plan( tests => 9 ); $Test->level(0); my @Expected_Details; $Test->is_num( scalar $Test->summary(), 0, 'no tests yet, no summary' ); push @Expected_Details, { 'ok' => 1, actual_ok => 1, name => 'no tests yet, no summary', type => '', reason => '' }; # Inline TODO tests will confuse pre 1.20 Test::Harness, so we # should just avoid the problem and not print it out. my $start_test = $Test->current_test + 1; my $output = ''; $Test->output(\$output); $Test->todo_output(\$output); SKIP: { $Test->skip( 'just testing skip' ); } push @Expected_Details, { 'ok' => 1, actual_ok => 1, name => '', type => 'skip', reason => 'just testing skip', }; TODO: { local $TODO = 'i need a todo'; $Test->ok( 0, 'a test to todo!' ); push @Expected_Details, { 'ok' => 1, actual_ok => 0, name => 'a test to todo!', type => 'todo', reason => 'i need a todo', }; $Test->todo_skip( 'i need both' ); } push @Expected_Details, { 'ok' => 1, actual_ok => 0, name => '', type => 'todo_skip', reason => 'i need both' }; for ($start_test..$Test->current_test) { print "ok $_\n" } $Test->reset_outputs; $Test->is_num( scalar $Test->summary(), 4, 'summary' ); push @Expected_Details, { 'ok' => 1, actual_ok => 1, name => 'summary', type => '', reason => '', }; $Test->current_test(6); print "ok 6 - current_test incremented\n"; push @Expected_Details, { 'ok' => 1, actual_ok => undef, name => undef, type => 'unknown', reason => 'incrementing test number', }; my @details = $Test->details(); $Test->is_num( scalar @details, 6, 'details() should return a list of all test details'); $Test->level(1); is_deeply( \@details, \@Expected_Details ); # This test has to come last because it thrashes the test details. { my $curr_test = $Test->current_test; $Test->current_test(4); my @details = $Test->details(); $Test->current_test($curr_test); $Test->is_num( scalar @details, 4 ); } no_diag.t 0000644 00000000466 15127535424 0006347 0 ustar 00 #!/usr/bin/perl -w use Test::More 'no_diag'; plan 'skip_all' => "This test cannot be run with the current formatter" unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter'); pass('foo'); diag('This should not be displayed'); is(Test::More->builder->no_diag, 1); done_testing; done_testing.t 0000644 00000000353 15127535424 0007424 0 ustar 00 #!/usr/bin/perl -w use strict; use Test::Builder; my $tb = Test::Builder->new; $tb->level(0); $tb->ok(1, "testing done_testing() with no arguments"); $tb->ok(1, " another test so we're not testing just one"); $tb->done_testing(); no_header.t 0000644 00000000452 15127535424 0006666 0 ustar 00 BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use Test::Builder; # STDOUT must be unbuffered else our prints might come out after # Test::More's. $| = 1; BEGIN { Test::Builder->new->no_header(1); } use Test::More tests => 1; print "1..1\n"; pass; reset.t 0000644 00000004024 15127535424 0006063 0 ustar 00 #!/usr/bin/perl -w # HARNESS-NO-STREAM # Test Test::Builder->reset; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } chdir 't'; use Test::Builder; my $Test = Test::Builder->new; my $tb = Test::Builder->create; # We'll need this later to know the outputs were reset my %Original_Output; $Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output); # Alter the state of Test::Builder as much as possible. my $output = ''; $tb->output(\$output); $tb->failure_output(\$output); $tb->todo_output(\$output); $tb->plan(tests => 14); $tb->level(0); $tb->ok(1, "Running a test to alter TB's state"); # This won't print since we just sent output off to oblivion. $tb->ok(0, "And a failure for fun"); $Test::Builder::Level = 3; $tb->exported_to('Foofer'); $tb->use_numbers(0); $tb->no_header(1); $tb->no_ending(1); $tb->done_testing; # make sure done_testing gets reset # Now reset it. $tb->reset; # Test the state of the reset builder $Test->ok( !defined $tb->exported_to, 'exported_to' ); $Test->is_eq( $tb->expected_tests, 0, 'expected_tests' ); $Test->is_eq( $tb->level, 1, 'level' ); $Test->is_eq( $tb->use_numbers, 1, 'use_numbers' ); $Test->is_eq( $tb->no_header, 0, 'no_header' ); $Test->is_eq( $tb->no_ending, 0, 'no_ending' ); $Test->is_eq( $tb->current_test, 0, 'current_test' ); $Test->is_eq( scalar $tb->summary, 0, 'summary' ); $Test->is_eq( scalar $tb->details, 0, 'details' ); $Test->is_eq( fileno $tb->output, fileno $Original_Output{output}, 'output' ); $Test->is_eq( fileno $tb->failure_output, fileno $Original_Output{failure_output}, 'failure_output' ); $Test->is_eq( fileno $tb->todo_output, fileno $Original_Output{todo_output}, 'todo_output' ); # The reset Test::Builder will take over from here. $Test->no_ending(1); $tb->current_test($Test->current_test); $tb->level(0); $tb->ok(1, 'final test to make sure output was reset'); $tb->done_testing; has_plan.t 0000644 00000000556 15127535424 0006534 0 ustar 00 #!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib'); } } use strict; use Test::Builder; my $unplanned; BEGIN { $unplanned = 'oops'; $unplanned = Test::Builder->new->has_plan; }; use Test::More tests => 2; is($unplanned, undef, 'no plan yet defined'); is(Test::Builder->new->has_plan, 2, 'has fixed plan'); done_testing_with_no_plan.t 0000644 00000000230 15127535424 0012157 0 ustar 00 #!/usr/bin/perl -w use strict; use Test::Builder; my $tb = Test::Builder->new; $tb->plan( "no_plan" ); $tb->ok(1); $tb->ok(1); $tb->done_testing(2); try.t 0000644 00000001353 15127535424 0005561 0 ustar 00 #!perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use strict; use Test::More 'no_plan'; require Test::Builder; my $tb = Test::Builder->new; # Test that _try() has no effect on $@ and $! and is not effected by # __DIE__ { local $SIG{__DIE__} = sub { fail("DIE handler called: @_") }; local $@ = 42; local $! = 23; is $tb->_try(sub { 2 }), 2; is $tb->_try(sub { return '' }), ''; is $tb->_try(sub { die; }), undef; is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"]; is $@, 42; cmp_ok $!, '==', 23; } ok !eval { $tb->_try(sub { die "Died\n" }, die_on_fail => 1); }; is $@, "Died\n"; ClassConst.php 0000644 00000007443 15127673200 0007344 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; use PhpParser\Node\Const_; use PhpParser\Node\Identifier; use PhpParser\Node\Stmt; class ClassConst implements PhpParser\Builder { protected int $flags = 0; /** @var array<string, mixed> */ protected array $attributes = []; /** @var list<Const_> */ protected array $constants = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** @var Identifier|Node\Name|Node\ComplexType|null */ protected ?Node $type = null; /** * Creates a class constant builder * * @param string|Identifier $name Name * @param Node\Expr|bool|null|int|float|string|array|\UnitEnum $value Value */ public function __construct($name, $value) { $this->constants = [new Const_($name, BuilderHelpers::normalizeValue($value))]; } /** * Add another constant to const group * * @param string|Identifier $name Name * @param Node\Expr|bool|null|int|float|string|array|\UnitEnum $value Value * * @return $this The builder instance (for fluid interface) */ public function addConst($name, $value) { $this->constants[] = new Const_($name, BuilderHelpers::normalizeValue($value)); return $this; } /** * Makes the constant public. * * @return $this The builder instance (for fluid interface) */ public function makePublic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PUBLIC); return $this; } /** * Makes the constant protected. * * @return $this The builder instance (for fluid interface) */ public function makeProtected() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED); return $this; } /** * Makes the constant private. * * @return $this The builder instance (for fluid interface) */ public function makePrivate() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE); return $this; } /** * Makes the constant final. * * @return $this The builder instance (for fluid interface) */ public function makeFinal() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::FINAL); return $this; } /** * Sets doc comment for the constant. * * @param PhpParser\Comment\Doc|string $docComment Doc comment to set * * @return $this The builder instance (for fluid interface) */ public function setDocComment($docComment) { $this->attributes = [ 'comments' => [BuilderHelpers::normalizeDocComment($docComment)] ]; return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Sets the constant type. * * @param string|Node\Name|Identifier|Node\ComplexType $type * * @return $this */ public function setType($type) { $this->type = BuilderHelpers::normalizeType($type); return $this; } /** * Returns the built class node. * * @return Stmt\ClassConst The built constant node */ public function getNode(): PhpParser\Node { return new Stmt\ClassConst( $this->constants, $this->flags, $this->attributes, $this->attributeGroups, $this->type ); } } Function_.php 0000644 00000003233 15127673200 0007205 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Stmt; class Function_ extends FunctionLike { protected string $name; /** @var list<Stmt> */ protected array $stmts = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates a function builder. * * @param string $name Name of the function */ public function __construct(string $name) { $this->name = $name; } /** * Adds a statement. * * @param Node|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $this->stmts[] = BuilderHelpers::normalizeStmt($stmt); return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built function node. * * @return Stmt\Function_ The built function node */ public function getNode(): Node { return new Stmt\Function_($this->name, [ 'byRef' => $this->returnByRef, 'params' => $this->params, 'returnType' => $this->returnType, 'stmts' => $this->stmts, 'attrGroups' => $this->attributeGroups, ], $this->attributes); } } FunctionLike.php 0000644 00000003416 15127673200 0007656 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser\BuilderHelpers; use PhpParser\Node; abstract class FunctionLike extends Declaration { protected bool $returnByRef = false; /** @var Node\Param[] */ protected array $params = []; /** @var Node\Identifier|Node\Name|Node\ComplexType|null */ protected ?Node $returnType = null; /** * Make the function return by reference. * * @return $this The builder instance (for fluid interface) */ public function makeReturnByRef() { $this->returnByRef = true; return $this; } /** * Adds a parameter. * * @param Node\Param|Param $param The parameter to add * * @return $this The builder instance (for fluid interface) */ public function addParam($param) { $param = BuilderHelpers::normalizeNode($param); if (!$param instanceof Node\Param) { throw new \LogicException(sprintf('Expected parameter node, got "%s"', $param->getType())); } $this->params[] = $param; return $this; } /** * Adds multiple parameters. * * @param (Node\Param|Param)[] $params The parameters to add * * @return $this The builder instance (for fluid interface) */ public function addParams(array $params) { foreach ($params as $param) { $this->addParam($param); } return $this; } /** * Sets the return type for PHP 7. * * @param string|Node\Name|Node\Identifier|Node\ComplexType $type * * @return $this The builder instance (for fluid interface) */ public function setReturnType($type) { $this->returnType = BuilderHelpers::normalizeType($type); return $this; } } Use_.php 0000644 00000002375 15127673200 0006162 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser\Builder; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Stmt; class Use_ implements Builder { protected Node\Name $name; /** @var Stmt\Use_::TYPE_* */ protected int $type; protected ?string $alias = null; /** * Creates a name use (alias) builder. * * @param Node\Name|string $name Name of the entity (namespace, class, function, constant) to alias * @param Stmt\Use_::TYPE_* $type One of the Stmt\Use_::TYPE_* constants */ public function __construct($name, int $type) { $this->name = BuilderHelpers::normalizeName($name); $this->type = $type; } /** * Sets alias for used name. * * @param string $alias Alias to use (last component of full name by default) * * @return $this The builder instance (for fluid interface) */ public function as(string $alias) { $this->alias = $alias; return $this; } /** * Returns the built node. * * @return Stmt\Use_ The built node */ public function getNode(): Node { return new Stmt\Use_([ new Node\UseItem($this->name, $this->alias) ], $this->type); } } TraitUseAdaptation.php 0000644 00000010252 15127673200 0011025 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser\Builder; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; use PhpParser\Node\Stmt; class TraitUseAdaptation implements Builder { private const TYPE_UNDEFINED = 0; private const TYPE_ALIAS = 1; private const TYPE_PRECEDENCE = 2; protected int $type; protected ?Node\Name $trait; protected Node\Identifier $method; protected ?int $modifier = null; protected ?Node\Identifier $alias = null; /** @var Node\Name[] */ protected array $insteadof = []; /** * Creates a trait use adaptation builder. * * @param Node\Name|string|null $trait Name of adapted trait * @param Node\Identifier|string $method Name of adapted method */ public function __construct($trait, $method) { $this->type = self::TYPE_UNDEFINED; $this->trait = is_null($trait) ? null : BuilderHelpers::normalizeName($trait); $this->method = BuilderHelpers::normalizeIdentifier($method); } /** * Sets alias of method. * * @param Node\Identifier|string $alias Alias for adapted method * * @return $this The builder instance (for fluid interface) */ public function as($alias) { if ($this->type === self::TYPE_UNDEFINED) { $this->type = self::TYPE_ALIAS; } if ($this->type !== self::TYPE_ALIAS) { throw new \LogicException('Cannot set alias for not alias adaptation buider'); } $this->alias = BuilderHelpers::normalizeIdentifier($alias); return $this; } /** * Sets adapted method public. * * @return $this The builder instance (for fluid interface) */ public function makePublic() { $this->setModifier(Modifiers::PUBLIC); return $this; } /** * Sets adapted method protected. * * @return $this The builder instance (for fluid interface) */ public function makeProtected() { $this->setModifier(Modifiers::PROTECTED); return $this; } /** * Sets adapted method private. * * @return $this The builder instance (for fluid interface) */ public function makePrivate() { $this->setModifier(Modifiers::PRIVATE); return $this; } /** * Adds overwritten traits. * * @param Node\Name|string ...$traits Traits for overwrite * * @return $this The builder instance (for fluid interface) */ public function insteadof(...$traits) { if ($this->type === self::TYPE_UNDEFINED) { if (is_null($this->trait)) { throw new \LogicException('Precedence adaptation must have trait'); } $this->type = self::TYPE_PRECEDENCE; } if ($this->type !== self::TYPE_PRECEDENCE) { throw new \LogicException('Cannot add overwritten traits for not precedence adaptation buider'); } foreach ($traits as $trait) { $this->insteadof[] = BuilderHelpers::normalizeName($trait); } return $this; } protected function setModifier(int $modifier): void { if ($this->type === self::TYPE_UNDEFINED) { $this->type = self::TYPE_ALIAS; } if ($this->type !== self::TYPE_ALIAS) { throw new \LogicException('Cannot set access modifier for not alias adaptation buider'); } if (is_null($this->modifier)) { $this->modifier = $modifier; } else { throw new \LogicException('Multiple access type modifiers are not allowed'); } } /** * Returns the built node. * * @return Node The built node */ public function getNode(): Node { switch ($this->type) { case self::TYPE_ALIAS: return new Stmt\TraitUseAdaptation\Alias($this->trait, $this->method, $this->modifier, $this->alias); case self::TYPE_PRECEDENCE: return new Stmt\TraitUseAdaptation\Precedence($this->trait, $this->method, $this->insteadof); default: throw new \LogicException('Type of adaptation is not defined'); } } } Property.php 0000644 00000013163 15127673200 0007110 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; use PhpParser\Node\Identifier; use PhpParser\Node\Name; use PhpParser\Node\Stmt; use PhpParser\Node\ComplexType; class Property implements PhpParser\Builder { protected string $name; protected int $flags = 0; protected ?Node\Expr $default = null; /** @var array<string, mixed> */ protected array $attributes = []; /** @var null|Identifier|Name|ComplexType */ protected ?Node $type = null; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** @var list<Node\PropertyHook> */ protected array $hooks = []; /** * Creates a property builder. * * @param string $name Name of the property */ public function __construct(string $name) { $this->name = $name; } /** * Makes the property public. * * @return $this The builder instance (for fluid interface) */ public function makePublic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PUBLIC); return $this; } /** * Makes the property protected. * * @return $this The builder instance (for fluid interface) */ public function makeProtected() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED); return $this; } /** * Makes the property private. * * @return $this The builder instance (for fluid interface) */ public function makePrivate() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE); return $this; } /** * Makes the property static. * * @return $this The builder instance (for fluid interface) */ public function makeStatic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::STATIC); return $this; } /** * Makes the property readonly. * * @return $this The builder instance (for fluid interface) */ public function makeReadonly() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::READONLY); return $this; } /** * Makes the property abstract. Requires at least one property hook to be specified as well. * * @return $this The builder instance (for fluid interface) */ public function makeAbstract() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::ABSTRACT); return $this; } /** * Makes the property final. * * @return $this The builder instance (for fluid interface) */ public function makeFinal() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::FINAL); return $this; } /** * Gives the property private(set) visibility. * * @return $this The builder instance (for fluid interface) */ public function makePrivateSet() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE_SET); return $this; } /** * Gives the property protected(set) visibility. * * @return $this The builder instance (for fluid interface) */ public function makeProtectedSet() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED_SET); return $this; } /** * Sets default value for the property. * * @param mixed $value Default value to use * * @return $this The builder instance (for fluid interface) */ public function setDefault($value) { $this->default = BuilderHelpers::normalizeValue($value); return $this; } /** * Sets doc comment for the property. * * @param PhpParser\Comment\Doc|string $docComment Doc comment to set * * @return $this The builder instance (for fluid interface) */ public function setDocComment($docComment) { $this->attributes = [ 'comments' => [BuilderHelpers::normalizeDocComment($docComment)] ]; return $this; } /** * Sets the property type for PHP 7.4+. * * @param string|Name|Identifier|ComplexType $type * * @return $this */ public function setType($type) { $this->type = BuilderHelpers::normalizeType($type); return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Adds a property hook. * * @return $this The builder instance (for fluid interface) */ public function addHook(Node\PropertyHook $hook) { $this->hooks[] = $hook; return $this; } /** * Returns the built class node. * * @return Stmt\Property The built property node */ public function getNode(): PhpParser\Node { if ($this->flags & Modifiers::ABSTRACT && !$this->hooks) { throw new PhpParser\Error('Only hooked properties may be declared abstract'); } return new Stmt\Property( $this->flags !== 0 ? $this->flags : Modifiers::PUBLIC, [ new Node\PropertyItem($this->name, $this->default) ], $this->attributes, $this->type, $this->attributeGroups, $this->hooks ); } } EnumCase.php 0000644 00000003724 15127673200 0006766 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Identifier; use PhpParser\Node\Stmt; class EnumCase implements PhpParser\Builder { /** @var Identifier|string */ protected $name; protected ?Node\Expr $value = null; /** @var array<string, mixed> */ protected array $attributes = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates an enum case builder. * * @param string|Identifier $name Name */ public function __construct($name) { $this->name = $name; } /** * Sets the value. * * @param Node\Expr|string|int $value * * @return $this */ public function setValue($value) { $this->value = BuilderHelpers::normalizeValue($value); return $this; } /** * Sets doc comment for the constant. * * @param PhpParser\Comment\Doc|string $docComment Doc comment to set * * @return $this The builder instance (for fluid interface) */ public function setDocComment($docComment) { $this->attributes = [ 'comments' => [BuilderHelpers::normalizeDocComment($docComment)] ]; return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built enum case node. * * @return Stmt\EnumCase The built constant node */ public function getNode(): PhpParser\Node { return new Stmt\EnumCase( $this->name, $this->value, $this->attributeGroups, $this->attributes ); } } Declaration.php 0000644 00000002355 15127673200 0007512 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; abstract class Declaration implements PhpParser\Builder { /** @var array<string, mixed> */ protected array $attributes = []; /** * Adds a statement. * * @param PhpParser\Node\Stmt|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ abstract public function addStmt($stmt); /** * Adds multiple statements. * * @param (PhpParser\Node\Stmt|PhpParser\Builder)[] $stmts The statements to add * * @return $this The builder instance (for fluid interface) */ public function addStmts(array $stmts) { foreach ($stmts as $stmt) { $this->addStmt($stmt); } return $this; } /** * Sets doc comment for the declaration. * * @param PhpParser\Comment\Doc|string $docComment Doc comment to set * * @return $this The builder instance (for fluid interface) */ public function setDocComment($docComment) { $this->attributes['comments'] = [ BuilderHelpers::normalizeDocComment($docComment) ]; return $this; } } Interface_.php 0000644 00000005104 15127673200 0007317 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Name; use PhpParser\Node\Stmt; class Interface_ extends Declaration { protected string $name; /** @var list<Name> */ protected array $extends = []; /** @var list<Stmt\ClassConst> */ protected array $constants = []; /** @var list<Stmt\ClassMethod> */ protected array $methods = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates an interface builder. * * @param string $name Name of the interface */ public function __construct(string $name) { $this->name = $name; } /** * Extends one or more interfaces. * * @param Name|string ...$interfaces Names of interfaces to extend * * @return $this The builder instance (for fluid interface) */ public function extend(...$interfaces) { foreach ($interfaces as $interface) { $this->extends[] = BuilderHelpers::normalizeName($interface); } return $this; } /** * Adds a statement. * * @param Stmt|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $stmt = BuilderHelpers::normalizeNode($stmt); if ($stmt instanceof Stmt\ClassConst) { $this->constants[] = $stmt; } elseif ($stmt instanceof Stmt\ClassMethod) { // we erase all statements in the body of an interface method $stmt->stmts = null; $this->methods[] = $stmt; } else { throw new \LogicException(sprintf('Unexpected node of type "%s"', $stmt->getType())); } return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built interface node. * * @return Stmt\Interface_ The built interface node */ public function getNode(): PhpParser\Node { return new Stmt\Interface_($this->name, [ 'extends' => $this->extends, 'stmts' => array_merge($this->constants, $this->methods), 'attrGroups' => $this->attributeGroups, ], $this->attributes); } } Enum_.php 0000644 00000006272 15127673200 0006332 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Identifier; use PhpParser\Node\Name; use PhpParser\Node\Stmt; class Enum_ extends Declaration { protected string $name; protected ?Identifier $scalarType = null; /** @var list<Name> */ protected array $implements = []; /** @var list<Stmt\TraitUse> */ protected array $uses = []; /** @var list<Stmt\EnumCase> */ protected array $enumCases = []; /** @var list<Stmt\ClassConst> */ protected array $constants = []; /** @var list<Stmt\ClassMethod> */ protected array $methods = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates an enum builder. * * @param string $name Name of the enum */ public function __construct(string $name) { $this->name = $name; } /** * Sets the scalar type. * * @param string|Identifier $scalarType * * @return $this */ public function setScalarType($scalarType) { $this->scalarType = BuilderHelpers::normalizeType($scalarType); return $this; } /** * Implements one or more interfaces. * * @param Name|string ...$interfaces Names of interfaces to implement * * @return $this The builder instance (for fluid interface) */ public function implement(...$interfaces) { foreach ($interfaces as $interface) { $this->implements[] = BuilderHelpers::normalizeName($interface); } return $this; } /** * Adds a statement. * * @param Stmt|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $stmt = BuilderHelpers::normalizeNode($stmt); if ($stmt instanceof Stmt\EnumCase) { $this->enumCases[] = $stmt; } elseif ($stmt instanceof Stmt\ClassMethod) { $this->methods[] = $stmt; } elseif ($stmt instanceof Stmt\TraitUse) { $this->uses[] = $stmt; } elseif ($stmt instanceof Stmt\ClassConst) { $this->constants[] = $stmt; } else { throw new \LogicException(sprintf('Unexpected node of type "%s"', $stmt->getType())); } return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built class node. * * @return Stmt\Enum_ The built enum node */ public function getNode(): PhpParser\Node { return new Stmt\Enum_($this->name, [ 'scalarType' => $this->scalarType, 'implements' => $this->implements, 'stmts' => array_merge($this->uses, $this->enumCases, $this->constants, $this->methods), 'attrGroups' => $this->attributeGroups, ], $this->attributes); } } Method.php 0000644 00000007254 15127673200 0006510 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; use PhpParser\Node\Stmt; class Method extends FunctionLike { protected string $name; protected int $flags = 0; /** @var list<Stmt>|null */ protected ?array $stmts = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates a method builder. * * @param string $name Name of the method */ public function __construct(string $name) { $this->name = $name; } /** * Makes the method public. * * @return $this The builder instance (for fluid interface) */ public function makePublic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PUBLIC); return $this; } /** * Makes the method protected. * * @return $this The builder instance (for fluid interface) */ public function makeProtected() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED); return $this; } /** * Makes the method private. * * @return $this The builder instance (for fluid interface) */ public function makePrivate() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE); return $this; } /** * Makes the method static. * * @return $this The builder instance (for fluid interface) */ public function makeStatic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::STATIC); return $this; } /** * Makes the method abstract. * * @return $this The builder instance (for fluid interface) */ public function makeAbstract() { if (!empty($this->stmts)) { throw new \LogicException('Cannot make method with statements abstract'); } $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::ABSTRACT); $this->stmts = null; // abstract methods don't have statements return $this; } /** * Makes the method final. * * @return $this The builder instance (for fluid interface) */ public function makeFinal() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::FINAL); return $this; } /** * Adds a statement. * * @param Node|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { if (null === $this->stmts) { throw new \LogicException('Cannot add statements to an abstract method'); } $this->stmts[] = BuilderHelpers::normalizeStmt($stmt); return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built method node. * * @return Stmt\ClassMethod The built method node */ public function getNode(): Node { return new Stmt\ClassMethod($this->name, [ 'flags' => $this->flags, 'byRef' => $this->returnByRef, 'params' => $this->params, 'returnType' => $this->returnType, 'stmts' => $this->stmts, 'attrGroups' => $this->attributeGroups, ], $this->attributes); } } TraitUse.php 0000644 00000003166 15127673200 0007026 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser\Builder; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Stmt; class TraitUse implements Builder { /** @var Node\Name[] */ protected array $traits = []; /** @var Stmt\TraitUseAdaptation[] */ protected array $adaptations = []; /** * Creates a trait use builder. * * @param Node\Name|string ...$traits Names of used traits */ public function __construct(...$traits) { foreach ($traits as $trait) { $this->and($trait); } } /** * Adds used trait. * * @param Node\Name|string $trait Trait name * * @return $this The builder instance (for fluid interface) */ public function and($trait) { $this->traits[] = BuilderHelpers::normalizeName($trait); return $this; } /** * Adds trait adaptation. * * @param Stmt\TraitUseAdaptation|Builder\TraitUseAdaptation $adaptation Trait adaptation * * @return $this The builder instance (for fluid interface) */ public function with($adaptation) { $adaptation = BuilderHelpers::normalizeNode($adaptation); if (!$adaptation instanceof Stmt\TraitUseAdaptation) { throw new \LogicException('Adaptation must have type TraitUseAdaptation'); } $this->adaptations[] = $adaptation; return $this; } /** * Returns the built node. * * @return Node The built node */ public function getNode(): Node { return new Stmt\TraitUse($this->traits, $this->adaptations); } } Class_.php 0000644 00000010113 15127673200 0006460 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; use PhpParser\Node\Name; use PhpParser\Node\Stmt; class Class_ extends Declaration { protected string $name; protected ?Name $extends = null; /** @var list<Name> */ protected array $implements = []; protected int $flags = 0; /** @var list<Stmt\TraitUse> */ protected array $uses = []; /** @var list<Stmt\ClassConst> */ protected array $constants = []; /** @var list<Stmt\Property> */ protected array $properties = []; /** @var list<Stmt\ClassMethod> */ protected array $methods = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates a class builder. * * @param string $name Name of the class */ public function __construct(string $name) { $this->name = $name; } /** * Extends a class. * * @param Name|string $class Name of class to extend * * @return $this The builder instance (for fluid interface) */ public function extend($class) { $this->extends = BuilderHelpers::normalizeName($class); return $this; } /** * Implements one or more interfaces. * * @param Name|string ...$interfaces Names of interfaces to implement * * @return $this The builder instance (for fluid interface) */ public function implement(...$interfaces) { foreach ($interfaces as $interface) { $this->implements[] = BuilderHelpers::normalizeName($interface); } return $this; } /** * Makes the class abstract. * * @return $this The builder instance (for fluid interface) */ public function makeAbstract() { $this->flags = BuilderHelpers::addClassModifier($this->flags, Modifiers::ABSTRACT); return $this; } /** * Makes the class final. * * @return $this The builder instance (for fluid interface) */ public function makeFinal() { $this->flags = BuilderHelpers::addClassModifier($this->flags, Modifiers::FINAL); return $this; } /** * Makes the class readonly. * * @return $this The builder instance (for fluid interface) */ public function makeReadonly() { $this->flags = BuilderHelpers::addClassModifier($this->flags, Modifiers::READONLY); return $this; } /** * Adds a statement. * * @param Stmt|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $stmt = BuilderHelpers::normalizeNode($stmt); if ($stmt instanceof Stmt\Property) { $this->properties[] = $stmt; } elseif ($stmt instanceof Stmt\ClassMethod) { $this->methods[] = $stmt; } elseif ($stmt instanceof Stmt\TraitUse) { $this->uses[] = $stmt; } elseif ($stmt instanceof Stmt\ClassConst) { $this->constants[] = $stmt; } else { throw new \LogicException(sprintf('Unexpected node of type "%s"', $stmt->getType())); } return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built class node. * * @return Stmt\Class_ The built class node */ public function getNode(): PhpParser\Node { return new Stmt\Class_($this->name, [ 'flags' => $this->flags, 'extends' => $this->extends, 'implements' => $this->implements, 'stmts' => array_merge($this->uses, $this->constants, $this->properties, $this->methods), 'attrGroups' => $this->attributeGroups, ], $this->attributes); } } Trait_.php 0000644 00000004464 15127673200 0006512 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Stmt; class Trait_ extends Declaration { protected string $name; /** @var list<Stmt\TraitUse> */ protected array $uses = []; /** @var list<Stmt\ClassConst> */ protected array $constants = []; /** @var list<Stmt\Property> */ protected array $properties = []; /** @var list<Stmt\ClassMethod> */ protected array $methods = []; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates an interface builder. * * @param string $name Name of the interface */ public function __construct(string $name) { $this->name = $name; } /** * Adds a statement. * * @param Stmt|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $stmt = BuilderHelpers::normalizeNode($stmt); if ($stmt instanceof Stmt\Property) { $this->properties[] = $stmt; } elseif ($stmt instanceof Stmt\ClassMethod) { $this->methods[] = $stmt; } elseif ($stmt instanceof Stmt\TraitUse) { $this->uses[] = $stmt; } elseif ($stmt instanceof Stmt\ClassConst) { $this->constants[] = $stmt; } else { throw new \LogicException(sprintf('Unexpected node of type "%s"', $stmt->getType())); } return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built trait node. * * @return Stmt\Trait_ The built interface node */ public function getNode(): PhpParser\Node { return new Stmt\Trait_( $this->name, [ 'stmts' => array_merge($this->uses, $this->constants, $this->properties, $this->methods), 'attrGroups' => $this->attributeGroups, ], $this->attributes ); } } Param.php 0000644 00000010562 15127673200 0006324 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Modifiers; use PhpParser\Node; class Param implements PhpParser\Builder { protected string $name; protected ?Node\Expr $default = null; /** @var Node\Identifier|Node\Name|Node\ComplexType|null */ protected ?Node $type = null; protected bool $byRef = false; protected int $flags = 0; protected bool $variadic = false; /** @var list<Node\AttributeGroup> */ protected array $attributeGroups = []; /** * Creates a parameter builder. * * @param string $name Name of the parameter */ public function __construct(string $name) { $this->name = $name; } /** * Sets default value for the parameter. * * @param mixed $value Default value to use * * @return $this The builder instance (for fluid interface) */ public function setDefault($value) { $this->default = BuilderHelpers::normalizeValue($value); return $this; } /** * Sets type for the parameter. * * @param string|Node\Name|Node\Identifier|Node\ComplexType $type Parameter type * * @return $this The builder instance (for fluid interface) */ public function setType($type) { $this->type = BuilderHelpers::normalizeType($type); if ($this->type == 'void') { throw new \LogicException('Parameter type cannot be void'); } return $this; } /** * Make the parameter accept the value by reference. * * @return $this The builder instance (for fluid interface) */ public function makeByRef() { $this->byRef = true; return $this; } /** * Make the parameter variadic * * @return $this The builder instance (for fluid interface) */ public function makeVariadic() { $this->variadic = true; return $this; } /** * Makes the (promoted) parameter public. * * @return $this The builder instance (for fluid interface) */ public function makePublic() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PUBLIC); return $this; } /** * Makes the (promoted) parameter protected. * * @return $this The builder instance (for fluid interface) */ public function makeProtected() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED); return $this; } /** * Makes the (promoted) parameter private. * * @return $this The builder instance (for fluid interface) */ public function makePrivate() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE); return $this; } /** * Makes the (promoted) parameter readonly. * * @return $this The builder instance (for fluid interface) */ public function makeReadonly() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::READONLY); return $this; } /** * Gives the promoted property private(set) visibility. * * @return $this The builder instance (for fluid interface) */ public function makePrivateSet() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PRIVATE_SET); return $this; } /** * Gives the promoted property protected(set) visibility. * * @return $this The builder instance (for fluid interface) */ public function makeProtectedSet() { $this->flags = BuilderHelpers::addModifier($this->flags, Modifiers::PROTECTED_SET); return $this; } /** * Adds an attribute group. * * @param Node\Attribute|Node\AttributeGroup $attribute * * @return $this The builder instance (for fluid interface) */ public function addAttribute($attribute) { $this->attributeGroups[] = BuilderHelpers::normalizeAttribute($attribute); return $this; } /** * Returns the built parameter node. * * @return Node\Param The built parameter node */ public function getNode(): Node { return new Node\Param( new Node\Expr\Variable($this->name), $this->default, $this->type, $this->byRef, $this->variadic, [], $this->flags, $this->attributeGroups ); } } Namespace_.php 0000644 00000002061 15127673200 0007312 0 ustar 00 <?php declare(strict_types=1); namespace PhpParser\Builder; use PhpParser; use PhpParser\BuilderHelpers; use PhpParser\Node; use PhpParser\Node\Stmt; class Namespace_ extends Declaration { private ?Node\Name $name; /** @var Stmt[] */ private array $stmts = []; /** * Creates a namespace builder. * * @param Node\Name|string|null $name Name of the namespace */ public function __construct($name) { $this->name = null !== $name ? BuilderHelpers::normalizeName($name) : null; } /** * Adds a statement. * * @param Node|PhpParser\Builder $stmt The statement to add * * @return $this The builder instance (for fluid interface) */ public function addStmt($stmt) { $this->stmts[] = BuilderHelpers::normalizeStmt($stmt); return $this; } /** * Returns the built node. * * @return Stmt\Namespace_ The built node */ public function getNode(): Node { return new Stmt\Namespace_($this->name, $this->stmts, $this->attributes); } } NoOutput.pm 0000644 00000004717 15130725001 0006702 0 ustar 00 package Test::Builder::NoOutput; use strict; use warnings; use Symbol qw(gensym); use base qw(Test::Builder); =head1 NAME Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing =head1 SYNOPSIS use Test::Builder::NoOutput; my $tb = Test::Builder::NoOutput->new; ...test as normal... my $output = $tb->read; =head1 DESCRIPTION This is a subclass of Test::Builder which traps all its output. It is mostly useful for testing Test::Builder. =head3 read my $all_output = $tb->read; my $output = $tb->read($stream); Returns all the output (including failure and todo output) collected so far. It is destructive, each call to read clears the output buffer. If $stream is given it will return just the output from that stream. $stream's are... out output() err failure_output() todo todo_output() all all outputs Defaults to 'all'. =cut my $Test = __PACKAGE__->new; sub create { my $class = shift; my $self = $class->SUPER::create(@_); require Test::Builder::Formatter; $self->{Stack}->top->format(Test::Builder::Formatter->new); my %outputs = ( all => '', out => '', err => '', todo => '', ); $self->{_outputs} = \%outputs; my($out, $err, $todo) = map { gensym() } 1..3; tie *$out, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out}; tie *$err, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err}; tie *$todo, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo}; $self->output($out); $self->failure_output($err); $self->todo_output($todo); return $self; } sub read { my $self = shift; my $stream = @_ ? shift : 'all'; my $out = $self->{_outputs}{$stream}; $self->{_outputs}{$stream} = ''; # Clear all the streams if 'all' is read. if( $stream eq 'all' ) { my @keys = keys %{$self->{_outputs}}; $self->{_outputs}{$_} = '' for @keys; } return $out; }
| ver. 1.6 |
Github
|
.
| PHP 8.2.30 | ??????????? ?????????: 0 |
proxy
|
phpinfo
|
???????????