From 493ba8208e0c824a582669ab5ec9c1ed901040d3 Mon Sep 17 00:00:00 2001 From: Louis Krupp Date: Sun, 18 Sep 2016 05:52:23 +0000 Subject: [PATCH] re PR fortran/68078 (segfault with allocate and stat for derived types with default initialization) 2016-09-17 Louis Krupp PR fortran/68078 * gfortran.dg/pr68078.f90: New test. * gfortran.dg/set_vm_limit.c: New, called by pr68078. 2016_09_17 Louis Krupp PR fortran/68078 * resolve.c (resolve_allocate_expr): Check that derived type pointer, object or array has been successfully allocated before initializing. From-SVN: r240219 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/resolve.c | 38 +++++++++++++++----- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/pr68078.f90 | 46 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/set_vm_limit.c | 22 ++++++++++++ 5 files changed, 111 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr68078.f90 create mode 100644 gcc/testsuite/gfortran.dg/set_vm_limit.c diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5954c73f404..611699f3ac2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016_09_17 Louis Krupp + + PR fortran/68078 + * resolve.c (resolve_allocate_expr): Check that derived type + pointer, object or array has been successfully allocated before + initializing. + 2016-09-16 Steven G. Kargl PR fortran/77612 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f8ba00bab82..037c2fe74e0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6928,6 +6928,35 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2) return true; } +static void +cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_expr *init_e) +{ + gfc_code *block; + gfc_expr *cond; + gfc_code *init_st; + gfc_expr *e_to_init = gfc_expr_to_initialize (e); + + cond = pointer + ? gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ASSOCIATED, + "associated", code->loc, 2, gfc_copy_expr (e_to_init), NULL) + : gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ALLOCATED, + "allocated", code->loc, 1, gfc_copy_expr (e_to_init)); + + init_st = gfc_get_code (EXEC_INIT_ASSIGN); + init_st->loc = code->loc; + init_st->expr1 = e_to_init; + init_st->expr2 = init_e; + + block = gfc_get_code (EXEC_IF); + block->loc = code->loc; + block->block = gfc_get_code (EXEC_IF); + block->block->loc = code->loc; + block->block->expr1 = cond; + block->block->next = init_st; + block->next = code->next; + + code->next = block; +} /* Resolve the expression in an ALLOCATE statement, doing the additional checks to see whether the expression is OK or not. The expression must @@ -7193,14 +7222,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) ts = ts.u.derived->components->ts; if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts))) - { - gfc_code *init_st = gfc_get_code (EXEC_INIT_ASSIGN); - init_st->loc = code->loc; - init_st->expr1 = gfc_expr_to_initialize (e); - init_st->expr2 = init_e; - init_st->next = code->next; - code->next = init_st; - } + cond_init (code, e, pointer, init_e); } else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b2bded06ac6..6e65edf6918 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-09-17 Louis Krupp + + PR fortran/68078 + * gfortran.dg/pr68078.f90: New test. + * gfortran.dg/set_vm_limit.c: New, called by pr68078. + 2016-09-16 Bill Schmidt PR target/77613 diff --git a/gcc/testsuite/gfortran.dg/pr68078.f90 b/gcc/testsuite/gfortran.dg/pr68078.f90 new file mode 100644 index 00000000000..4a501840447 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr68078.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! { dg-additional-sources set_vm_limit.c } + +USE :: ISO_C_BINDING !, only: C_INT +IMPLICIT NONE + +INTERFACE + SUBROUTINE set_vm_limit(n) bind(C) + import + integer(C_INT), value, intent(in) :: n + END SUBROUTINE set_vm_limit +END INTERFACE + +TYPE foo + INTEGER, DIMENSION(10000) :: data = 42 +END TYPE +TYPE(foo), POINTER :: foo_ptr +TYPE(foo), ALLOCATABLE :: foo_obj +TYPE(foo), ALLOCATABLE, DIMENSION(:) :: foo_array + +INTEGER istat + +CALL set_vm_limit(1000000) + +DO + ALLOCATE(foo_ptr, stat = istat) + IF (istat .NE. 0) THEN + PRINT *, "foo_ptr allocation failed" + EXIT + ENDIF +ENDDO + +ALLOCATE(foo_obj, stat = istat) +IF (istat .NE. 0) THEN + PRINT *, "foo_obj allocation failed" +ENDIF + +ALLOCATE(foo_array(5), stat = istat) +IF (istat .NE. 0) THEN + PRINT *, "foo_array allocation failed" +ENDIF + +END +! { dg-output " *foo_ptr allocation failed(\n|\r\n|\r)" } +! { dg-output " *foo_obj allocation failed(\n|\r\n|\r)" } +! { dg-output " *foo_array allocation failed(\n|\r\n|\r)" } diff --git a/gcc/testsuite/gfortran.dg/set_vm_limit.c b/gcc/testsuite/gfortran.dg/set_vm_limit.c new file mode 100644 index 00000000000..30c4b43e0ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/set_vm_limit.c @@ -0,0 +1,22 @@ +/* Called by pr68078. */ + +#include +#include +#include +#include + +void +set_vm_limit (int vm_limit) +{ + struct rlimit rl = { vm_limit, RLIM_INFINITY }; + int r; + + r = setrlimit (RLIMIT_AS, &rl); + if (r) + { + perror ("set_vm_limit"); + exit (1); + } + + return; +} -- 2.30.2