Patchwork [Fortran] PR57596 - Fix OPTIONAL handling of deferred-length strings

login
register
mail settings
Submitter Tobias Burnus
Date June 13, 2013, 9:13 a.m.
Message ID <51B98D35.8060800@net-b.de>
Download mbox | patch
Permalink /patch/251018/
State New
Headers show

Comments

Tobias Burnus - June 13, 2013, 9:13 a.m.
A rather simple patch. I wonder why we didn't get in trouble before - 
the "*dummy = NULL;" part should affect also other optional allocatable 
dummy arguments.

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

Tobias

PS: Pending patches:
* Unreviewed: Print exception status at STOP, 
http://gcc.gnu.org/ml/fortran/2013-06/msg00077.html
* Uncommitted: Mikael's CLASS+function patch, 
http://gcc.gnu.org/ml/fortran/2013-06/msg00079.html

PPS: The old dump (GCC 4.8, 4.9 w/o patch should be the same) produced:

get (character(kind=1)[1:(integer(kind=4)) _c_val] * * c_val, 
integer(kind=4) * _c_val)
{
       *c_val = 0B;
...
   finally
     {
       *_c_val = .c_val;
     }
}

and with intent(inout):
       .c_val = *_c_val;
Mikael Morin - June 13, 2013, 9:27 p.m.
Le 13/06/2013 11:13, Tobias Burnus a écrit :
> A rather simple patch. I wonder why we didn't get in trouble before -
> the "*dummy = NULL;" part should affect also other optional allocatable
> dummy arguments.
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
> 
OK; thanks.

Mikael

Patch

2013-06-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/57596
	* trans-decl.c (gfc_trans_deferred_vars): Honor OPTIONAL
	for nullify and deferred-strings' length variable.

2013-06-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/57596
	* gfortran.dg/deferred_type_param_9.f90: New.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 87652ba..300175f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3855,12 +3857,21 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
 		{
 		  /* Nullify when entering the scope.  */
-		  gfc_add_modify (&init, se.expr,
-				  fold_convert (TREE_TYPE (se.expr),
-					        null_pointer_node));
+		  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+					 TREE_TYPE (se.expr), se.expr,
+					 fold_convert (TREE_TYPE (se.expr),
+						       null_pointer_node));
+		  if (sym->attr.optional)
+		    {
+		      tree present = gfc_conv_expr_present (sym);
+		      tmp = build3_loc (input_location, COND_EXPR,
+					void_type_node, present, tmp,
+					build_empty_stmt (input_location));
+		    }
+		  gfc_add_expr_to_block (&init, tmp);
 		}
 
-	      if ((sym->attr.dummy ||sym->attr.result)
+	      if ((sym->attr.dummy || sym->attr.result)
 		    && sym->ts.type == BT_CHARACTER
 		    && sym->ts.deferred)
 		{
@@ -3874,15 +3885,38 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		    gfc_add_modify (&init, sym->ts.u.cl->backend_decl,
 				build_int_cst (gfc_charlen_type_node, 0));
 		  else
-		    gfc_add_modify (&init, sym->ts.u.cl->backend_decl, tmp);
+		    {
+		      tree tmp2;
+
+		      tmp2 = fold_build2_loc (input_location, MODIFY_EXPR,
+					      gfc_charlen_type_node,
+					      sym->ts.u.cl->backend_decl, tmp);
+		      if (sym->attr.optional)
+			{
+			  tree present = gfc_conv_expr_present (sym);
+			  tmp2 = build3_loc (input_location, COND_EXPR,
+					     void_type_node, present, tmp2,
+					     build_empty_stmt (input_location));
+			}
+		      gfc_add_expr_to_block (&init, tmp2);
+		    }
 
 		  gfc_restore_backend_locus (&loc);
 
 		  /* Pass the final character length back.  */
 		  if (sym->attr.intent != INTENT_IN)
-		    tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-					   gfc_charlen_type_node, tmp,
-					   sym->ts.u.cl->backend_decl);
+		    {
+		      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+					     gfc_charlen_type_node, tmp,
+					     sym->ts.u.cl->backend_decl);
+		      if (sym->attr.optional)
+			{
+			  tree present = gfc_conv_expr_present (sym);
+			  tmp = build3_loc (input_location, COND_EXPR,
+					    void_type_node, present, tmp,
+					    build_empty_stmt (input_location));
+			}
+		    }
 		  else
 		    tmp = NULL_TREE;
 		}
--- /dev/null	2013-06-13 09:10:45.615178715 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90	2013-06-13 10:55:51.506836678 +0200
@@ -0,0 +1,22 @@ 
+! { dg-do run }
+!
+! PR fortran/57596
+!
+! Contributed by Valery Weber
+!
+PROGRAM main
+  IMPLICIT NONE
+  call get ()
+  call get2 ()
+contains
+  SUBROUTINE get (c_val)
+    CHARACTER( : ), INTENT( INOUT ), ALLOCATABLE, OPTIONAL :: c_val
+    CHARACTER( 10 ) :: c_val_tmp
+    if(present(c_val)) call abort()
+  END SUBROUTINE get
+  SUBROUTINE get2 (c_val)
+    CHARACTER( : ), INTENT( OUT ), ALLOCATABLE, OPTIONAL :: c_val
+    CHARACTER( 10 ) :: c_val_tmp
+    if(present(c_val)) call abort()
+  END SUBROUTINE get2
+END PROGRAM main