This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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]

[Patch, Fortran] PR 51758 - fix ICE with null() in elemental procedures


The issue was discovered when looking at the optional + elemental + scalarizer issue (PR 50981, 4.4-4.7 regression). However, the example of this PR never worked. Passing null() to denote an absent argument (for nonallocatable/nonpointer dummies) is a Fortran 2008 / GCC 4.6 feature.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
2012-01-09  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51758
	* trans-expr (gfc_conv_procedure_call): Handle EXPR_NULL
	in a scalarized loop.

2012-01-09  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51758
	* gfortran.dg/optional_absent_2.f90: New.

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 182995)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -3408,6 +3408,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
 	  parmse.expr = null_pointer_node;
 	  if (arg->missing_arg_type == BT_CHARACTER)
 	    parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
+	  if (se->ss && (se->ss->info->type == GFC_SS_SCALAR
+			 || se->ss->info->type == GFC_SS_REFERENCE))
+	    gfc_advance_se_ss_chain (se);
 	}
       else if (fsym && fsym->ts.type == BT_CLASS
 		 && e->ts.type == BT_DERIVED)
Index: gcc/testsuite/gfortran.dg/optional_absent_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/optional_absent_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/optional_absent_2.f90	(working copy)
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/51758
+!
+! Contributed by Mikael Morin
+!
+! Check whether passing NULL() to an elemental procedure works,
+! where NULL() denotes an absent optional argument.
+!
+program p
+
+  integer :: a(2)
+  integer :: b
+
+  a = 0
+  a = foo((/ 1, 1 /), null())
+!  print *, a
+  if (any(a /= 2)) call abort
+
+  a = 0
+  a = bar((/ 1, 1 /), null())
+!  print *, a
+  if (any(a /= 2)) call abort
+
+ b = 0
+ b = bar(1, null())
+! print *, b
+ if (b /= 2) call abort
+
+contains
+
+  function foo(a, b)
+    integer           :: a(:)
+    integer, optional :: b(:)
+    integer           :: foo(size(a))
+
+    if (present(b)) call abort
+
+    foo = 2
+  end function foo
+
+  elemental function bar(a, b)
+    integer, intent(in)           :: a
+    integer, intent(in), optional :: b
+    integer                       :: bar
+
+    bar = 2
+
+    if (present(b)) bar = 1
+
+  end function bar
+
+end program p

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