olson@sax.cs.uiuc.edu (Robert Olson) (03/16/91)
There seems to be a problem with the construct
while (($key, *list) = each (%assoc))
{
...
}
where the values in assoc are symbol table entries pointing to arrays
(Is that right? I don't think I completely understand the *var
construct).
Namely, perl coredumps with a segfault.
The seemingly equivalent structure
for $key (keys %assoc)
{
*list = $assoc{$key};
...
}
seems to work fine.
I've generated four scripts, each a little different, that produce a
segfault in three different parts of perl. The sharfile at the end of
this posting contains the scripts and the gdb backtraces for each.
Version information (for the backtraces):
> This is perl, version 4.0
> $Header: perly.c,v 4.0.beta 91/01/11 18:22:48 lwall Locked $
> Patch level: 0
> Copyright (c) 1989, 1990, 1991, Larry Wall
> Perl may be copied only under the terms of the GNU General Public License,
> a copy of which can be found with the Perl 4.0 distribution kit.
Running on a sparcstation 1+ with SunOS 4.1.
The code also crashes with
> This is perl, version 3.0
> $Header: perly.c,v 3.0.1.10 91/01/11 18:22:48 lwall Locked $
> Patch level: 44
> Copyright (c) 1989, 1990, Larry Wall
> Perl may be copied only under the terms of the GNU General Public License,
> a copy of which can be found with the Perl 3.0 distribution kit.
on the Sun and on a DECstation 3100.
--bob
Bob Olson University of Illinois at Urbana/Champaign
Internet: rolson@uiuc.edu UUCP: {uunet|convex|pur-ee}!uiucdcs!olson
UIUC NeXT Campus Consultant NeXT mail: olson@fazer.champaign.il.us
"You can't win a game of chess with an action figure!" AMA #522687 DoD #28
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# bug1
# bug2
# bug3
# bug4
# backtrace.1
# backtrace.2
# backtrace.3
# backtrace.4
# This archive created: Sat Mar 16 09:34:23 1991
export PATH; PATH=/bin:$PATH
if test -f 'bug1'
then
echo shar: will not over-write existing file "'bug1'"
else
cat << \SHAR_EOF > 'bug1'
#!/usr/local/bin/perl
$gensym = 'symdata00000';
$sym = "astrin";
%nodeUnlinked = ();
%fileAssoc = ("nodeUnlinked", *nodeUnlinked);
&readFile("nodeUnlinked", "one");
&intersect("nodeUnlinked");
sub intersect
{
local($type) = @_;
local(*list, $key);
local(*assoc) = $fileAssoc{$type};
print "Intersecting for type $type\n";
while (($key, *list) = each(%assoc))
{
print "key is $key, list is ", join(',', @list),"\n";
}
print "exiting\n";
}
sub readFile
{
local($which, $name) = @_;
$lname = $gensym++;
$str = "@$lname = (); *$lname";
*list = eval $str;
push(@list, $sym++, $sym++, $sym++);
local(*assoc) = $fileAssoc{$which};
$assoc{$name} = *list;
}
# ;;; Local Variables: ***
# ;;; mode: cperl ***
# ;;; End: ***
SHAR_EOF
chmod +x 'bug1'
fi # end of overwriting check
if test -f 'bug2'
then
echo shar: will not over-write existing file "'bug2'"
else
cat << \SHAR_EOF > 'bug2'
#!/usr/local/bin/perl
$gensym = 'symdata00000';
%mainAssoc = ("assoc", *assoc);
%assoc = ();
@ames = keys %mainAssoc;
local(*list) = eval "@$gensym = (); *$gensym";
local(*as) = $mainAssoc{"assoc"};
$as{"foo"} = *list;
push(@list, 1, 2, 3);
print "calling nocrash\n";
&nocrash;
print "nocrash returns\n";
print "calling crash\n";
&crash;
print "crash returns\n";
exit 0;
sub crash
{
local(*list, $key);
local(*as);
*as = $mainAssoc{"assoc"};
print "doing it\n";
while (($key, *list) = each(%as))
{
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
sub nocrash
{
local(*list, $key);
local(*as);
*as = $mainAssoc{"assoc"};
print "doing it\n";
for $key (keys %as)
{
*list = $assoc{$key};
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
# Which is one of the files in
# ;;; Local Variables: ***
# ;;; mode: cperl ***
# ;;; End: ***
SHAR_EOF
chmod +x 'bug2'
fi # end of overwriting check
if test -f 'bug3'
then
echo shar: will not over-write existing file "'bug3'"
else
cat << \SHAR_EOF > 'bug3'
#!/usr/local/bin/perl
$gensym = 'symdata00000';
%assoc = ();
local(*list) = eval "@$gensym = (); *$gensym";
$assoc{"foo"} = *list;
push(@list, 1, 2, 3);
print "calling nocrash\n";
&nocrash;
print "nocrash returns\n";
print "calling crash\n";
&crash;
print "crash returns\n";
exit 0;
sub crash
{
local(*list, $key);
print "doing it\n";
while (($key, *list) = each(%assoc))
{
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
sub nocrash
{
local(*list, $key);
print "doing it\n";
for $key (keys %assoc)
{
*list = $assoc{$key};
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
# Which is one of the files in
# ;;; Local Variables: ***
# ;;; mode: cperl ***
# ;;; End: ***
SHAR_EOF
chmod +x 'bug3'
fi # end of overwriting check
if test -f 'bug4'
then
echo shar: will not over-write existing file "'bug4'"
else
cat << \SHAR_EOF > 'bug4'
#!/usr/local/bin/perl
$gensym = 'symdata00000';
%assoc = ();
@list = ();
$assoc{"foo"} = *list;
push(@list, 1, 2, 3);
print "calling nocrash\n";
&nocrash;
print "nocrash returns\n";
print "calling crash\n";
&crash;
print "crash returns\n";
exit 0;
sub crash
{
local(*list, $key);
print "doing it\n";
while (($key, *list) = each(%assoc))
{
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
sub nocrash
{
local(*list, $key);
print "doing it\n";
for $key (keys %assoc)
{
*list = $assoc{$key};
print "got key $key\n";
print "got list ", join(',', @list), "\n";
}
print "exiting\n";
}
# Which is one of the files in
# ;;; Local Variables: ***
# ;;; mode: cperl ***
# ;;; End: ***
SHAR_EOF
fi # end of overwriting check
if test -f 'backtrace.1'
then
echo shar: will not over-write existing file "'backtrace.1'"
else
cat << \SHAR_EOF > 'backtrace.1'
(gdb) r bug/bug1
Starting program: /home/reed/olson/perl/perl4 bug/bug1
Intersecting for type nodeUnlinked
key is one, list is astrin,astrio,astrip
exiting
Program received signal 11, Segmentation fault
0x30930 in stab_clear (stab=(struct stab *) 0x89dd8) (stab.c line 870)
(gdb) where
#0 0x30930 in stab_clear (stab=(struct stab *) 0x89dd8) (stab.c line 870)
#1 0x6090 in restorelist (...) (...)
#2 0xf748 in do_subr (...) (...)
#3 0x2050c in eval (arg=(struct arg *) 0x89cb8, gimme=0, sp=1) (eval.c line 1268)
#4 0x4bd0 in cmd_exec (...) (...)
#5 0x28acc in main (...) (...)
(gdb)
SHAR_EOF
fi # end of overwriting check
if test -f 'backtrace.2'
then
echo shar: will not over-write existing file "'backtrace.2'"
else
cat << \SHAR_EOF > 'backtrace.2'
(gdb) r bug/bug2
Starting program: /home/reed/olson/perl/perl4 bug/bug2
calling nocrash
doing it
got key foo
got list 1,2,3
exiting
nocrash returns
calling crash
doing it
Program received signal 11, Segmentation fault
0x26784 in hiternext (tb=(struct htbl *) 0x89670) (hash.c line 511)
(gdb) where
#0 0x26784 in hiternext (tb=(struct htbl *) 0x89670) (hash.c line 511)
#1 0x1c088 in do_each (...) (...)
#2 0x1f72c in eval (arg=(struct arg *) 0x8ac50, gimme=1, sp=2) (eval.c line 1042)
#3 0x1c7c4 in eval (arg=(struct arg *) 0x8af58, gimme=0, sp=1) (eval.c line 290)
#4 0x4bd0 in cmd_exec (...) (...)
#5 0xf6f4 in do_subr (...) (...)
#6 0x2050c in eval (arg=(struct arg *) 0x8a7b0, gimme=0, sp=1) (eval.c line 1268)
#7 0x4bd0 in cmd_exec (...) (...)
#8 0x28acc in main (...) (...)
(gdb)
SHAR_EOF
fi # end of overwriting check
if test -f 'backtrace.3'
then
echo shar: will not over-write existing file "'backtrace.3'"
else
cat << \SHAR_EOF > 'backtrace.3'
(gdb) r bug/bug3
Starting program: /home/reed/olson/perl/perl4 bug/bug3
calling nocrash
doing it
got key foo
got list 1,2,3
exiting
nocrash returns
calling crash
doing it
got key foo
Program received signal 11, Segmentation fault
0x52658 in memcpy ()
(gdb) where
#0 0x52658 in memcpy ()
#1 0x1f818 in eval (arg=(struct arg *) 0x8a760, gimme=1, sp=2) (eval.c line 1065)
#2 0x1c7c4 in eval (arg=(struct arg *) 0x8a7a8, gimme=1, sp=2) (eval.c line 290)
#3 0x1c7c4 in eval (arg=(struct arg *) 0x8a898, gimme=1, sp=1) (eval.c line 290)
#4 0x1c7c4 in eval (arg=(struct arg *) 0x8a7d8, gimme=0, sp=0) (eval.c line 290)
#5 0x4bd0 in cmd_exec (...) (...)
#6 0x571c in cmd_exec (...) (...)
#7 0xf6f4 in do_subr (...) (...)
#8 0x2050c in eval (arg=(struct arg *) 0x89f60, gimme=0, sp=1) (eval.c line 1268)
#9 0x4bd0 in cmd_exec (...) (...)
#10 0x28acc in main (...) (...)
(gdb)
SHAR_EOF
fi # end of overwriting check
if test -f 'backtrace.4'
then
echo shar: will not over-write existing file "'backtrace.4'"
else
cat << \SHAR_EOF > 'backtrace.4'
(gdb) r bug/bug4
Starting program: /home/reed/olson/perl/perl4 bug/bug4
calling nocrash
doing it
got key foo
got list 1,2,3
exiting
nocrash returns
calling crash
doing it
got key foo
got list ,,,
exiting
Program received signal 11, Segmentation fault
0x30930 in stab_clear (stab=(struct stab *) 0x893f8) (stab.c line 870)
(gdb) where
#0 0x30930 in stab_clear (stab=(struct stab *) 0x893f8) (stab.c line 870)
#1 0x6090 in restorelist (...) (...)
#2 0xf748 in do_subr (...) (...)
#3 0x2050c in eval (arg=(struct arg *) 0x89eb0, gimme=0, sp=1) (eval.c line 1268)
#4 0x4bd0 in cmd_exec (...) (...)
#5 0x28acc in main (...) (...)
(gdb)
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0
--
Bob Olson University of Illinois at Urbana/Champaign
Internet: rolson@uiuc.edu UUCP: {uunet|convex|pur-ee}!uiucdcs!olson
UIUC NeXT Campus Consultant NeXT mail: olson@fazer.champaign.il.us
"You can't win a game of chess with an action figure!" AMA #522687 DoD #28olson@sax.cs.uiuc.edu (Bob Olson) (03/17/91)
I should qualify my last posting. There is a bug with the while...each
construct *inside* of a subroutine. For example, given
@list = ();
%assoc = ("name", *list);
&foo();
sub foo
{
local(*assoc) = $assoc{"name"};
local($key, *list);
while (($key, *list) = each(%assoc))
{
}
}
perl will segfault on the return from foo in stab_clear().
--bob