re PR fortran/57596 (Wrong code for allocatable deferred-length strings)

2013-06-14  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-14  Tobias Burnus  <burnus@net-b.de>

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

From-SVN: r200084

gcc/fortran/ChangeLog

+2013-06-14  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  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/49074

gcc/fortran/trans-decl.c

@@ -3855,12 +3855,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 +3883,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;
 		}

gcc/testsuite/ChangeLog

+2013-06-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57596
+	* gfortran.dg/deferred_type_param_9.f90: New.
+
 2013-06-13  Marc Glisse  <marc.glisse@inria.fr>
 
 	* gcc.dg/fold-minus-1.c: New testcase.

gcc/testsuite/gfortran.dg/deferred_type_param_9.f90

+! { 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