Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

when( @n && %n ) fails to smart match #9221

Closed
p5pRT opened this issue Feb 5, 2008 · 4 comments
Closed

when( @n && %n ) fails to smart match #9221

p5pRT opened this issue Feb 5, 2008 · 4 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 5, 2008

Migrated from rt.perl.org#50538 (status was 'resolved')

Searchable as RT50538$

@p5pRT
Copy link
Author

p5pRT commented Feb 5, 2008

From @briandfoy

Created by @briandfoy

I first mentioned this on p5p in " Clarifying smart match behaviour in
when( ... && ... )" at
http​://groups.google.com/group/perl.perl5.porters/browse_thread/thread/5f5d24422227e57a/2c2aa46cdeabcbcc?lnk=st&q=smart+match+foy#2c2aa46cdeabcbcc

With && in a when() and when both arguments are arrays and hashes, the
smart match doesn't come out right. If it is coming out right, then
there needs to be a doc fix. No one has spoken up to say it should be
one way or the other.

Here's a patch to t/op/switch.t that tests the problem in three
different cases​:

Inline Patch
--- t/op/switch.t	2008-02-04 21:04:17.000000000 -0600
+++ t/op/switch-new.t	2008-02-04 21:13:27.000000000 -0600
@@ -8,7 +8,7 @@
 use strict;
 use warnings;

-use Test::More tests => 108;
+use Test::More tests => 111;

 # The behaviour of the feature pragma should be tested by lib/switch.t
 # using the tests in t/lib/switch/*. This file tests the behaviour of
@@ -520,6 +520,66 @@
     ok($ok, '((1 == $ok) || "foo") smartmatched');
 }

+{ # this should smart match on each side of &&
+	my @n = qw(fred barney betty);
+	my @m = @n;
+	
+	my $ok = 0;
+	given( "fred" ) {
+	when( @n ) {
+		$ok++; continue;
+	}
+	when( @m ) {
+		$ok++; continue;
+	}
+	when( @m && @n ) {
+		$ok++;
+	}
+	}
+
+	is($ok, 3, '(@n && @m) smart-matched');	
+}
+
+{ # this should smart match on each side of &&
+	my @n = qw(fred barney betty);
+	my %n = map { $_, 1 } @n;
+	
+	my $ok = 0;
+	given( "fred" ) {
+	when( @n ) {
+		$ok++; continue;
+	}
+	when( %n ) {
+		$ok++; continue;
+	}
+	when( @n && %n ) {
+		$ok++;
+	}
+	}
+
+	is($ok, 3, '(@n && %n) smart-matched');	
+}
+
+{ # this should smart match on each side of &&
+	my %n = map { $_, 1 } qw(fred barney betty);
+	my %m = %n;
+	
+	my $ok = 0;
+	given( "fred" ) {
+	when( %m ) {
+		$ok++; continue;
+	}
+	when( %n ) {
+		$ok++; continue;
+	}
+	when( %m && %n ) {
+		$ok++;
+	}
+	}
+
+	is($ok, 3, '(%m && %n) smart-matched');	
+}
+
 # Make sure we aren't invoking the get-magic more than once

 { # A helper class to count the number of accesses.
@@ -689,7 +749,7 @@
 	    	q{Can't "break" in a loop topicalizer});
 	}
 	when (1) {
-	    is($first, 1, "Lecical loop: first");
+	    is($first, 1, "Lexical loop: first");
 	    $first = 0;
 	    # Implicit break is okay
 	}
Perl Info

Flags:
    category=core
    severity=high

This perlbug was built using Perl v5.8.8 - Mon Apr  9 10:35:38 CDT 2007
It is being executed now by  Perl v5.10.0 - Sun Dec  2 12:12:45 CST 2007.

Site configuration information for perl v5.10.0:

Configured by brian at Sun Dec  2 12:12:45 CST 2007.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=darwin, osvers=8.10.1, archname=darwin-2level
    uname='darwin alexandria2-10.nyc.access.net 8.10.1 darwin kernel
version 8.10.1: wed may 23 16:33:00 pdt 2007;
root:xnu-792.22.5~1release_i386 i386 i386 '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp
-fno-strict-aliasing -pipe -I/usr/local/include -I/opt/local/include',
    optimize='-O3',
    cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN
-no-cpp-precomp -fno-strict-aliasing -pipe -I/usr/local/include
-I/opt/local/include'
    ccversion='', gccversion='4.0.1 (Apple Computer, Inc. build
5363)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, 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 ='
-L/usr/local/lib -L/opt/local/lib'
    libpth=/usr/local/lib /opt/local/lib /usr/lib
    libs=-ldbm -ldl -lm -lc
    perllibs=-ldl -lm -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 -L/opt/local/lib'

Locally applied patches:



@INC for perl v5.10.0:
    /usr/local/perls/perl-5.10.0-rc2/lib/5.10.0/darwin-2level
    /usr/local/perls/perl-5.10.0-rc2/lib/5.10.0
    /usr/local/perls/perl-5.10.0-rc2/lib/site_perl/5.10.0/darwin-2level
    /usr/local/perls/perl-5.10.0-rc2/lib/site_perl/5.10.0
    .


Environment for perl v5.10.0:
    DYLD_LIBRARY_PATH (unset)
    HOME=/Users/brian
    LANG=en_US
    LANGUAGE (unset)
    LC_ALL=C
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/Library/Frameworks/Python.framework/Versions/Current/bin:/Users/brian/bin:/usr/local/bin:/opt/local/bin:/Users/brian/TPR/scripts:/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/mysql/bin:/usr/X11R6/bin:/usr/local/teTeX/bin/powerpc-apple-darwin-current:/usr/local/pgsql/bin:/usr/local/gcj/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash


-- 
brian d foy <brian.d.foy@gmail.com>
http://www.pair.com/~comdog/

@p5pRT
Copy link
Author

p5pRT commented Jun 27, 2008

From spamdummy3@yahoo.com

This is a bug report for perl from spamdummy3@​yahoo.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.


"perlsyn" says that in the "when" clause of a "given" block, "or"
should cause the test to be applied recursively to the first
argument. I can't fathom why the recursive magic is supposed to
apply to only the first argument, even if it evaluates as false,
but as implemented, "or" in a "given" appears to work neither as
documented nor as to how I think it ought to work. This code​:

sub test
  {my $x = shift;
  given ($x)
  {when ('a' or 'b') {say 'Y';}
  default {say 'N';}}
  given ($x)
  {when ('a' or $_ ~~ 'b') {say 'Y';}
  default {say 'N';}}
  given ($x)
  {when ($_ ~~ 'a' or 'b') {say 'Y';}
  default {say 'N';}}}

test('a');
test('b');

ought, I think, to print six "Y"s, but instead it prints​:

Y
Y
Y
N
N
Y

I asked about this weirdness on Perl Monks
(http​://perlmonks.org/?node_id=693370), but no one was able to
explain it, so I think it's a bug.



Flags​:
  category=core
  severity=medium


This perlbug was built using Perl 5.10.0 - Sat Jun 7 17​:43​:34 EDT 2008
It is being executed now by Perl 5.10.0 - Sat Jun 7 13​:10​:17 EDT 2008.

Site configuration information for perl 5.10.0​:

Configured by hippo at Sat Jun 7 13​:10​:17 EDT 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration​:
  Platform​:
  osname=linux, osvers=2.6.24-16-generic, archname=i686-linux-thread-multi-ld
  uname='linux thoth 2.6.24-16-generic #1 smp thu apr 10 13​:23​:42 utc 2008 i686 gnulinux '
  config_args='-Dusethreads -Duselongdouble'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=undef, use64bitall=undef, uselongdouble=define
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O3',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='4.2.3 (Ubuntu 4.2.3-2ubuntu7)', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long', ivsize=4, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
  alignbytes=4, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib
  libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
  libc=/lib/libc-2.7.so, so=so, useshrplib=false, libperl=libperl.a
  gnulibc_version='2.7'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -O3 -L/usr/local/lib'

Locally applied patches​:
 


@​INC for perl 5.10.0​:
  /usr/local/lib/perl5/5.10.0/i686-linux-thread-multi-ld
  /usr/local/lib/perl5/5.10.0
  /usr/local/lib/perl5/site_perl/5.10.0/i686-linux-thread-multi-ld
  /usr/local/lib/perl5/site_perl/5.10.0
  /usr/local/lib/perl5/site_perl
  /usr/lib/perl/5.8.8
  .


Environment for perl 5.10.0​:
  HOME=/home/hippo
  LANG=en_US.UTF-8
  LANGUAGE (unset)
  LD_LIBRARY_PATH=/usr/lib/xorg
  LOGDIR (unset)
  PATH=/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/usr/bin​:/sbin​:/bin​:/usr/bin/X11​:/usr/games​:~/Geekdom/Perl/Code Generation​:~/Geekdom/Perl/Internet​:~/Geekdom/Perl/Math​:~/Geekdom/Perl/Miscellany​:~/Geekdom/Perl/​:~/Geekdom/Perl/System Utilites​:~/Geekdom/Perl/Text Processing​:~/Geekdom/Perl/Typing Exercises​:~/Desktop​:~/Command-Line Shortcuts
  PERL_BADLANG (unset)
  SHELL=/bin/bash

 

@p5pRT
Copy link
Author

p5pRT commented Dec 14, 2009

From @rgs

Closing bug, since the semantics of ~~ have settled down in 5.10.1.

@p5pRT
Copy link
Author

p5pRT commented Dec 14, 2009

@rgs - Status changed from 'new' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant