diff --git a/Changes b/Changes index 0acc958..f8e7929 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,9 @@ Revision history for Overload-FileCheck {{$NEXT}} +- Fix a PL_statcache bug when checking: -l $f || -e _ +- Add some extra test coverage for 'mock_all_from_stat' + 0.012 2022-01-20 19:00:46-07:00 America/Denver - Fix regression from previous release when checking PL_statcache diff --git a/FileCheck.xs b/FileCheck.xs index 2ef18b2..c8c20a6 100644 --- a/FileCheck.xs +++ b/FileCheck.xs @@ -196,7 +196,7 @@ int _overload_ft_stat(Stat_t *stat, int *size) { if (count == 2) sv = POPs; /* RvAV */ check_status = POPi; /* TOOO pop on SV* for true / false & co */ - *size = 0; /* by default it fails */ + *size = -1; /* by default it fails */ if ( check_status == 1 ) { AV *stat_array; @@ -218,8 +218,8 @@ int _overload_ft_stat(Stat_t *stat, int *size) { if ( av_size > 0 && av_size != ( STAT_T_MAX - 1 ) ) croak( "Overload::FileCheck::_check: Array should contain 13 elements" ); + *size = av_size; /* store the av_size */ if ( av_size > 0 ) { - *size = av_size; /* store the av_size */ ary = AvARRAY(stat_array); @@ -371,23 +371,23 @@ PP(pp_overload_stat) { /* stat & lstat */ /* copy the content of mocked_stat to PL_statcache */ memcpy(&PL_statcache, &mocked_stat, sizeof(PL_statcache)); + if ( size >= 0) { /* yes it succeeds */ + PL_laststatval = 0; + } else { /* the stat call fails */ + PL_laststatval = -1; + } + + PL_laststype = PL_op->op_type; /* this was for our OP */ + /* Here, we cut early when stat() returned no values * In such a case, we set the statcache, but do not call * the real op (CALL_REAL_OP) */ - if ( !size ) + if ( size < 0 ) RETURN; PUSHs( MUTABLE_SV( PL_defgv ) ); /* add *_ to the stack */ - if ( size ) { /* yes it succeeds */ - PL_laststatval = 0; - } else { /* the stat call fails */ - PL_laststatval = -1; - } - - PL_laststype = PL_op->op_type; /* this was for our OP */ - /* probably not real necesseary, make warning messages nicer */ if ( previous_stack && SvPOK(previous_stack) ) sv_setpv(PL_statname, SvPV_nolen(previous_stack) ); diff --git a/README.md b/README.md index 5c12253..4887f2f 100644 --- a/README.md +++ b/README.md @@ -242,7 +242,7 @@ unmock_all_file_checks(); __END__ -# The ouput looks similar to +# The output looks similar to -d '/root' called from at t/perldoc_mock-all-file-check-trace.t line 26. -l '/root' called from at t/perldoc_mock-all-file-check-trace.t line 27. @@ -412,7 +412,7 @@ sub my_stat { return $fake_stat if $f eq 'fake.stat'; - # can also retun stats as a hash ref + # can also return stats as a hash ref return { st_dev => 1, st_atime => 987654321 } if $f eq 'hash.stat'; return { diff --git a/examples/mock-stat.pl b/examples/mock-stat.pl index e3223d8..1ecf4fa 100644 --- a/examples/mock-stat.pl +++ b/examples/mock-stat.pl @@ -45,7 +45,7 @@ sub my_stat { return $fake_stat if $f eq 'fake.stat'; - # can also retun stats as a hash ref + # can also return stats as a hash ref return { st_dev => 1, st_atime => 987654321 } if $f eq 'hash.stat'; return { diff --git a/examples/perldoc_mock-stat.t b/examples/perldoc_mock-stat.t index d87497c..47ce68e 100644 --- a/examples/perldoc_mock-stat.t +++ b/examples/perldoc_mock-stat.t @@ -52,7 +52,7 @@ sub my_stat { return $fake_stat if $f eq 'fake.stat'; - # can also retun stats as a hash ref + # can also return stats as a hash ref return { st_dev => 1, st_atime => 987654321 } if $f eq 'hash.stat'; return { diff --git a/examples/trace-code.pl b/examples/trace-code.pl index 5382d6a..1b06f17 100644 --- a/examples/trace-code.pl +++ b/examples/trace-code.pl @@ -27,7 +27,7 @@ sub my_custom_check { __END__ -# The ouput looks similar to +# The output looks similar to -d '/root' called from at t/perldoc_mock-all-file-check-trace.t line 26. -l '/root' called from at t/perldoc_mock-all-file-check-trace.t line 27. diff --git a/t/mock-all-from-stat.t b/t/mock-all-from-stat.t new file mode 100644 index 0000000..6998e68 --- /dev/null +++ b/t/mock-all-from-stat.t @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +# Copyright (c) 2018, cPanel, LLC. +# All rights reserved. +# http://cpanel.net +# +# This is free software; you can redistribute it and/or modify it under the +# same terms as Perl itself. See L. + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; +use Test2::Plugin::NoWarnings; + +use Overload::FileCheck qw(CHECK_IS_FALSE CHECK_IS_TRUE FALLBACK_TO_REAL_OP); + +use File::Temp qw{ tempfile tempdir }; + +my %STATS; + +# non existing but mocked +my $FILENAME; +my $FAKE_DIR; + +{ + my ( $fh, $filename ) = tempfile(); + $STATS{'file'} = [ stat($filename) ]; + unlink $filename; + + $FILENAME = "$filename"; + + my $dir = tempdir( CLEANUP => 1 ); + + $STATS{'dir'} = [ stat("$dir") ]; + + $STATS{'perl'} = [ stat($^X) ]; + + $FAKE_DIR = "$dir/not/there"; +} + +my $current_test = "$0"; + +our $call_my_stat; + +ok !-e $FILENAME, "filename does not exist"; +ok !-d $FAKE_DIR, "directory does not exis"; + +ok !$call_my_stat, 'start - without mock'; + +# note: we are just mocking stat here... +ok Overload::FileCheck::mock_all_from_stat( \&my_stat ), "mock_all_from_stat succees"; + +is [ stat( $FILENAME ) ], $STATS{'file'}, "stats for file"; +ok $call_my_stat, "stat is now mocked"; +ok -e $FILENAME, "-e filename"; +ok -f $FILENAME, "-f filename"; + +ok -e $FILENAME && -f _, "-e filename && -f _"; + +is -l $FILENAME || -e $FILENAME, 1, q[-l $f || -e $f]; +is -l $FILENAME || -e _, 1, q[-l $f || -e _]; + +is [ stat('/empty') ], [], "stat /empty"; + +is -l q[/empty] || -e q[/empty], undef, q[-l /empty || -e /empty]; +is -l q[/empty] || -e _, undef, q[-l /empty || -e _]; + +# --- END --- +ok Overload::FileCheck::unmock_all_file_checks(), "unmock all"; +done_testing; + +exit; + +sub my_stat { + my ( $opname, $file_or_handle ) = @_; + + note "=== my_stat is called. Type: ", $opname, " File: ", $file_or_handle; + ++$call_my_stat; + + my $f = $file_or_handle; # alias to use a shorter name later... + + return $STATS{'file'} if $f eq $FILENAME; + return $STATS{'dir'} if $f eq $FAKE_DIR; + + return [] if $f eq '/empty'; + + return FALLBACK_TO_REAL_OP(); +} + +sub stat_for_a_directory { + return $STATS{'dir'}; +} + +sub stat_for_a_binary { + return $STATS{'perl'}; +} + +sub stat_for_a_tty { + return $STATS{'tty'}; +} + +1; \ No newline at end of file diff --git a/t/mock-stat.t b/t/mock-stat.t index 798a658..7919765 100644 --- a/t/mock-stat.t +++ b/t/mock-stat.t @@ -16,19 +16,43 @@ use Test2::Plugin::NoWarnings; use Overload::FileCheck qw(CHECK_IS_FALSE CHECK_IS_TRUE FALLBACK_TO_REAL_OP); +use File::Temp qw{ tempfile tempdir }; + +my %STATS; + +our @FAKE_DIR; + +{ + my ( $fh, $filename ) = tempfile(); + $STATS{'file'} = [ stat($filename) ]; + + my $dir = tempdir( CLEANUP => 1 ); + + $STATS{'dir'} = [ stat("$dir") ]; + + $STATS{'$0'} = [ stat($0) ]; + + $STATS{'perl'} = [ stat($^X) ]; + + $STATS{'tty'} = [ stat('/dev/tty') ]; + + @FAKE_DIR = ( "$dir/not/there" ); + push @FAKE_DIR, "/not/there" if -e q[/not/there]; +} + my $current_test = "$0"; my $call_my_stat = 0; my $last_called_for; -our @FAKE_DIR = qw{/a/b/c /usr/somewhere /home/fake}; ok 1, 'start'; my $stat_result = [ stat($0) ]; is scalar @$stat_result, 13, "call stat unmocked"; -my $unmocked_stat_for_perl = [ stat($^X) ]; +my $unmocked_stat_for_perl = $STATS{'perl'}; +# note: we are just mocking stat here... ok Overload::FileCheck::mock_stat( \&my_stat ), "mock_stat succees"; is $call_my_stat, 0, "my_stat was not called at this point"; @@ -86,8 +110,7 @@ foreach my $f (qw{alpha1 alpha2 alpha3}) { foreach my $d (@FAKE_DIR) { is [ stat($d) ], stat_for_a_directory(), "stat_for_a_directory - $d"; - - ok !-e $d, "directory $d does not exist"; + ok !-d $d, "!-d $d - we are just mocking the stats"; } is [ stat('fake.binary') ], stat_for_a_binary(), "stat_for_a_binary - 'fake.binary'"; @@ -114,6 +137,8 @@ like( is [ stat($^X) ], $unmocked_stat_for_perl, q[stat is mocked but $^X should fallback to the regular stat]; is [ stat(_) ], $unmocked_stat_for_perl, q[stat is mocked - using _ on an unmocked file]; +is [ stat('/empty') ], [], "stat /empty"; + # --- END --- ok Overload::FileCheck::unmock_all_file_checks(), "unmock all"; done_testing; @@ -148,77 +173,25 @@ sub my_stat { return 666 if $f eq 'evil'; + return [] if $f eq '/empty'; + return FALLBACK_TO_REAL_OP(); } sub fake_stat_for_dollar_0 { - return [ - 0, - 0, - 4, - 3, - 2, - 1, - 42, - 10001, - 1000, - 2000, - 3000, - 0, - 0 - ]; + $STATS{'$0'}; } sub stat_for_a_directory { - return [ - 64769, - 67149975, - 16877, - 23, - 0, - 0, - 0, - 4096, - 1539271725, - 1524671853, - 1524671853, - 4096, - 8, - ]; + return $STATS{'dir'}; } sub stat_for_a_binary { - return [ - 64769, - 33728572, - 33261, - 1, - 0, - 0, - 0, - 28920, - 1539797896, - 1523421302, - 1526572488, - 4096, - 64, - ]; + return $STATS{'perl'}; } sub stat_for_a_tty { - return [ - 5, - 1043, - 8592, - 1, - 0, - 5, - 1025, - 0, - 1538428544, - 1538428544, - 1538428550, - 4096, - 0, - ]; + return $STATS{'tty'}; } + +1; \ No newline at end of file