re PR fortran/54599 (Issues found in gfortran by the Coverity Scan)

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

        * parse.c (parse_derived): Don't set attr.alloc_comp
        for pointer components with allocatable subcomps.

        PR fortran/54599
        * resolve.c (resolve_fl_namelist): Remove superfluous
        NULL check.
        * simplify.c (simplify_min_max): Remove unreachable code.
        * trans-array.c (gfc_trans_create_temp_array): Change
        a condition into an assert.

        PR fortran/54618
        * trans-expr.c (gfc_trans_class_init_assign): Guard
        re-setting of the _data by gfc_conv_expr_present.
        (gfc_conv_procedure_call): Fix INTENT(OUT) handling
        for allocatable BT_CLASS.

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

        PR fortran/54618
        * gfortran.dg/class_array_14.f90: New.

From-SVN: r191649

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 983d305419d1ff9b6951a919571751a5d7a16fb7..1be83d418b25207cf924d28ef225b671a4ce138a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2012-09-23  Tobias Burnus  <burnus@net-b.de>
+
+       * parse.c (parse_derived): Don't set attr.alloc_comp
+       for pointer components with allocatable subcomps.
+
+       PR fortran/54599
+       * resolve.c (resolve_fl_namelist): Remove superfluous
+       NULL check.
+       * simplify.c (simplify_min_max): Remove unreachable code.
+       * trans-array.c (gfc_trans_create_temp_array): Change
+       a condition into an assert.
+
+       PR fortran/54618
+       * trans-expr.c (gfc_trans_class_init_assign): Guard
+       re-setting of the _data by gfc_conv_expr_present.
+       (gfc_conv_procedure_call): Fix INTENT(OUT) handling
+       for allocatable BT_CLASS.
+
 2012-09-22  Thomas König  <tkoenig@gcc.gnu.org>
 
        PR fortran/54599

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 5c5d38176c370fdb5a17e2738c1923ff18087657..f31e30940b8ee655b14f8d2327627a544a69e407 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2195,7 +2195,8 @@ endType:
       if (c->attr.allocatable
          || (c->ts.type == BT_CLASS && c->attr.class_ok
              && CLASS_DATA (c)->attr.allocatable)
-         || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
+         || (c->ts.type == BT_DERIVED && !c->attr.pointer
+             && c->ts.u.derived->attr.alloc_comp))
        {
          allocatable = true;
          sym->attr.alloc_comp = 1;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f67c07f8b7b987f399c8426d77c1a7ae444d2a04..0a20540b6da765098d6f7850c4082e076c81186f 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12478,7 +12478,7 @@ resolve_fl_namelist (gfc_symbol *sym)
          continue;
 
       nlsym = NULL;
-      if (nl->sym && nl->sym->name)
+      if (nl->sym->name)
        gfc_find_symbol (nl->sym->name, sym->ns, 1, &nlsym);
       if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
        {

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 1c9dff23410e8d0f880b718fc6b8910ac4c4f4bb..2f96e900bf1b20a385090573a526b48ba7b8e842 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4106,10 +4106,7 @@ simplify_min_max (gfc_expr *expr, int sign)
       min_max_choose (arg->expr, extremum->expr, sign);
 
       /* Delete the extra constant argument.  */
-      if (last == NULL)
-       expr->value.function.actual = arg->next;
-      else
-       last->next = arg->next;
+      last->next = arg->next;
 
       arg->next = NULL;
       gfc_free_actual_arglist (arg);

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c350c3b5e3abde81b7e5501ffd270037d4f08c53..3e684ee66495145892f146cf7beeee0489fd5579 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1022,8 +1022,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
      dynamic type.  Generate an eltype and then the class expression.  */
   if (eltype == NULL_TREE && initial)
     {
-      if (POINTER_TYPE_P (TREE_TYPE (initial)))
-       class_expr = build_fold_indirect_ref_loc (input_location, initial);
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (initial)));
+      class_expr = build_fold_indirect_ref_loc (input_location, initial);
       eltype = TREE_TYPE (class_expr);
       eltype = gfc_get_element_type (eltype);
       /* Obtain the structure (class) expression.  */

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 98634c3e13f7e98b41daf00704a116cebd41c33d..177d2865b81a70fdcd5a0084271e316bbdf5d0fa 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -621,6 +621,16 @@ gfc_trans_class_init_assign (gfc_code *code)
       gfc_add_block_to_block (&block, &src.pre);
       tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
     }
+
+  if (code->expr1->symtree->n.sym->attr.optional
+      || code->expr1->symtree->n.sym->ns->proc_name->attr.entry_master)
+    {
+      tree present = gfc_conv_expr_present (code->expr1->symtree->n.sym);
+      tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+                       present, tmp,
+                       build_empty_stmt (input_location));
+    }
+
   gfc_add_expr_to_block (&block, tmp);
   
   return gfc_finish_block (&block);
@@ -3905,22 +3915,42 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
                  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is 
                     allocated on entry, it must be deallocated.  */
-                 if (fsym && fsym->attr.allocatable
-                     && fsym->attr.intent == INTENT_OUT)
+                 if (fsym && fsym->attr.intent == INTENT_OUT
+                     && (fsym->attr.allocatable
+                         || (fsym->ts.type == BT_CLASS
+                             && CLASS_DATA (e)->attr.allocatable)))
                    {
                      stmtblock_t block;
+                     tree ptr;
 
                      gfc_init_block  (&block);
-                     tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE,
+                     ptr = parmse.expr;
+                     if (e->ts.type == BT_CLASS)
+                       ptr = gfc_class_data_get (ptr); 
+
+                     tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
                                                        NULL_TREE, NULL_TREE,
                                                        NULL_TREE, true, NULL,
                                                        false);
                      gfc_add_expr_to_block (&block, tmp);
                      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-                                            void_type_node, parmse.expr,
+                                            void_type_node, ptr,
                                             null_pointer_node);
                      gfc_add_expr_to_block (&block, tmp);
 
+                     if (fsym->ts.type == BT_CLASS)
+                       {
+                         gfc_symbol *vtab;
+                         gcc_assert (fsym->ts.u.derived == e->ts.u.derived);
+                         vtab = gfc_find_derived_vtab (fsym->ts.u.derived);
+                         tmp = gfc_get_symbol_decl (vtab);
+                         tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+                         ptr = gfc_class_vptr_get (parmse.expr);
+                         gfc_add_modify (&block, ptr,
+                                         fold_convert (TREE_TYPE (ptr), tmp));
+                         gfc_add_expr_to_block (&block, tmp);
+                       }
+
                      if (fsym->attr.optional
                          && e->expr_type == EXPR_VARIABLE
                          && e->symtree->n.sym->attr.optional)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3f842da74694fe1d6cb257bf32d2b6854dba353b..7b18d9906308bec4242fb7e77e21c6cf7a28cffa 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-09-2323  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/54618
+       * gfortran.dg/class_array_14.f90: New.
+
 2012-09-22  Kai Tietz  <ktietz@redhat.com>
 
        * gcc.dg/tree-ssa/scev-3.c: Add llp64 to xfail.

diff --git a/gcc/testsuite/gfortran.dg/class_array_14.f90 b/gcc/testsuite/gfortran.dg/class_array_14.f90
new file mode 100644 (file)
index 0000000..ad227a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_array_14.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/54618
+!
+! Check whether default initialization works with INTENT(OUT)
+! and ALLOCATABLE and no segfault occurs with OPTIONAL.
+!
+
+subroutine test1()
+  type typ1
+    integer :: i = 6
+  end type typ1
+
+  type(typ1) :: x
+
+  x%i = 77
+  call f(x)
+  if (x%i /= 6) call abort ()
+  call f()
+contains
+  subroutine f(y1)
+    class(typ1), intent(out), optional :: y1
+  end subroutine f
+end subroutine test1
+
+subroutine test2()
+  type mytype
+  end type mytype
+  type, extends(mytype):: mytype2
+  end type mytype2
+
+  class(mytype), allocatable :: x,y
+  allocate (mytype2 :: x)
+  call g(x)
+  if (allocated (x) .or. .not. same_type_as (x,y)) call abort()
+
+  allocate (mytype2 :: x)
+  call h(x)
+  if (allocated (x) .or. .not. same_type_as (x,y)) call abort()
+
+  call h()
+contains
+  subroutine g(y2)
+    class(mytype), intent(out), allocatable :: y2
+  end subroutine g
+  subroutine h(y3)
+    class(mytype), optional, intent(out), allocatable :: y3
+  end subroutine h
+end subroutine test2
+
+call test1()
+call test2()
+end