if (my $result = thatroutine()) { 
     return $result;
}
[download]

Aha! I knew it merely took the electron spin reversal of the other side of the world to solve this correctly! Thanks. That's the version that goes into the example now.

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

This works fine, and does not clobber $_.

#!/usr/bin/perl -w

use strict;

print test(), $/;

sub subtest { return 4 }

sub test {
    return $_ if ( local $_ = subtest() );

    # continue
    return 'false';
}
[download]

Given how often I hear about (even experienced) programmers mistakenly typing "=" in an if statement when they meant "==", I don't know if encouraging this particular idiom as a rare case where it is indeed what you mean is a good idea. Might I suggest this instead:

while (my $result = thatroutine()) {
     return $result;
}
[download]

As an aside, I was actually surprised that the version with if didn't warn about the single "=", but a little testing showed that the warning only appears to happen if you mistakenly assign (instead of compare) a literal value, not a subroutine.

-xdg

Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.

I agree with you. I would certainly never recommend that people write:

if ($result = thatroutine()) {
     return $result;
}
[download]

But, as your while-based variant shows, non-constant assignments in a conditional are always fine if you're declaring the lvalue variable at that point:

if (my $result = thatroutine()) {
     return $result;
}
[download]

In such cases, the = must be intentional, since == on a newly-created variable doesn't make any sense.

As for your alternative suggestion, I don't feel it's a clear or as clean as using an if, because the use of a while implies looping behaviour, which the return undermines in a not-entirely-obvious way. That could be especially misleading to subsequent readers of the code if the number of statements in the while block later increases, pushing the return away from the loop keyword it's subverting.

I want a subroutine to call another subroutine, and if the return value from that subroutine is true, this subroutine should return that value, otherwise continue.

I'd think that keeping value retrieval and flow of control separate will be easiest on whoever picks up the code next. That speaks for either of your last two solutions, or something more explicit, like

  my $v = thatroutine();
  return $v if $v;
[download]

Since you're willing to consider taking on the overhead of eval, I rather suspect a temporary variable won't faze you, especially since it offers a convenient debug point for anyone who is stepping through the code.

the overhead of eval

Huh? Are you confusing eval $string (which fires up a compiler) with eval {block} (which merely pushes a marker onto the return stack)?

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

Huh? Are you confusing ...

No confusion here. The bookkeeping overhead (pushing a marker onto the return stack, though I recall eval doing a bit more than that) is on par with creating a temporary variable. In my mind, at least, that cancels any performance objections about using a temporary variable.

eval'ing a string would be nuts, and I give you credit for not being that nuts.

why not just:

retrun thatroutine() if thatroutine()

edit: or

 if (thatroutine()) {return $_}

--
Linux, sci-fi, and Nat Torkington, all at Penguicon 3.0
perl -e 'print(map(chr,(0x4a,0x41,0x50,0x48,0xa)))'

retrun thatroutine() if thatroutine()

That calls thatroutine() twice, which will perform things twice. Not good.

if (thatroutine()) {return $_}

$_ isn't getting set there. Are you expecting the variable to be psychic?

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

T'aint pretty.

    ...
    { return do{ thatroutine() or last } }
    ...
[download]

You don't need the do:

{ return thatroutine() || last }

eval { return thatroutine() || die };
[download]

The || operator is the high priority logical or, so if thatroutine() evaluates false, die is evaluated before return is.

Update: Oops, I misunderstood your objection, which is correct:

$ perl -Mstrict -we'sub bar {"baz"} sub foo {eval{return bar() || die}
+; "quux"} print foo()'
quux$
[download]

If the eval return was effective in the foo() call, should have printed "baz".

After Compline,
Zaxo

Thats clear to me, but I do not understand the other part: The question is how to return a value, if it is true and continue otherwise.

sub that { 5 }
sub xx{ eval { return that() || die }; 1 }
print xx;
__OUTPUT__
1
[download]

But the op wants 5 and that the part outside the eval is not executed expect when that is false.
Boris

Not really any better, but there is:

$rv = thatsubroutine()
   and return $rv;
[download]

The trouble is that you can't add a "my" there. You can't use "my $foo" and "$foo" in the same statement, because the "my" isn't in effect until the next statement.

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

My guesses are:

sub thisoutine {
    PRE_CODE();
    thisroutine() and do {
    CONTINUE();
    };
}
[download]

sub thisroutine {
    PRE_CODE();
    unless (thatroutine()) {
    CONTINUE();
    }
}
[download]

I tried

return $var if my $var = thatroutine();
[download]

return my $var if $var = thatroutine();
[download]

Don't do that; $_ is a global.

I concur.

And I've previously found when I was doing a micro-optimisation effort somewhere, that $_ is also relatively slow to assign and then read from, compared to the temporary variable.

First of all, it helps to characterize the problem: you're building a very simple state machine. Each called subroutine is a new state, and the return value from each called function is the input which selects the next transition. In this case, you want FALSE to trigger a transition to the next state, and TRUE to trigger a transition to the accept state:

    (s0)- F ->(s1)- F ->(s2)-[...]
      |         |         |
      +---------+---------+--[...]- T ->(accept)
[download]

In this case, you can implement that with a list of function pointers and a loop:

    sub outer {
        my @funcs = (\&f1, \&f2, \&f3, ...);
        my $result = 0;
        
        for $f (@funcs) {
            $result = $f->();
        last if $result;
        }
        
        return ($result);
    }
[download]

And more generally, you can use a hash as a transition table:

    sub outer {
        %trans = _get_transition_table();
        
        my $f = $trans{'start'};
        my $result = 0;
        
        do {
            $result = $f1->();
            my $state = ($result) ? "$f.true" : "$f.false";
            $f = $trans{ $state };
        } while ($f);
        
        return ($result);
    }
    
    sub _get_transition_table {
        my $f1 = \&f1;
        my $f2 = \&f2;
        my $f3 = \&f3;
        [...]
        
        return (
            "start"     =>  $f1,
            "$f1.true"  =>  0,
            "$f1.false" =>  $f2,
            [...]
        );
    }
[download]

which allows for multiple output values per function, and state diagrams that are more complicated than just a simple list.

If you want to pass parameters to the functions, pass a listref and have the called functions and use it as an argument list, a stack, a queue, or whatever:

    sub caller {
        [yadda yadda]
        
        my $args = [];
        
        do {
            $result = $f->($args);
            [yadda yadda]
        } while ($f);
        
        return ($result);
    }
    
    sub as_list {
        my $args = shift;
        
        my ($arg1, $arg2, $arg3) = @$args;
        @$args = ();
        
        [...]
    }
    
    sub as_stack {
        my $args = shift;
        my $item = pop @$args;
        
        [...]
        
        push @args, $result;
        
        return ([true|false]);
    }
    
    sub as_queue {
        my $args = shift;
        my $item = shift @$args;
        
        [...]
        
        push @args, $result;
        
        return ([true|false]);
    }
[download]

thatroutine() =~ /(.+)/s and return $1;
[download]

Sorry, no offense, but this looks really terrible to me... Why on earth do you want to fire up a regex matching here?

Probably this has also an interesting side effect: it could convert a "numeric" scalar into a "string" scalar. No good.

I'm not saying it's good, but it does answer the OP, somewhat, and it's very short.

...it could convert a "numeric" scalar into a "string" scalar. No good.

If you think such conversions are inherently bad, then Perl probably isn't the language for you.

map { $_ ? return $_ : () } that_routine();
[download]

return $_ for grep $_, thatroutine();
[download]

return $_ for thatroutine() or ();
[download]

return thatroutine() || do {
    # the rest of the sub ...
};
[download]

This won't work if, for example, the return statement is to be used in the middle of a loop, or some other control flow block.

update: I just noticed somebody on use.perl.org thought of the same solution.

print testing();

sub testing {
    return $_ if $_ = rval0();
    return $_ if $_ = rval1();
}

sub rval1 {
    return 1;
}

sub rval0 {
    return 0;
}
[download]

Except that those clobber a regional $_, which may be needed for other things. I might as well use the predeclared $a or $b instead, with just about as much chance of collision.

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

I guess you're missing a set of parens there:

($_ = thatroutine()) ? return $_ : undef;
[download]

$_ ? return $_ : undef for thatroutine();
#or simply 
return $_ if $_ for thatroutine();
[download]


Gyan Kapur

map{$_&&return$_}thatroutine();
[download]

With return($level, $thingy) you get

sub return_if {
    if ($_[0]){
        return(2, $_[0]);
    }
}
[download]

return $_ || last for subroutine() (T04) was my choice for syntax, and I was sorry to see that the for loops are so slow.

The winner was if (my $ret = subroutine()) { return $ret)} as might be expected, as this is (I would assume) the most common way to test a return value.

       Rate  T11  T02  T10  T03  T01  T04  T09  T08  T06  T07  T05
T11 37594/s   --  -8% -12% -12% -29% -31% -39% -39% -47% -47% -50%
T02 40959/s   9%   --  -4%  -4% -23% -24% -33% -33% -42% -42% -46%
T10 42581/s  13%   4%   --  -0% -20% -21% -30% -30% -40% -40% -44%
T03 42708/s  14%   4%   0%   -- -20% -21% -30% -30% -39% -39% -44%
T01 53095/s  41%  30%  25%  24%   --  -2% -13% -13% -25% -25% -30%
T04 54097/s  44%  32%  27%  27%   2%   -- -12% -12% -23% -23% -29%
T09 61265/s  63%  50%  44%  43%  15%  13%   --   0% -13% -13% -19%
T08 61265/s  63%  50%  44%  43%  15%  13%   0%   -- -13% -13% -19%
T06 70447/s  87%  72%  65%  65%  33%  30%  15%  15%   --   0%  -7%
T07 70447/s  87%  72%  65%  65%  33%  30%  15%  15%   0%   --  -7%
T05 75918/s 102%  85%  78%  78%  43%  40%  24%  24%   8%   8%   --

thatroutine() and return;
[download]

Hardly a deficiancy... especially when return; doesn't return undef _OR_ (), it returns both undef _AND_ () at the same time (dependending on context of course).

We would have to replace all existing return; with return wantarray ? () : undef;

ugh...

It returns the equivalent of an empty list, which in a scalar context, is undef.

my $x = ();
[download]

Sets $x to undef.

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

Doesn't the following bit of code work? It's only slightly more obtuse than what you propose.

thatroutine() and return 1;
[download]
UPDATE: I just tested this to prevent ignorance, and it does in fact work.
UPDATE AGAIN: Ah, I missed the point. My code does not return the value returned by thatroutine(). If there are no side effects I suppose you could do:

thatroutine() and return thatroutine();
[download]
:-)
----
My mission: To boldy split infinitives that have never been split before!

This reminds me of how Applescript does it. When a sub is called in void context, the variable result gets assigned the return value. Sort of like this (pseudo):

thatroutine() and return @result;
[download]

Sounds like a Perl 6 feature request...

#!/usr/bin/perl -w
use strict;

my $foo = shift;

sub one {
    return shift;
}

sub two {
    push @_, one( $foo ) and $_[0] ? return pop : pop;
    return "No arg";
}

print two() . "\n";;
[download]

if you wouldn't mind refactoring thatroutine, this works:

sub thatroutine(\$) { # do something to ${$_[0]} }

sub thisroutine
{
     return $_ if thatroutine local $_;
     ...
     my $namedvar;
     return $namedvar if thatroutine $namedvar;
}
[download]

I haven't seen this among the replies, so here it goes

$_ = thatroutine() and return $_;
[download]

return $_ if $_ = thatroutine();
[download]

the lowliest monk