Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > How to overwrite or mock -e for testing?

Reply
Thread Tools

How to overwrite or mock -e for testing?

 
 
John W. Krahn
Guest
Posts: n/a
 
      10-27-2008
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
 
Reply With Quote
 
 
 
 
Helmut Wollmersdorfer
Guest
Posts: n/a
 
      10-27-2008
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
 
Reply With Quote
 
 
 
 
Ilya Zakharevich
Guest
Posts: n/a
 
      10-27-2008
[A complimentary Cc of this posting was sent to
John W. Krahn
<(E-Mail Removed)>], who wrote in article <H_oNk.8750$(E-Mail Removed)>:
> 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
 
Reply With Quote
 
helmut.wollmersdorfer.ext@siemens.com
Guest
Posts: n/a
 
      10-28-2008
On 27 Okt., 20:53, "John W. Krahn" <(E-Mail Removed)> 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



 
Reply With Quote
 
Michele Dondi
Guest
Posts: n/a
 
      10-30-2008
On Mon, 27 Oct 2008 21:21:47 +0100, Helmut Wollmersdorfer
<(E-Mail Removed)> 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,
 
Reply With Quote
 
Helmut Wollmersdorfer
Guest
Posts: n/a
 
      10-30-2008
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
 
Reply With Quote
 
Michele Dondi
Guest
Posts: n/a
 
      10-31-2008
On Thu, 30 Oct 2008 20:32:55 +0100, Helmut Wollmersdorfer
<(E-Mail Removed)> 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,
 
Reply With Quote
 
Michele Dondi
Guest
Posts: n/a
 
      10-31-2008
On Fri, 31 Oct 2008 10:40:14 +0100, Michele Dondi
<(E-Mail Removed)> 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,
 
Reply With Quote
 
Ilya Zakharevich
Guest
Posts: n/a
 
      10-31-2008
[A complimentary Cc of this posting was NOT [per weedlist] sent to
Michele Dondi
<(E-Mail Removed)>], who wrote in article <(E-Mail Removed)>:
> >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
 
Reply With Quote
 
Michele Dondi
Guest
Posts: n/a
 
      10-31-2008
On Fri, 31 Oct 2008 20:50:28 +0000 (UTC), Ilya Zakharevich
<(E-Mail Removed)> 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,
 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Re: How include a large array? Edward A. Falk C Programming 1 04-04-2013 08:07 PM
Want mock test Sanket MCSD 1 12-16-2004 10:01 PM
Need free Mock exam papers for MCSD Exam viswanath MCSD 3 03-03-2004 05:52 AM
mock test on internet - TNA's Louise Microsoft Certification 0 02-10-2004 12:34 PM
Mock exams Chris MCSD 0 09-23-2003 06:05 AM



Advertisments