[sf-perl] Trying to understand 'caller'

[David Christensen]

sfpm:

I am working on a function for generating debugging information and am 
trying to understand the behavior of 'caller'.  Please see my test 
script 'caller-20200316.t' and the console sessions, at the bottom.


The first through third, and fifth through seventh, test cases behave as 
I expect, but the fourth test case surprises me:

1.  The test case is defined on line 24.

2.  The value to be tested is the return value of uut().

3.  I expected uut() to return a value of 24, but uut() returns 27.


The first line of output holds a clue:

     # uut $u = 27;


I believe this output was produced when Perl evaluated the definition of 
@case (lines 20-30); and, specifically, when Perl evaluated the call to 
uut() in the second position of the fourth test case.


My guess is that when 'caller' is invoked in a function and that 
function is invoked in a multi-line statement, the line number returned 
by 'caller' is the line number of the last expression evaluated in the 
multi-line statement (?).  And, blank lines and comments are ignored (?).


Comments?


David


### First console session, Debian GNU/Linux:

2020-03-16 14:09:09 dpchrist at tinkywinky ~/sandbox/perl
$ cat /etc/debian_version ; uname -a ; perl -v | head -n 3
9.12
Linux tinkywinky 4.9.0-12-amd64 #1 SMP Debian 4.9.210-1 (2020-01-20) 
x86_64 GNU/Linux

This is perl 5, version 24, subversion 1 (v5.24.1) built for 
x86_64-linux-gnu-thread-multi
(with 86 registered patches, see perl -V for more detail)

2020-03-16 14:09:34 dpchrist at tinkywinky ~/sandbox/perl
$ cat caller-20200316.t
#!/usr/bin/env perl

use strict;
use warnings;

use Data::Dumper;
use Test::More;

$| = 1;
$Data::Dumper::Indent = 0;

sub _d { join $", Data::Dumper->Dump(@_) }

sub uut {
     my $u = (caller)[2];
     note 'uut ' . _d [$u], [qw(u)];
     return $u;
}

my @case = (
     [__LINE__, __LINE__,		__LINE__	],
     [__LINE__, sub { __LINE__ },	__LINE__	],
     [__LINE__, sub { (caller)[2] },	0		],
     [__LINE__, uut(),			__LINE__	], # 27?
     [__LINE__, \&uut,			0		],
     [__LINE__, sub { uut() },		__LINE__	],
     [__LINE__, sub { \&uut },		0		],

     # Third column of 0 means call to 'caller' is delayed and test loop
     # must compute expected value.
);

for my $case (@case) {
     my ($l, $v, $x) = @$case;
     note 'for ' . _d [$l, $v, $x], [qw(l v x)];
     while (ref $v) {
        	$v = $v->();
     	$x = __LINE__ - 1 unless $x;
        	note 'while ' . _d [$v, $x], [qw(v x)];
     };
     is $v, $x, 'is ' . _d [$v, $x], [qw(v x)];
}

done_testing;

2020-03-16 14:09:39 dpchrist at tinkywinky ~/sandbox/perl
$ perl caller-20200316.t
# uut $u = 27;
# for $l = '21'; $v = '21'; $x = '21';
ok 1 - is $v = '21'; $x = '21';
# for $l = '22'; $v = sub { "DUMMY" }; $x = '22';
# while $v = '22'; $x = '22';
ok 2 - is $v = '22'; $x = '22';
# for $l = '23'; $v = sub { "DUMMY" }; $x = 0;
# while $v = 37; $x = 37;
ok 3 - is $v = 37; $x = 37;
# for $l = '24'; $v = 27; $x = '24';
not ok 4 - is $v = 27; $x = '24';
#   Failed test 'is $v = 27; $x = '24';'
#   at caller-20200316.t line 41.
#          got: '27'
#     expected: '24'
# for $l = '25'; $v = sub { "DUMMY" }; $x = 0;
# uut $u = 37;
# while $v = 37; $x = 37;
ok 5 - is $v = 37; $x = 37;
# for $l = '26'; $v = sub { "DUMMY" }; $x = '26';
# uut $u = 26;
# while $v = 26; $x = '26';
ok 6 - is $v = 26; $x = '26';
# for $l = '27'; $v = sub { "DUMMY" }; $x = 0;
# while $v = sub { "DUMMY" }; $x = 37;
# uut $u = 37;
# while $v = 37; $x = 37;
ok 7 - is $v = 37; $x = 37;
1..7
# Looks like you failed 1 test of 7.


### Second console session, FreeBSD with newer version of Perl:

2020-03-16 14:12:25 dpchrist at f3 ~/sandbox/perl
$ freebsd-version ; uname -a ; perl -v | head -n 2
12.1-RELEASE-p2
FreeBSD f3.tracy.holgerdanske.com 12.1-RELEASE-p2 FreeBSD 
12.1-RELEASE-p2 GENERIC  amd64

This is perl 5, version 30, subversion 1 (v5.30.1) built for 
amd64-freebsd-thread-multi

2020-03-16 14:12:29 dpchrist at f3 ~/sandbox/perl
$ perl caller-20200316.t
# uut $u = 27;
# for $l = '21'; $v = '21'; $x = '21';
ok 1 - is $v = '21'; $x = '21';
# for $l = '22'; $v = sub { "DUMMY" }; $x = '22';
# while $v = '22'; $x = '22';
ok 2 - is $v = '22'; $x = '22';
# for $l = '23'; $v = sub { "DUMMY" }; $x = 0;
# while $v = 37; $x = 37;
ok 3 - is $v = 37; $x = 37;
# for $l = '24'; $v = 27; $x = '24';
not ok 4 - is $v = 27; $x = '24';
#   Failed test 'is $v = 27; $x = '24';'
#   at caller-20200316.t line 41.
#          got: '27'
#     expected: '24'
# for $l = '25'; $v = sub { "DUMMY" }; $x = 0;
# uut $u = 37;
# while $v = 37; $x = 37;
ok 5 - is $v = 37; $x = 37;
# for $l = '26'; $v = sub { "DUMMY" }; $x = '26';
# uut $u = 26;
# while $v = 26; $x = '26';
ok 6 - is $v = 26; $x = '26';
# for $l = '27'; $v = sub { "DUMMY" }; $x = 0;
# while $v = sub { "DUMMY" }; $x = 37;
# uut $u = 37;
# while $v = 37; $x = 37;
ok 7 - is $v = 37; $x = 37;
1..7
# Looks like you failed 1 test of 7.