develooper Front page | perl.perl5.porters | Postings from April 2001

[ID 20010412.002] tie() magic upsets stack (can't last() outsideof block)

Thread Next
From:
jpinyan
Date:
April 12, 2001 10:09
Subject:
[ID 20010412.002] tie() magic upsets stack (can't last() outsideof block)
Message ID:
200104121708.NAA18395@sushi.riskgrades.com
This is a bug report for perl from japhy@pobox.com,
generated with the help of perlbug 1.28 running under perl v5.6.0.


-----------------------------------------------------------------
[Please enter your report here]

I was attempting to create a hybrid while loop -- one that exited the
very moment a condition was met.  I used tie() to (almost) achieve this
end:


#################################################################
#!/usr/bin/perl

package Tie::Ensure;
use strict;


sub TIESCALAR {
  my ($class, $var, $code) = @_;
  bless {
    VAL => $$var,
    CODE => $code,
  }, $class;
}


sub FETCH { $_[0]{VAL} }


sub STORE {
  my ($self, $val) = @_;
  local $_ = $self->{VAL} = $val;
  $self->{CODE}->() ? $_ : last;   # <-- bad news
}


package main;
use strict;


sub ensure (&@) {
  my ($cref, $obj, $loop) = @_;
  tied($$obj)->{CODE} = $cref;
  { $loop->(); redo }
}


sub using (\$) {
  tie ${$_[0]}, 'Tie::Ensure', $_[0];
  return $_[0];
}


sub looping (&) { $_[0] }


my $foo = 10;

ensure { $_ < 15 } using($foo), looping {
  print "before: $foo\n";
  $foo++;  # <-- bad news
  print "after: $foo\n";
};
#################################################################


When I run this code, I'm told I can't call last() from outside a loop
block.  Ugh.  I can't even get a nasty goto() to work for me.

However, if I change $foo++ to

  tied($foo)->STORE($foo + 1);

everything works fine.  But this should NOT be required of an enduser
(particularly, me).

It seems that the implicit slide into STORE messes up Perl's view of the
stack.  This upsets me.  I'd really like this program to work.  What can
be done to change this?


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
---
Site configuration information for perl v5.6.0:

Configured by root at Tue Feb  6 18:31:14 EST 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=solaris, osvers=2.7, archname=sun4-solaris
    uname='sunos sushi 5.7 generic_106541-14 sun4u sparc sunw,ultra-60 '
    config_args='-Dcc=gcc -Doptimize=-O2'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=undef 
    use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler:
    cc='gcc', optimize='-O2', gccversion=2.95.2 19991024 (release)
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccflags ='-fno-strict-aliasing -I/usr/local/include'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
    alignbytes=8, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -lgdbm -ldb -ldl -lm -lc -lcrypt -lsec
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:
    

---
@INC for perl v5.6.0:
    /usr/local/lib/perl5/5.6.0/sun4-solaris
    /usr/local/lib/perl5/5.6.0
    /usr/local/lib/perl5/site_perl/5.6.0/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.6.0
    /usr/local/lib/perl5/site_perl
    .

---
Environment for perl v5.6.0:
    HOME=/export/home/jpinyan
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/local/oracle/lib
    LOGDIR (unset)
    PATH=/usr/local/bin:/usr/openwin/bin:/usr/bin:/usr/local/oracle/bin:.:/export/home/jpinyan/bin
    PERL_BADLANG (unset)
    SHELL=/bin/tcsh


Thread Next


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