Merge pull request #23 from KohaAloha/master

fix spelling typos

Author: atoomic

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

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) );

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 {

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 {

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 {

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.

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<perlartistic>.
+
+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;

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;