How to overwrite or mock -e for testing?

Discussion in 'Perl Misc' started by John W. Krahn, Oct 27, 2008.

  1. Helmut Wollmersdorfer wrote:
    >
    > to test a module like this
    >
    > package MyModule;
    >
    > sub get_foo {
    > my $file = '/etc/foo.conf';
    >
    > if (-e $file) {


    Why are you using -e? You have a race condition.

    > open my $fh,'<',$file;
    > my $content = <$fh>;
    > return $content;
    > }
    > }


    sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' and return scalar
    <$fh> }



    John
    --
    Perl isn't a toolbox, but a small machine shop where you
    can special-order certain sorts of tools at low cost and
    in short order. -- Larry Wall
     
    John W. Krahn, Oct 27, 2008
    #1
    1. Advertising

  2. Hi,

    to test a module like this

    package MyModule;

    sub get_foo {
    my $file = '/etc/foo.conf';

    if (-e $file) {
    open my $fh,'<',$file;
    my $content = <$fh>;
    return $content;
    }
    }

    I tried to mock '-e'

    === get_foo.t ===
    #!perl -T

    use strict;
    use warnings;

    my %file;

    use overload
    '-e' => sub {
    my ($name) = @_;
    print 'trying mocked -e',"\n";
    return exists $file{$name};
    };

    use Test::More qw(no_plan);

    $file{foo} = 1;
    ok(-e 'foo', 'file foo exists'); # does not work

    __END__


    The above does not overwrite the behaviour of -e.
    How can I do it?

    TIA

    Helmut Wollmersdorfer
     
    Helmut Wollmersdorfer, Oct 27, 2008
    #2
    1. Advertising

  3. [A complimentary Cc of this posting was sent to
    John W. Krahn
    <>], who wrote in article <H_oNk.8750$>:
    > sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' and return scalar <$fh> }


    This leaves no way for the caller to check for errors.

    sub get_foo { my $fh; open $fh, '<', '/etc/foo.conf' or return; scalar <$fh> }

    Note the differences,
    Ilya
     
    Ilya Zakharevich, Oct 27, 2008
    #3
  4. John W. Krahn

    Guest

    On 27 Okt., 20:53, "John W. Krahn" <> wrote:

    > Why are you using -e?  


    It is not my code. I only want to test the module without change of
    the source.

    My question is how to mock or overwrite '-e', or more general '-X', or
    overwrite the function behind the operator '-e'.

    Helmut Wollmersdorfer
     
    , Oct 28, 2008
    #4
  5. On Mon, 27 Oct 2008 21:21:47 +0100, Helmut Wollmersdorfer
    <> wrote:

    >I tried to mock '-e'
    >
    >=== get_foo.t ===
    >#!perl -T
    >
    >use strict;
    >use warnings;
    >
    >my %file;
    >
    >use overload
    > '-e' => sub {
    > my ($name) = @_;
    > print 'trying mocked -e',"\n";
    > return exists $file{$name};
    > };


    Appears to work:

    C:\temp>cat foo.pl
    #!/usr/bin/perl

    use strict;
    use warnings;

    my %file;

    BEGIN {
    no strict 'refs';
    *{'CORE::GLOBAL::-e'} = sub {
    my ($name) = @_;
    warn "trying mocked -e\n";
    return exists $file{$name};
    };
    }

    use Test::More qw(no_plan);

    $file{foo} = 1;
    ok(-e $_, "file $_ exists") for qw/foo bar/;

    __END__

    C:\temp>perl foo.pl
    ok 1 - file foo exists
    not ok 2 - file bar exists
    # Failed test 'file bar exists'
    # at foo.pl line 20.
    1..2
    # Looks like you failed 1 test of 2.


    HTH,
    Michele
    --
    {$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
    (($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
    ..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
    256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
     
    Michele Dondi, Oct 30, 2008
    #5
  6. Michele Dondi wrote:

    > Appears to work:
    >
    > C:\temp>cat foo.pl
    > #!/usr/bin/perl
    >
    > use strict;
    > use warnings;
    >
    > my %file;
    >
    > BEGIN {
    > no strict 'refs';
    > *{'CORE::GLOBAL::-e'} = sub {
    > my ($name) = @_;
    > warn "trying mocked -e\n";
    > return exists $file{$name};
    > };
    > }
    >
    > use Test::More qw(no_plan);
    >
    > $file{foo} = 1;
    > ok(-e $_, "file $_ exists") for qw/foo bar/;
    >
    > __END__
    >
    > C:\temp>perl foo.pl
    > ok 1 - file foo exists
    > not ok 2 - file bar exists
    > # Failed test 'file bar exists'
    > # at foo.pl line 20.
    > 1..2
    > # Looks like you failed 1 test of 2.


    Hmmm ... where is the output of 'warn "trying mocked -e\n";'?

    Maybe you have 'foo' in your filesystem?

    That's what I get (tested under Perl 5.8.8 and 5.10.0):

    helmut@duo2400:~$ ls foo*
    ls: cannot access foo*: No such file or directory

    helmut@duo2400:~$ perl mock_e.t
    not ok 1 - file foo exists
    # Failed test 'file foo exists'
    # at mock_e.t line 20.
    not ok 2 - file bar exists
    # Failed test 'file bar exists'
    # at mock_e.t line 20.
    1..2
    # Looks like you failed 2 tests of 2.

    Helmut Wollmersdorfer
     
    Helmut Wollmersdorfer, Oct 30, 2008
    #6
  7. On Thu, 30 Oct 2008 20:32:55 +0100, Helmut Wollmersdorfer
    <> wrote:

    >> BEGIN {
    >> no strict 'refs';
    >> *{'CORE::GLOBAL::-e'} = sub {
    >> my ($name) = @_;
    >> warn "trying mocked -e\n";
    >> return exists $file{$name};
    >> };
    >> }

    [snip]
    >> C:\temp>perl foo.pl
    >> ok 1 - file foo exists
    >> not ok 2 - file bar exists
    >> # Failed test 'file bar exists'
    >> # at foo.pl line 20.
    >> 1..2
    >> # Looks like you failed 1 test of 2.

    >
    >Hmmm ... where is the output of 'warn "trying mocked -e\n";'?
    >
    >Maybe you have 'foo' in your filesystem?


    Yep, I believe you're right. That's what you get out of posting when
    your eyes just can hardly stay open! [End of *standard* disclaimer...]

    Actually, now that I think of it, I don't know if -X functions are
    overridable, and you made me discover something interesting: people
    generally check the prototype() of CORE:: functions because IF they
    are not ovverridable THEN it returns undef() - but then please note
    that the inverse implication does not hold[*]. Now, I tried to see
    what happens with -e() and it turns out that it gives a run-time error
    I had *never* seen:

    whisky:~ [09:58:08]$ perl -E 'say prototype "CORE::$_" // "undef"
    > for qw/rand require -e/'

    ;$
    undef
    Can't find an opnumber for "-e" at -e line 2.

    Anyway, as they say, the proof of the pudding is in the eating: the
    above in fact would imply that -X functions are *not* overridable.

    As far as your problem is concerned, I thought that perhaps -X's would
    use stat() behind the courtain and that you may override the latter,
    (at the expense of some flexibility,) which is doable. But that's not
    the case:

    whisky:~/test [10:38:06]$ ls
    foo.pl
    whisky:~/test [10:38:09]$ cat foo.pl
    #!/usr/bin/perl

    use strict;
    use warnings;

    my %file;

    BEGIN {
    no strict 'refs';
    *{'CORE::GLOBAL::stat'} = sub {
    warn "trying mocked stat()\n";
    (my $f)=@_;
    CORE::stat( @_ && !ref($f) &&
    exists $file{$f} ? $0 : @_ );
    };
    }

    use Test::More qw(no_plan);

    $file{foo} = 1;
    ok( (scalar stat $_) => "file $_ exists") for qw/foo bar/;
    ok( (-e $_) => "file $_ exists") for qw/foo bar/;

    __END__
    whisky:~/test [10:38:13]$ ./foo.pl
    trying mocked stat()
    ok 1 - file foo exists
    trying mocked stat()
    not ok 2 - file bar exists
    # Failed test 'file bar exists'
    # at ./foo.pl line 21.
    not ok 3 - file foo exists
    # Failed test 'file foo exists'
    # at ./foo.pl line 22.
    not ok 4 - file bar exists
    # Failed test 'file bar exists'
    # at ./foo.pl line 22.
    1..4
    # Looks like you failed 3 tests of 4.


    [*] E.g. require() returns undef() but I have *seen* it duly
    overridden.


    Michele
    --
    {$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
    (($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
    ..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
    256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
     
    Michele Dondi, Oct 31, 2008
    #7
  8. On Fri, 31 Oct 2008 10:40:14 +0100, Michele Dondi
    <> wrote:

    >that the inverse implication does not hold[*]. Now, I tried to see
    >what happens with -e() and it turns out that it gives a run-time error
    >I had *never* seen:
    >
    > whisky:~ [09:58:08]$ perl -E 'say prototype "CORE::$_" // "undef"
    > > for qw/rand require -e/'

    > ;$
    > undef
    > Can't find an opnumber for "-e" at -e line 2.
    >
    >Anyway, as they say, the proof of the pudding is in the eating: the
    >above in fact would imply that -X functions are *not* overridable.


    BTW: I brought this up in PerlMonks. Incidentally, there someone
    pointed me to <http://perlmonks.org/?node_id=584078> and in particular
    to the *second footnote* which may be interesting for the OP: it seems
    that definitely filetest operators are not overridable in any way, and
    that a patch was submitted to p5p to enable that instead. But it was
    refused. Still, the node is not very recent... In the meanwhile,
    somebody made me notice (see <http://perlmonks.org/?node_id=720682>,)
    that qw// is now overridable.


    Michele
    --
    {$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
    (($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
    ..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
    256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
     
    Michele Dondi, Oct 31, 2008
    #8
  9. [A complimentary Cc of this posting was NOT [per weedlist] sent to
    Michele Dondi
    <>], who wrote in article <>:
    > >that the inverse implication does not hold[*].


    .... And where is [*]?

    When I (first) implemented prototype on CORE::***, I used an existing
    table in the lexer, and just translated the semantic of this table to
    the semantic of prototype(). I did only a very quick scan through the
    table to check the validity. The lexer has too many special cases
    which massaged the argument before access to the table, and I could
    miss some...

    > >Anyway, as they say, the proof of the pudding is in the eating: the
    > >above in fact would imply that -X functions are *not* overridable.


    This is what I would like to change if I ever work on Perl again: it
    must have a concept of IFS in the core...

    > somebody made me notice (see <http://perlmonks.org/?node_id=720682>,)
    > that qw// is now overridable.


    You managed to give me several very deep breaths... You meant qx()
    here, right?

    Yours,
    Ilya
     
    Ilya Zakharevich, Oct 31, 2008
    #9
  10. On Fri, 31 Oct 2008 20:50:28 +0000 (UTC), Ilya Zakharevich
    <> wrote:

    >> >that the inverse implication does not hold[*].

    >
    >... And where is [*]?


    It was in the twice quoted message. Pasted hereafter:

    : [*] E.g. require() returns undef() but I have *seen* it duly
    : overridden.

    >> >Anyway, as they say, the proof of the pudding is in the eating: the
    >> >above in fact would imply that -X functions are *not* overridable.

    >
    >This is what I would like to change if I ever work on Perl again: it
    >must have a concept of IFS in the core...


    And... What is IFS supposed to mean?

    >> somebody made me notice (see <http://perlmonks.org/?node_id=720682>,)
    >> that qw// is now overridable.

    >
    >You managed to give me several very deep breaths... You meant qx()
    >here, right?


    Oops! Well, of course. Apologies for the "several very deep breaths,"
    or... was it a *positive* experience, perhaps? ;)


    Michele
    --
    {$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
    (($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
    ..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
    256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
     
    Michele Dondi, Oct 31, 2008
    #10
  11. Michele Dondi wrote:
    > On Fri, 31 Oct 2008 20:50:28 +0000 (UTC), Ilya Zakharevich
    > <> wrote:
    >
    >>>> that the inverse implication does not hold[*].

    >> ... And where is [*]?

    >
    > It was in the twice quoted message. Pasted hereafter:
    >
    > : [*] E.g. require() returns undef() but I have *seen* it duly
    > : overridden.
    >
    >>>> Anyway, as they say, the proof of the pudding is in the eating: the
    >>>> above in fact would imply that -X functions are *not* overridable.

    >> This is what I would like to change if I ever work on Perl again: it
    >> must have a concept of IFS in the core...

    >
    > And... What is IFS supposed to mean?


    Input Field Separator



    John
    --
    Perl isn't a toolbox, but a small machine shop where you
    can special-order certain sorts of tools at low cost and
    in short order. -- Larry Wall
     
    John W. Krahn, Nov 1, 2008
    #11
  12. [A complimentary Cc of this posting was NOT [per weedlist] sent to
    Michele Dondi
    <>], who wrote in article <>:
    > >> >Anyway, as they say, the proof of the pudding is in the eating: the
    > >> >above in fact would imply that -X functions are *not* overridable.

    > >
    > >This is what I would like to change if I ever work on Perl again: it
    > >must have a concept of IFS in the core...


    > And... What is IFS supposed to mean?


    Something like

    my $fs = Installible::FileSystem::FTP->new('ftp://ftp/perl.org/CPAN');
    chdir $fs;
    # After this all filesystem operators are redirected as method calls
    # on $fs

    So you can use File::Find to traverse FTP directories, etc.

    Hope this helps,
    Ilya
     
    Ilya Zakharevich, Nov 1, 2008
    #12
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. =?Utf-8?B?RGF2aWQgVGhpZWxlbg==?=

    Mock objects for nunit tests?

    =?Utf-8?B?RGF2aWQgVGhpZWxlbg==?=, Mar 17, 2006, in forum: ASP .Net
    Replies:
    4
    Views:
    4,982
  2. Peter Hansen
    Replies:
    9
    Views:
    876
  3. Joe Van Dyk

    Mock objects and testing

    Joe Van Dyk, Apr 8, 2006, in forum: C++
    Replies:
    3
    Views:
    397
    Daniel T.
    Apr 8, 2006
  4. Fuzzyman
    Replies:
    0
    Views:
    267
    Fuzzyman
    Aug 22, 2009
  5. jmv

    Unit-testing and mock objects

    jmv, Oct 6, 2006, in forum: Perl Misc
    Replies:
    5
    Views:
    158
Loading...

Share This Page