develooper Front page | perl.perl5.porters | Postings from June 2011

[perl #93548] do-given doesn't return values from variables defined inside given

From:
brian d foy
Date:
June 26, 2011 20:21
Subject:
[perl #93548] do-given doesn't return values from variables defined inside given
Message ID:
rt-3.6.HEAD-16080-1309030720-1695.93548-75-0@perl.org
# New Ticket Created by  "brian d foy" 
# Please include the string:  [perl #93548]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=93548 >


This is a bug report for perl from brian.d.foy@gmail.com,
generated with the help of perlbug 1.39 running under perl 5.14.1.


-----------------------------------------------------------------
[Please describe your issue here]

The variables declared inside the given and lower don't propagate through the
do to become the return value. Additionally, this causes a panic for me.

	#!/usr/local/perls/perl-5.14.1/bin/perl
	
	use 5.014;
	use Test::More;
	
	use vars qw($file_local $for_local $do_local $given_local $when_local);
	
	my    $file_my    = 'Buster';
	our   $file_our   = 'Mimi';
	
	my @tests = map {
		my $scope = $_;
		map { "$_-$scope" } qw(file for do given when)
		} qw(my our local);
	
	qw(
		my local our file-my file-our for-my for-our given-my given-our
		);
	
	foreach my $test (@tests ) {
		my    $for_my    = 'Buster';
		our   $for_our   = 'Mimi';
		local $for_local = 'Roscoe';
	
		my $got = do {
			my    $do_my    = 'Buster';
			our   $do_our   = 'Mimi';
			local $do_local = 'Roscoe';
	
			given( $test ) {
				my    $given_my    = 'Buster';
				our   $given_our   = 'Mimi';
				local $given_local = 'Roscoe';
				
				when( 'when-my' )         { my $quux = 'quux!'    }
				when( 'when-local' )      { local $when_local = 1 }
				when( 'when-our' )        { our $fib = 'quak!'    }
		
				when( 'given-my' )        { $given_my             }
				when( 'given-local' )     { $given_our            }
				when( 'given-our' )       { $given_local          }
	
				when( 'do-my' )           { $do_my                }
				when( 'do-our' )          { $do_our               }
				when( 'do-local' )        { $do_local             }
		
				when( 'for-my' )          { $for_my               }
				when( 'for-our' )         { $for_our              }
				when( 'for-local' )       { $for_local            }
		
				when( 'file-my' )         { $file_my              }
				when( 'file-our' )        { $file_our             }
				when( 'file-local' )      { $file_local           }
		
				default              { 'default'             }
				}
			};
	
		ok( $got, "Value for $test is defined [$got]" );
		}
	
	done_testing();

This program causes a panic, too:

	# Testing file-my
	ok 1 - Value for file-my is defined [Buster]
	# Testing for-my
	ok 2 - Value for for-my is defined [Buster]
	# Testing do-my
	ok 3 - Value for do-my is defined [Buster]
	# Testing given-my
	not ok 4 - Value for given-my is defined []
	#   Failed test 'Value for given-my is defined []'
	#   at test-local.pl line 60.
	# Testing when-my
	not ok 5 - Value for when-my is defined []
	#   Failed test 'Value for when-my is defined []'
	#   at test-local.pl line 60.
	# Testing file-our
	ok 6 - Value for file-our is defined [Mimi]
	# Testing for-our
	ok 7 - Value for for-our is defined [Mimi]
	# Testing do-our
	ok 8 - Value for do-our is defined [Mimi]
	# Testing given-our
	not ok 9 - Value for given-our is defined []
	#   Failed test 'Value for given-our is defined []'
	#   at test-local.pl line 60.
	# Testing when-our
	ok 10 - Value for when-our is defined [quak!]
	# Testing file-local
	not ok 11 - Value for file-local is defined []
	#   Failed test 'Value for file-local is defined []'
	#   at test-local.pl line 60.
	# Testing for-local
	ok 12 - Value for for-local is defined [Roscoe]
	# Testing do-local
	ok 13 - Value for do-local is defined [Roscoe]
	# Testing given-local
	ok 14 - Value for given-local is defined [Mimi]
	# Testing when-local
	panic: attempt to copy freed scalar 10088e328 to 100826ce8 at
test-local.pl line 31.
	# Tests were run but no plan was declared and done_testing() was not seen.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=high
---
Site configuration information for perl 5.14.1:

Configured by brian at Sun Jun 19 13:36:19 CEST 2011.

Summary of my perl5 (revision 5 version 14 subversion 1) configuration:

  Platform:
    osname=darwin, osvers=10.7.0, archname=darwin-2level
    uname='darwin roscoe.local 10.7.0 darwin kernel version 10.7.0:
sat jan 29 15:17:16 pst 2011; root:xnu-1504.9.37~1release_i386 i386
i386 '
    config_args='-des -Dprefix=/usr/local/perls/perl-5.14.1'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-common -DPERL_DARWIN -fno-strict-aliasing
-pipe -fstack-protector -I/usr/local/include',
    optimize='-O3',
    cppflags='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe
-fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.2.1 (Apple Inc. build 5664)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags ='
-fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib
    libs=-ldbm -ldl -lm -lutil -lc
    perllibs=-ldl -lm -lutil -lc
    libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup
-L/usr/local/lib -fstack-protector'

Locally applied patches:


---
@INC for perl 5.14.1:
    /usr/local/perls/perl-5.14.1/lib/site_perl/5.14.1/darwin-2level
    /usr/local/perls/perl-5.14.1/lib/site_perl/5.14.1
    /usr/local/perls/perl-5.14.1/lib/5.14.1/darwin-2level
    /usr/local/perls/perl-5.14.1/lib/5.14.1
    .

---
Environment for perl 5.14.1:
    DYLD_LIBRARY_PATH (unset)
    HOME=/Users/brian
    LANG=en_US
    LANGUAGE (unset)
    LC_ALL=en_US.UTF-8
    LC_COLLATE=en_US.utf-8
    LC_CTYPE=en_US.utf-8
    LC_MESSAGES=en_US.utf-8
    LC_MONETARY=en_US.utf-8
    LC_NUMERIC=en_US.utf-8
    LC_TIME=en_US.utf-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/Users/brian/bin:/usr/local/bin:/Users/brian/TPR/scripts:/bin:/usr/bin:/sbin:/usr/sbin:/usr/X11R6/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About