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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@200084 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cd491a0..07ab220 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 87652ba..f04ebdc 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/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;
                }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 39580f7..0d4c54e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90
new file mode 100644 (file)
index 0000000..a6e6857
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90
@@ -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