This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ptach, fortran] PR25818 - Problem with handling optional and entry master arguments


:ADDPATCH fortran:

This patch is adevelopment of one due to Alexander Taeschner.

The problem is that procedures with entries and f77-style assumed shape
arrays need some arithmetic with the array size before the switch on the
entry number.  If the particular entry that is active does not have the
array size as an argument, the inevitable segfault can occur. The fix is
illustrated by the following code produced by the patch:

nran (vector, n)
{
  master.0.nran (0, 0B, n, vector);


nranin (v) { master.0.nran (1, v, 0B, 0B);


master.0.nran (__entry, v, n, vector) { int4 i; int4 ubound.0; int4 size.1; int4 D.1018; bit_size_type D.1019; <unnamed type> D.1020;

  if (vector != 0B)
    {
      ubound.0 = *n;
      size.1 = NON_LVALUE_EXPR <ubound.0>;
      size.1 = size.1 >= 0 ? size.1 : 0;
      D.1018 = size.1 - 1;
      D.1019 = (bit_size_type) (<unnamed type>) size.1 * 32;
      D.1020 = (<unnamed type>) size.1 * 4;
    }
  else
    {
      (void) 0;
    }
  switch (__entry)
    {
      case 0:;
      goto L.2;
      case 1:;
      goto L.4;

It will be seen that vector and n are not present for entry nranin.
Thus, without the if statement, the assinment of *n to ubound.0 could,
and usually did, cause a segfault.  The patch adds the if statement that
prevents this.  The testscase is the reporter's.

Regtested on Cygwin_NT/amd64 - OK for trunk and 4.2?

Paul



2006-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25818
	* trans-array.c	(gfc_trans_g77_array): If the variable is
	optional or not always present, make the statement conditional
	on presence of the argument.
	* gfortran.h : Add symbol_attribute not_always_present.
	* resolve.c (check_argument_lists): New function to check if
	arguments are not present in all entries.
	(resolve_entries): Call check_argument_lists.

2006-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25818
	* gfortran.dg/entry_array_specs_2.f: New test.

Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 120116)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -3753,6 +3753,7 @@
   locus loc;
   tree offset;
   tree tmp;
+  tree stmt;  
   stmtblock_t block;
 
   gfc_get_backend_locus (&loc);
@@ -3782,13 +3783,21 @@
       tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm));
       gfc_add_modify_expr (&block, parm, tmp);
     }
-  tmp = gfc_finish_block (&block);
+  stmt = gfc_finish_block (&block);
 
   gfc_set_backend_locus (&loc);
 
   gfc_start_block (&block);
+
   /* Add the initialization code to the start of the function.  */
-  gfc_add_expr_to_block (&block, tmp);
+
+  if (sym->attr.optional || sym->attr.not_always_present)
+    {
+      tmp = gfc_conv_expr_present (sym);
+      stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
+    }
+  
+  gfc_add_expr_to_block (&block, stmt);
   gfc_add_expr_to_block (&block, body);
 
   return gfc_finish_block (&block);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 120116)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -480,7 +480,7 @@
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
     optional:1, pointer:1, save:1, target:1, value:1, volatile_:1,
-    dummy:1, result:1, assign:1, threadprivate:1;
+    dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
     protected:1,		/* Symbol has been marked as protected.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 120116)
+++ gcc/fortran/resolve.c	(working copy)
@@ -342,6 +342,30 @@
 }
 
 
+/* Flag the arguments that are not present in all entries.  */
+
+static void
+check_argument_lists (gfc_symbol *proc, gfc_formal_arglist *new_args)
+{
+  gfc_formal_arglist *f, *head;
+  head = new_args;
+
+  for (f = proc->formal; f; f = f->next)
+    {
+      for (new_args = head; new_args; new_args = new_args->next)
+	{
+	  if (new_args->sym == f->sym)
+	    break;
+	}
+
+      if (new_args)
+	continue;
+
+      f->sym->attr.not_always_present = 1;
+    }
+}
+
+
 /* Resolve alternate entry points.  If a symbol has multiple entry points we
    create a new master symbol for the main routine, and turn the existing
    symbol into an entry point.  */
@@ -541,6 +565,11 @@
   for (el = ns->entries; el; el = el->next)
     merge_argument_lists (proc, el->sym->formal);
 
+  /* Check the master formal arguments for any that are not
+     present in all entry points.  */
+  for (el = ns->entries; el; el = el->next)
+    check_argument_lists (proc, el->sym->formal);
+
   /* Use the master function for the function body.  */
   ns->proc_name = proc;
 
Index: gcc/testsuite/gfortran.dg/entry_array_specs_2.f
===================================================================
--- gcc/testsuite/gfortran.dg/entry_array_specs_2.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/entry_array_specs_2.f	(revision 0)
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the patch for PR30025, aka 25818, in which the initialization
+! code for the array a, was causing a segfault in runtime for a call
+! to x, since n is missing.
+!
+! COntributed by Elizabeth Yip <elizabeth.l.yip@boeing.com>
+      program test_entry
+      common // j
+      real a(10)
+      a(1) = 999.
+      call x
+      if (j .ne. 1) call abort ()
+      call y(a,10)
+      if (j .ne. 2) call abort ()
+      stop
+      end 
+      subroutine x
+      common // j
+      real a(n)
+      j = 1
+      return
+      entry y(a,n)
+      call foo(a(1))
+      end
+      subroutine foo(a)
+      common // j
+      real a
+      j = 2
+      return
+      end
+


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]