From: jfriedl+@cs.cmu.edu (Jeffrey E. F. Friedl)
Newsgroups: comp.lang.perl
Subject: array bug (not infinite recursion)
Date: 16 Aug 92 20:17:00 GMT
Article-I.D.: cs.Bt3F0D.G3K.1
Reply-To: jfriedl@cs.cmu.edu
Organization: Carnegie Mellon / Omron Corporation

I wrote:

|> The following (contrived) program dumps core with 4.035
|> 
|> 	&foo;
|> 	sub foo {
|> 	    ($a, $b) = &foo('fi','b');
|> 	}
|> 
|> I've run it (and had the problem) on Sun 3, Sun 4, IBM-RT,
|> Pmax, Vax, and Luna/88k.

Ok,ok, I guess I should have been more verbose and not assumed I would
be taken for a two-year-old (no, even a two-year old knows infinite
recursion is a no-no :-)  I made the mistake of assuming the perl.gods would
actually try the program.  The number of patronizing messages in my mail
box that said "Jeffy, maybe infinite recursion isn't such a hot idea"
indicates that my assumption was a poor one.

Perl dumps core before &foo is called a 2nd time (i.e. before it is
called even once recursively).

It seems to die when it's trying to save local variables. There are none,
so some pointer is zero. This pointer isn't being checked before being
dereferenced [see code snippet at end of message].  I don't have enough
of a global understanding of the internals to know exactly what's wrong
(i.e. that the pointer isn't being checked, or that it shouldn't be null
to begin with).

See the script below for a -D14 run with gdb trace.

The following is a more politically correct example:

	&foo;
	sub foo {
		($a, $b) = &foo('','') if $depth++ == 0;
	}

*jeff*

--------------------------------------------------------------

Script started on Sun Aug 16 15:40:19 1992
SHELL> cat foo
&foo;
sub foo {
	($a, $b) = &foo('','');
}
SHELL> gdb ./perl
GDB 3.4, Copyright (C) 1989 Free Software Foundation, Inc.
Omron Version 1.0, August 1, 1990.
There is ABSOLUTELY NO WARRANTY for GDB; type "info warranty" for details.
GDB is free software and you are welcome to distribute copies of it
 under certain conditions; type "info copying" to see the conditions.
Reading symbol data from /afs/cs.cmu.edu/misc/perl/build/src/perl-4.035/perl...done.
Type "help" for a list of commands.
(gdb) run -D14 foo
Starting program: /afs/cs.cmu.edu/misc/perl/build/src/perl-4.035/perl -D14 foo

EXECUTING...

5   mortals = (-1/-1) stack, = (-1/-1)
1   EXPR	(8a9c0)	r8a940	t0	a0	n0	cs0
1   E! SUBR (8a940) 2 args:
1   E! S: 1.NULL = ''
1   E! S: 2.NULL = ''
1   E! S: mortals = (-1/-1) stack, = (0/0)
3   E! S: EXPR	(8aec0)	r8ae80	t0	a0	n0	cs0
3   E! S: E! ASSIGN (8ae80) 2 args:
3   E! S: E! A: 1.LEXPR =>
3   E! S: E! A: LIST (8ad00) 2 args:
3   E! S: E! A: L: 1.LVAL $a = ''
3   E! S: E! A: L: 2.LVAL $b = ''
3   E! S: E! A: LIST RETURNS 2 ARGS ("","")
3   E! S: E! A: 1.LEXPR = ''
3   E! S: E! A: 2.EXPR =>
3   E! S: E! A: SUBR (8ae40) 2 args:
3   E! S: E! A: S: 1.NULL = ''
3   E! S: E! A: S: 2.EXPR =>
3   E! S: E! A: S: LIST (8adc0) 2 args:
3   E! S: E! A: S: L: 1.SINGLE = ''
3   E! S: E! A: S: L: 2.SINGLE = ''
3   E! S: E! A: S: LIST RETURNS 2 ARGS ("","")
3   E! S: E! A: S: 2.EXPR = ''
Reading in symbols for cmd.c...done.

Program received signal 10, Bus error
0x3054 in savelist (sarg=(struct string **) 0x0, maxsarg=3) (cmd.c line 1165)
1165	}
(gdb) where
#0  0x3054 in savelist (sarg=(struct string **) 0x0, maxsarg=3) (cmd.c line 1165)
Reading in symbols for doarg.c...done.
#1  0xb998 in do_subr (arg=(struct arg *) 0x8ae40, gimme=1, arglast=(int *) 0xffbff2a0) (doarg.c line 1156)
Reading in symbols for eval.c...done.
#2  0x1b310 in eval (arg=(struct arg *) 0x8ae40, gimme=1, sp=393216) (eval.c line 1286)
#3  0x174b8 in eval (arg=(struct arg *) 0x8ae80, gimme=0, sp=393216) (eval.c line 162)
#4  0x1f40 in cmd_exec (cmdparm=(struct cmd *) 0x8aec0, gimme=0, sp=-1) (cmd.c line 654)
#5  0xb9a8 in do_subr (arg=(struct arg *) 0x8ae40, gimme=1, arglast=(int *) 0xffbff2a0) (doarg.c line 1158)
#6  0x1b310 in eval (arg=(struct arg *) 0x8a940, gimme=0, sp=393216) (eval.c line 1286)
#7  0x1f40 in cmd_exec (cmdparm=(struct cmd *) 0x8a9c0, gimme=0, sp=-1) (cmd.c line 654)
Reading in symbols for perl.c...done.
#8  0x21c34 in main (argc=2, argv=(char **) 0x60000, env=(char **) 0x1) (perl.c line 890)
#9  0x98 in start ()
(gdb) quit
The program is running.  Quit anyway? (y or n) y
SHELL> exit

script done on Sun Aug 16 15:41:27 1992

The damage seems to be in doarg.c (do_subr):

        sub->depth++;
        if (sub->depth >= 2) {  /* save temporaries on recursion? */
            if (sub->depth == 100 && dowarn)
                warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
            savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
        }

That sub->tosave->ary_array in the last line is null.
Newsgroups: comp.lang.perl