Possible patch for fortran/68078

Possible patch for fortran/68078

[Louis Krupp]

[-- Attachment #1: Type: text/plain, Size: 321 bytes --]

Verify that allocation was successful before assigning default initialization values to components of the allocated object (or array of objects or pointer to an object).   The change could probably have been made while parsing or at translation.  This patch does it in the resolution phase.  It seemed like a good idea.


[-- Attachment #2: patch.txt --]
[-- Type: text/plain, Size: 4719 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(revision 240152)
+++ gcc/fortran/ChangeLog	(working copy)
@@ -1,3 +1,10 @@
+2016_09_14  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-14  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
 	* simplify.c (gfc_simplify_repeat): Fix a misplaced closing ')'.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 240152)
+++ gcc/fortran/resolve.c	(working copy)
@@ -6928,7 +6928,34 @@ 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->block = gfc_get_code (EXEC_IF);
+  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
    have a trailing array reference that gives the size of the array.  */
@@ -7193,14 +7220,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code
 	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)
     {
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(revision 240152)
+++ gcc/testsuite/ChangeLog	(working copy)
@@ -1,3 +1,9 @@
+2016-09-14  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-14  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/77549
Index: gcc/testsuite/gfortran.dg/pr68078.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68078.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68078.f90	(working copy)
@@ -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)" }
Index: gcc/testsuite/gfortran.dg/set_vm_limit.c
===================================================================
--- gcc/testsuite/gfortran.dg/set_vm_limit.c	(nonexistent)
+++ gcc/testsuite/gfortran.dg/set_vm_limit.c	(working copy)
@@ -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;
+}

Re: Possible patch for fortran/68078

[Fritz Reese]

It might be worth filling in the right locations for the new blocks (?):

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
@@ -7048,7 +7048,9 @@ cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_e
   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;


Minor nit, trailing whitespace:

--- gcc/fortran/resolve.c       (revision 240152)
+++ gcc/fortran/resolve.c       (working copy)
...
+  block->block->expr1 = cond;
+  block->block->next = init_st;
+  block->next = code->next;
+  <<<<< Trailing whitespace.
+  code->next = block;

Otherwise it looks fine to me. So long as the system(s) to test
support(s) setrlimit() (which should be true for POSIX systems).

---
Fritz Reese

(P.S. I can't officially approve the patch, I'm just providing feedback.)

On Thu, Sep 15, 2016 at 2:11 AM, Louis Krupp <louis.krupp@zoho.com> wrote:
> Verify that allocation was successful before assigning default initialization values to components of the allocated object (or array of > objects or pointer to an object).   The change could probably have been made while parsing or at translation.  This patch does it in > the resolution phase.  It seemed like a good idea.
>

Re: Possible patch for fortran/68078

[Louis Krupp]

[-- Attachment #1: Type: text/plain, Size: 1883 bytes --]

Thanks!

I've been running vi, and if there's nothing but spaces on a line, it acts as if the last space isn't there.   I don't know if this is a new "feature" or something I've just noticed.  vim does the same thing.

I've attached an updated patch.

Louis


 ---- On Thu, 15 Sep 2016 05:49:17 -0700 Fritz Reese <fritzoreese@gmail.com> wrote ---- 
 > It might be worth filling in the right locations for the new blocks (?): 
 >  
 > diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c 
 > @@ -7048,7 +7048,9 @@ cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_e 
 >    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; 
 >  
 >  
 > Minor nit, trailing whitespace: 
 >  
 > --- gcc/fortran/resolve.c       (revision 240152) 
 > +++ gcc/fortran/resolve.c       (working copy) 
 > ... 
 > +  block->block->expr1 = cond; 
 > +  block->block->next = init_st; 
 > +  block->next = code->next; 
 > +  <<<<< Trailing whitespace. 
 > +  code->next = block; 
 >  
 > Otherwise it looks fine to me. So long as the system(s) to test 
 > support(s) setrlimit() (which should be true for POSIX systems). 
 >  
 > --- 
 > Fritz Reese 
 >  
 > (P.S. I can't officially approve the patch, I'm just providing feedback.) 
 >  
 > On Thu, Sep 15, 2016 at 2:11 AM, Louis Krupp <louis.krupp@zoho.com> wrote: 
 > > Verify that allocation was successful before assigning default initialization values to components of the allocated object (or array of > objects or pointer to an object).   The change could probably have been made while parsing or at translation.  This patch does it in > the resolution phase.  It seemed like a good idea. 
 > > 
 > 

[-- Attachment #2: patch.txt --]
[-- Type: text/plain, Size: 4883 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(revision 240166)
+++ gcc/fortran/ChangeLog	(working copy)
@@ -1,3 +1,10 @@
+2016_09_14  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-14  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
 	* simplify.c (gfc_simplify_repeat): Fix a misplaced closing ')'.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 240166)
+++ gcc/fortran/resolve.c	(working copy)
@@ -6928,7 +6928,36 @@ 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
    have a trailing array reference that gives the size of the array.  */
@@ -7193,14 +7222,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code
 	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)
     {
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(revision 240153)
+++ gcc/testsuite/ChangeLog	(working copy)
@@ -1,7 +1,8 @@
-2016-09-15  Richard Biener  <rguenther@suse.de>
+2016-09-14  Louis Krupp  <louis.krupp@gmail.com>
 
-	PR tree-optimization/77514
-	* gcc.dg/torture/pr77514.c: New testcase.
+	PR fortran/68078
+	* gfortran.dg/pr68078.f90: New test.
+	* gfortran.dg/set_vm_limit.c: New, called by pr68078.
 
 2016-09-14  Jakub Jelinek  <jakub@redhat.com>
 
Index: gcc/testsuite/gfortran.dg/pr68078.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68078.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68078.f90	(working copy)
@@ -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)" }
Index: gcc/testsuite/gfortran.dg/set_vm_limit.c
===================================================================
--- gcc/testsuite/gfortran.dg/set_vm_limit.c	(nonexistent)
+++ gcc/testsuite/gfortran.dg/set_vm_limit.c	(working copy)
@@ -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;
+}

Re: Possible patch for fortran/68078

[Steve Kargl]

On Thu, Sep 15, 2016 at 11:12:05AM -0700, Louis Krupp wrote:
>
> I've attached an updated patch.
> 
> Louis
> 

Patch looks ok to me.

-- 
Steve