re PR fortran/68078 (segfault with allocate and stat for derived types with default...

2016-09-17  Louis Krupp  <louis.krupp@gmail.com>

	PR fortran/68078
	* gfortran.dg/pr68078.f90: New test.
	* gfortran.dg/set_vm_limit.c: New, called by pr68078.

2016_09_17  Louis Krupp  <louis.krupp@zoho.com>

	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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5954c73f4047a3e23bdb00f1601669ef23f5a3e0..611699f3ac2efcefd479a111947a82b040b9e1d8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016_09_17  Louis Krupp  <louis.krupp@zoho.com>
+
+       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  <kargl@gcc.gnu.org>
 
        PR fortran/77612

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f8ba00bab82ccabccae6e183400d4c089e6c9b4a..037c2fe74e0f2b519e0943ba4aa37e1ec9a4dfd0 100644 (file)
--- 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 b2bded06ac6ef777bc64c3bdc06dd013c88388e8..6e65edf69186e123159be4648d7813057759f644 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-09-17  Louis Krupp  <louis.krupp@gmail.com>
+
+       PR fortran/68078
+       * gfortran.dg/pr68078.f90: New test.
+       * gfortran.dg/set_vm_limit.c: New, called by pr68078.
+
 2016-09-16  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
        PR target/77613

diff --git a/gcc/testsuite/gfortran.dg/pr68078.f90 b/gcc/testsuite/gfortran.dg/pr68078.f90
new file mode 100644 (file)
index 0000000..4a50184
--- /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 (file)
index 0000000..30c4b43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/set_vm_limit.c
@@ -0,0 +1,22 @@
+/* Called by pr68078. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+
+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;
+}