Test::Base::Filter arguments - perl

In the POD for Test::Base, there is an example on rolling my own filters, which the documentation says is "self explanatory". I am having trouble understanding it and I think it may be a problem in my filter writing. The code is reproduced below:
use Test::Base;
filters 'foo', 'bar=xyz';
sub foo {
transform(shift);
}
sub Test::Base::Filter::bar {
my $self = shift; # The Test::Base::Filter object
my $data = shift;
my $args = $self->current_arguments;
my $current_block_object = $self->block;
# transform $data in a barish manner
return $data;
}
The filters function sets the named subroutines as filters on the incoming data. The declared filters are 'foo' and 'bar', which has arguments.
My question is why the structure of foo and bar are so different. Why is foo in the current namespace while bar is declared in the Test::Base::Filter namespace? And why does foo alter its first argument, while bar must grab the data from the second argument?
Another example. In MyTest.pm:
package t::MyTest;
use Test::Base -Base;
#some stuff here
package t::MyTest::Filter;
use base 'Test::Base::Filter';
sub choose {
print #_;
return {foo => 'bar'} if($_[0] eq '1');
return undef;
}
sub is_defined{
print #_;
defined $_[0];
}
And in test.t:
use t::MyTest;
filters {input => [qw(choose is_defined)] };
__END__
=== First
--- input
1
--- expected: 1
=== Second
--- input
0
--- expected: 0
If you place both of those in a "t" folder and run prove -v, this is the output:
t\01-test.t .. Use of uninitialized value $_[1] in print at t/MyTest.pm line 14,
<DATA> line 1.
1
t::MyTest::Filter=HASH(0x2af1670)ok 1 - First
1..1
Failed 1/1 subtests
Test Summary Report
-------------------
t\01-test.t (Wstat: 0 Tests: 0 Failed: 0)
Parse errors: Bad plan. You planned 1 tests but ran 0.
Files=1, Tests=0, 1 wallclock secs ( 0.06 usr + 0.23 sys = 0.30 CPU)
Result: FAIL
Nevermind the warning (which I don't completely understand the root of). Why is the first filter passed the input (like it's supposed to be), but the second one is passed some Filter object? Shouldn't the input of the second filter be the output of the first? If it isn't, then I have to worry about filter ordering all over the place.

I figured this out. I'm pretty sure it's a bug in the way filters work.
The POD says:
Each filter can take either a scalar or a list as input, and will return either a scalar or a list. Since filters are chained together, it is important to learn which filters expect which kind of input and return which kind of output.
Perldoc tells me that undef is a valid scalar in Perl, but Test::Base::Filter ignores it. Normally the input to a Filter would be first the data, and then some other stuff. However, if a filter returns undef, then its return value is ignored and the next filter gets one less argument, instead of getting undef as its first argument. I'll file this in RT.

Related

Raku operator overloading

Using the following code:
use v6d;
# sub circumfix:<α ω>( #a ) {
# #a[0] >= #a[1] & #a[0] <= #a[2];
# };
sub circumfix:<α ω>( $a, $b, $c ) {
$a >= $b & $a <= $c;
};
if (α <5 0 10> ω) {
say 'Truthy';
}
else {
say 'Falsey';
}
Results in:
(base) hsmyers#BigIron:~/board$ perl6 ./op.p6
Too few positionals passed; expected 3 arguments but got 1
in sub circumfix:<α ω> at ./op.p6 line 7
in block <unit> at ./op.p6 line 11
Whereas switching the commented block for the other definition results in:
(base) hsmyers#BigIron:~/board$ perl6 ./op.p6
Truthy
The broken version (with three parameters) is the one I want, could someone explain why it is broken?
<5 0 10> literally constructs a List, a single List.
An analogy would be a list of things to do, a todo list. How many things is a todo list? It's 1 -- one todo list.
Thus you get the error message:
expected 3 arguments but got 1
What you want is to specify that you want one value that is itself made up of several values. Here's one way to do that:
sub circumfix:<α ω>( ( $a, $b, $c ) ) ...
The additional surrounding ( and ) cause destructuring.
D:\>6e "say <5 0 10>"
(5 0 10)
These aren't three arguments. It's a list of three values (of type IntStr) and therefore a single argument.

Not able to extract a number from a text file

I have a text file which has the information of the number of tests that were run, passed and failed.
Also it contains information on which of the tests failed.
I want to extract the total number of the tests that were run and failed.
Below is the sample of the log file:
file_1 has difference
file_2 has difference
file_3 has difference
file_4 has difference
file_5 has difference
file_6 has difference
file_7 has difference
file_8 has difference
events has difference
QShrink has difference
Total tests run = 10
Total tests passed = 0
Total tests failed = 10
I tried to capture it like this, but didn't work:
if ( $_=~/^# run =/ || $_=~/^# failed =/ ) {
print $_;
my $entry = <FILE>;
print $entry;
}
My objective is that I should be able to fetch only the corresponding numbers and not the entire string.
You should put the entire line into the pattern and discern based on he last word before the =. That makes it flexible, because you don't need to care if all of the lines are present.
use strict;
use warnings 'all';
use Data::Dumper;
my %stats;
while (<DATA>) {
if ( m/^Total tests ([a-z]+) = (\d+)/ ) {
$stats{$1} = $2;
}
}
print Dumper \%stats;
__DATA__
file_1 has difference
file_2 has difference
file_3 has difference
file_4 has difference
file_5 has difference
file_6 has difference
file_7 has difference
file_8 has difference
events has difference
QShrink has difference
Total tests run = 10
Total tests passed = 0
Total tests failed = 10
This solution uses a hash to store the matches.
$VAR1 = {
'failed' => '10',
'run' => '10',
'passed' => '0'
};
Let's take a look at what you did.
if($_=~/^# run =/ || $_=~/^# failed =/)
{
print $_;
my$entry=<FILE>;
print $entry;
}
This code assumes there is something in $_. Maybe you already opened the file and are reading it.
while (<DATA>) {
if ($_ =~ /.../) {
So you are saying that if the current line matches the beginning of the string, a #, a space, the word run, a space and an = (or the same with failed, it should print the full line, then assign the next line to a lexical variable that only exists within that block, and print it.
This pattern does not match your input, so the block will never be executed. If it would be, you'd pull away another line of the input for every line that matches.
All of that is not what you want and does not get you anywhere near the numbers.
if($_=~/Total tests run = ([0-9]+)/)
{
print "Total tests run :$1\n";
}
In the above code the numbers that you want are captured in perls default variable $1 as they are placed in braces. Similarly you can do for failed number of tests.

Where does a Perl subroutine get values missing from the actual parameters?

I came across the following Perl subroutine get_billable_pages while chasing a bug. It takes 12 arguments.
sub get_billable_pages {
my ($dbc,
$bill_pages, $page_count, $cover_page_count,
$domain_det_page, $bill_cover_page, $virtual_page_billing,
$job, $bsj, $xqn,
$direction, $attempt,
) = #_;
my $billable_pages = 0;
if ($virtual_page_billing) {
my #row;
### Below is testing on the existence of the 11th and 12th parameters ###
if ( length($direction) && length($attempt) ) {
$dbc->xdb_execute("
SELECT convert(int, value)
FROM job_attribute_detail_atmp_tbl
WHERE job = $job
AND billing_sub_job = $bsj
AND xqn = $xqn
AND direction = '$direction'
AND attempt = $attempt
AND attribute = 1
");
}
else {
$dbc->xdb_execute("
SELECT convert(int, value)
FROM job_attribute_detail_tbl
WHERE job = $job
AND billing_sub_job = $bsj
AND xqn = $xqn
AND attribute = 1
");
}
$cnt = 0;
...;
But is sometimes called with only 10 arguments
$tmp_det = get_billable_pages(
$dbc2,
$row[6], $row[8], $row[7],
$domain_det_page, $bill_cover_page, $virtual_page_billing,
$job1, $bsj1, $row[3],
);
The function does a check on the 11th and 12th arguments.
What are the 11th and 12th arguments when the function is passed only 10 arguments?
Is it a bug to call the function with only 10 arguments because the 11th and 12th arguments end up being random values?
I am thinking this may be the source of the bug because the 12th argument had a funky value when the program failed.
I did not see another definition of the function which takes only 10 arguments.
The values are copied out of the parameter array #_ to the list of scalar variables.
If the array is shorter than the list, then the excess variables are set to undef. If the array is longer than the list, then excess array elements are ignored.
Note that the original array #_ is unmodified by the assignment. No values are created or lost, so it remains the definitive source of the actual parameters passed when the subroutine is called.
ikegami suggested that I should provide some Perl code to demonstrate the assignment of arrays to lists of scalars. Here is that Perl code, based mostly on his edit
use strict;
use warnings;
use Data::Dumper;
my $x = 44; # Make sure that we
my $y = 55; # know if they change
my #params = (8); # Make a dummy parameter array with only one value
($x, $y) = #params; # Copy as if this is were a subroutine
print Dumper $x, $y; # Let's see our parameters
print Dumper \#params; # And how the parameter array looks
output
$VAR1 = 8;
$VAR2 = undef;
$VAR1 = [ 8 ];
So both $x and $y are modified, but if there are insufficient values in the array then undef is used instead. It is as if the source array was extended indefinitely with undef elements.
Now let's look at the logic of the Perl code. undef evaluates as false for the purposes of conditional tests, but you apply the length operator like this
if ( length($direction) && length($attempt) ) { ... }
If you have use warnings in place as you should, Perl would normally produce a Use of uninitialized value warning. However length is unusual in that, if you ask for the length of an undef value (and you are running version 12 or later of Perl 5) it will just return undef instead of warning you.
Regarding "I did not see another definition of the function which takes only 10 arguments", Perl doesn't have function templates like C++ and Java - it is up to the code in the subroutine to look at what it has been passed and behave accordingly.
No, it's not a bug. The remaining arguments are "undef" and you can check for this situation
sub foo {
my ($x, $y) = #_;
print " x is undef\n" unless defined $x;
print " y is undef\n" unless defined $y;
}
foo(1);
prints
y is undef

How to create an anonymous array ([]) with 'empty slots'?

I can create an array with 'empty slots' in it:
$ perl -wde 1
...
DB<1> $x[2] = 0
DB<2> x \#x
0 ARRAY(0x103d5768)
0 empty slot
1 empty slot
2 0
or
DB<3> $#y = 4
DB<4> x \#y
0 ARRAY(0x103d5718)
0 empty slot
1 empty slot
2 empty slot
3 empty slot
4 empty slot
Please note: this is not the same as assigning undef.
But how do I specify that for an anonymous array using [ and ]?
This will not work:
DB<5> x [,,0]
syntax error at (eval 27)[/usr/local/lib/perl5/5.10.0/perl5db.pl:638] line 2, near "[,"
And this fails too, since I only get the assigned value:
DB<6> x []->[2] = 0
0 0
Bonus question: how can I check for an 'empty array slot' in my Perl script?
Background: In my test scripts I would like to be able to compare array contents precisely. For example I want to distinguish between 'not assigned' and 'assigned with an undef value'.
Thanks for any insights.
use feature qw/ say /;
use strict;
use warnings;
my $aref;
$#{$aref} = 4;
$aref->[2] = undef;
$aref->[3] = '';
foreach my $idx ( 0 .. $#{$aref} ) {
say "Testing $idx.";
say "\t$idx exists." if exists $aref->[$idx];
say "\t$idx defined." if defined $aref->[$idx];
}
OUTPUT:
Testing 0.
Testing 1.
Testing 2.
2 exists.
Testing 3.
3 exists.
3 defined.
Testing 4.
We pre-allocated five spots in the anonymous array, #{$aref}. The top index is 4. We are able to find what the top index is the same way we created it; by testing the value of $#{$aref}. We can test for existence. We know everything between 0 and 4 was created. But Perl only reports "exists" for array elements that have specifically had something assigned to them (even if it's undef). Therefore, $aref->[2] is reported to exist, but isn't defined. Just for fun, we assigned '' to $aref->[3] to see a test report defined once. But the short story is that even though the array is pre-extended, we can still test for the difference between an element being initialized with undef, and an element being undef through array pre-extension, by using 'exists'.
I can't say that's documented behavior of exists. So there's no guarantee it wouldn't change someday. But it works on 5.8, 5.10, 5.12, and 5.14.
So, looking for a simple way to find which elements were initialized, which were defined, and which were not, here's an example:
use feature qw/ say /;
use strict;
use warnings;
my $aref;
$#{$aref} = 4;
$aref->[2] = undef;
$aref->[3] = '';
my #initialized = grep { exists $aref->[$_] } 0 .. $#{$aref};
my #defined = grep { defined $aref->[$_] } 0 .. $#{$aref};
my #uninitialized = grep { not exists $aref->[$_] } 0 .. $#{$aref};
my #init_undef = grep { exists $aref->[$_] and not defined $aref->[$_] } 0 .. $#{$aref};
say "Top index is $#{$aref}.";
say "These elements are initialized: #initialized.";
say "These elements are not initialized: #uninitialized.";
say "These elements were initialized with 'undef': #init_undef.";
say "These elements are defined: #defined."
That should do:
$a=[];
$#$a=4;
Update (replying to #hexcoder): In one statement:
$#{$a=[]}=4
And in one statement that returns the array:
$a = (map(($_,$#$_=4),[]))[0]
Though, not that I recommend using that construction...
Background: In my test scripts I would like to be able to compare array contents precisely. For example I want to distinguish between 'not assigned' and 'assigned with an undef value'.
You can check if the index is past the end. Beyond that, there's not much you can do.
$x = [];
undef $x->[9999];
print scalar #$x;
prints 10000. The undef $x->[9999] is equivalent to $x->[9999] = undef; Because none of the elements 0 to 9998 exist, perl will magically assign all of the intervening elements to undef.
You can only do that kind of thing from XS code (see for example Devel::Peek). Some, but not all, of it is exposed by the *::Util packages. (I've been working on a debugging/tracing package, so I know more about this than anyone should need to....)

In Perl, what's the difference between "if defined $count" and "if $count"?

I have the following script:
#!/usr/bin/perl
use warnings;
use strict;
my $count = 0;
my ( #first , #second , #third );
while ($count <= 7){
push ( #first , $count);
push ( #second , $count) if defined $count;
push ( #third , $count) if $count;
$count++;
}
print "first: #first\n";
print "second: #second\n";
print "third: #third\n";
This produces the following output:
first: 0 1 2 3 4 5 6 7
second: 0 1 2 3 4 5 6 7
third: 1 2 3 4 5 6 7
What's the difference between putting if defined $count vs. if $count, other than the latter method won't add the zero to the array? I've searched the perldocs but couldn't find the answer.
Truth and Falsehood in perlsyn explains what values are considered false in a boolean context:
The number 0, the strings '0' and '',
the empty list (), and undef are
all false in a boolean context. All other values are true.
undef is the value of a variable that has never been initialized (or that has been reset using the undef function). The defined function returns true if the value of the expression is not undef.
if $count is false if $count is the number 0, the string '0', the empty string, undef, or an object that has been overloaded to return one of those things when used in a boolean context. Otherwise, it's true. (The empty list can't be stored in a scalar variable.)
if defined $count is false only if $count is undef.
if you see the documentation of defined in perldoc then you will find that
Returns a Boolean value telling
whether EXPR has a value other
than the undefined value undef. If EXPR is not present, $_ is
checked.
A simple Boolean test will not
distinguish among undef, zero, the
empty string, and "0" , which are all
equally false.
that means,
push ( #second , 'undef') if defined $count;
when $count = 0, then it is defined because 0 is different from undef and defined returns true, but in this case push ( #third , 'undef') if $count; if condition fails, that's why it is not pushing 0 into the array.
The defined predicate tests to see whether the variable ($count in this case) is defined at all. In the code you've written, it always will be defined inside the loop because it's always got some value.
If you were to add:
undef $count;
push ( #first , 'undef');
push ( #second , 'undef') if defined $count;
push ( #third , 'undef') if $count;
after the loop, you would see the difference. (Note that I changed the code to add the literal 'undef' instead of $count because you'll get misleading effects from adding the actual undef value.
The if decides to run its block (or single statement) by looking at the value of the expression you give it:
if( EXPR ) { ... }
If that expression is true, it runs its block. If that expression is false, it doesn't.
That expression can be just about anything. Perl evaluates the expression, reducing it to a value that is either true or false. The if() then looks at that value.
So, removing that part of your question, you're left with "What's the difference between defined $count and $count". Well, one is the return value for defined and the other is whatever value is stored in $count.
When you want to figure out what a particular bit of code is doing, reduce it in the same logical process that perl would, one step at a time. See what each step does, and you'll often be able to answer your own questions. :)
You say that you searched the documentation, but I'm not sure where you looked. If you want to look up a built-in function, you can use perldoc's -f switch:
$ perldoc -f defined
If you want to read about Perl's syntax for things such as if, that's in perlsyn.
I have a beginner's guide to the Perl docs in Perl documentation documentation.
The way I read it.
if $count is only true when $count evaluates != 0, hence the third array has no 0 in it.
if defined $count checks to see if the $count as a scalar has been created, and as you have $count scalar, it's the same as the first one.