[Bug fortran/61261] [OOP] Segfault on source-allocating polymorphic variables

["jouko.orava at iki dot fi" <gcc-bugzilla at gcc dot gnu dot org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=61261

Jouko Orava <jouko.orava at iki dot fi> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |jouko.orava at iki dot fi

--- Comment #6 from Jouko Orava <jouko.orava at iki dot fi> ---
Confirmed using gfortran 4.8.1 on both x86 (i386) and x86-64 (AMD64).

I suspect the bug is in gcc/fortran/resolve.c:resolve_allocate_expr().
Specifically, that it fails to correctly handle the case where the
allocated object is unlimited polymorphic, and there SOURCE= is
a pointer to a string.

In particular, replacing

    CHARACTER(LEN=80), TARGET :: c80
    c80 = 'the quick brown fox jumps over the lazy dog'
    p => c80

in the example with

    TYPE boxed
        CHARACTER(LEN=80) :: c
    END type boxed
    TYPE(boxed), TARGET :: c
    c%c = 'the quick brown fox jumps over the lazy dog'
    p => c

works. The problem seems to only occur when target is a pointer to
a string (a pointer to a CHARACTER type target).

Unfortunately, I am not familiar enough with the code to discover the
exact problem or fix it.
 _ _ _ _ _

Background and detailed observations:

The root cause of the bug is that the
    ALLOCATE(..., SOURCE=pointer-to-string-target)
expression, where pointer-to-string-target is a pointer to
a target of character type, generates a built-in call to memmove(),
where the length parameter is an uninitialized number taken from stack.

Note, however, that the length used for the allocation itself is correct;
the bug is in initialization, not allocation per se.

This is easy to verify using interpose.c:

    #define _POSIX_C_SOURCE 200112L
    #include <unistd.h>
    #include <stdlib.h>
    #include <stdio.h>
    #include <errno.h>

    static void wrerr(const char *str, const char *const end)
    {
        while (str < end) {
            ssize_t n = write(STDERR_FILENO, str, (size_t)(end - str));
            if (n > (ssize_t)0)
                str += n;
            else
            if (n != (ssize_t)-1 || errno != EINTR)
                return;
        }
    }

    void *malloc(size_t n)
    {
        const size_t size = (n < 16) ? 16 :
                            (n % 16) ? n + 16 - (n % 16) : n;
        void *retval = NULL;
        char msg[128];
        int len, err, saved_errno;

        saved_errno = errno;

        len = snprintf(msg, sizeof msg, "malloc(%lu) = ",
                                        (unsigned long)n);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        err = posix_memalign(&retval, 16, size);

        len = snprintf(msg, sizeof msg, "%p\n", retval);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        if (err) {
            errno = err;
            return NULL;
        }

        errno = saved_errno;
        return retval;
    }

    void *memset(void *dest, int c, size_t n)
    {
        unsigned char *const d = dest;
        char msg[128];
        int  len, saved_errno;

        saved_errno = errno;

        len = snprintf(msg, sizeof msg, "memset(%p, %d, %lu) = ",
                       dest, c, (unsigned long)n);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        while (n-->0)
            d[n] = c;

        len = snprintf(msg, sizeof msg, "%p\n", dest);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        errno = saved_errno;
        return dest;
    }       

    void *memmove(void *dest, const void *src, size_t n)
    {
        unsigned char *const d = dest;
        const unsigned char *const s = src;
        char msg[128];
        int  len, saved_errno;

        saved_errno = errno;

        if (n >= 3)
            len = snprintf(msg, sizeof msg,
                           "memmove(%p, %p = \"%c%c%c\"..., %lu) = ",
                           dest, src, s[0], s[1], s[2], (unsigned long)n);
        else
            len = snprintf(msg, sizeof msg, "memmove(%p, %p, 0x%lx) =",
                           dest, src, (unsigned long)n);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        if (dest < src) {
            size_t i;
            for (i = 0; i < n; i++)
                d[i] = s[i];
        } else
        if (dest > src) {
            size_t i = n;
            while (i-->0)
                d[i] = s[i];
        }

        len = snprintf(msg, sizeof msg, "%p\n", dest);
        if (len > 0 && len < sizeof msg)
            wrerr(msg, msg + len);

        errno = saved_errno;
        return dest;
    }

It interposes malloc(), memset(), and memmove() calls.
The function parameters are always printed first to stderr.
After using an inline version of the function (or calling
posix_memalign() for malloc()), the result is printed,
before returning to the caller. Raw unistd.h I/O is used,
to avoid any call loops or other interference.
(It should work with both Fortran and C code.)

Compiling interpose.c and bug-61261.f90 using
    gcc-4.8 -m32 -Wall interpose.c -c
    gfortran-4.8 -m32 -Wall bug-61261.f90 interpose.o -o bug-61261
and running it,
    ./bug-61261
shows that the program dies with SIGSEGV executing
    malloc(80) = 0x88e8dc0
    memset(0x88e8dc0, 0, 80) = 0x88e8dc0
    memmove(0x88e8dc0, 0xff812960 = "the"..., 1768698482) = 

The allocation is of correct size, and it is even cleared
using the correct size, but the memmove() call has an invalid size!

Using a function that fills stack with specific values, e.g.
    SUBROUTINE dummy(value)
        INTEGER, INTENT(IN) :: value
        INTEGER :: x(1000)
        x = value
        WRITE (*,*) "value = ", x(999)
    END SUBROUTINE
and use e.g.
    CALL dummy(51)
    CALL sub(e1, p)
and again compiling with -m32 the interposed output is
    malloc(80) = 0x87c1dc0
    memset(0x87c1dc0, 0, 80) = 0x87c1dc0
    memmove(0x87c1dc0, 0xfff53ef0 = "the"..., 51) = 0x87c1dc0
and the code does not crash anymore.

Changing the dymmy subroutine parameter changes the length in memmove(),
which IMHO proves that it is used from stack, uninitialized.

IMHO, the above shows that for some reason, the length for the SOURCE=
string is used uninitialized from the stack. The length seems to be
correct for the preceding malloc() call, though.

Finally, using a custom type wrapping the string, i.e.
    TYPE custom
        CHARACTER(LEN=80) :: c80
    END TYPE custom
    TYPE(custom), TARGET :: ct
    CLASS(*), POINTER :: p
    TYPE(element) :: el
    ct%c80 = 'the quick brown fox jumps over the lazy dog'
    p => c
    CALL  sub(el, p)
does not crash. However, instead of a memmove() call, a special
__copy_x_Custom function, defined in the vtab for the custom type,
is emitted and used in the binary. (It uses the correct length, too.)

Although I used 32-bit code for the above, the 64-bit results
are similar, except that the length parameter supplied to memmove()
is much more difficult to control; it tends to be equal to the target pointer
value (or in some cases a return address from some previous call).

In summary, ALLOCATE(unlimited-polymorphic-object, SOURCE=string)
allocates the correct size, but initializes the allocated object
using incorrect/undefined/uninitialized length.

Hopefully the above will help one of the gfortran developers
to pinpoint the exact bug, and fix it.

Apologies for the mailing list members for an overlong message.