Dear All,

This bug took a silly amount of effort to diagnose but once done, the
fix was obvious.

The bug is triggered in this function from the reporter's source file
gfc_graph.F90:

        function GraphIterAppendVertex(this,vertex) result(ierr)
!Appends a new vertex to the graph.
         implicit none
         integer(INTD):: ierr                               !out: error code
         class(graph_iter_t), intent(inout):: this          !inout:
graph iterator
         class(graph_vertex_t), intent(in), target:: vertex !in: new vertex
         type(vert_link_refs_t):: vlr

         ierr=this%vert_it%append(vertex) !<===== right here!
....snip....
         return
        end function GraphIterAppendVertex

'vertex' is being passed to a class(*) dummy. As you will see from the
attached patch and the ChangeLog, 'vertex' was being cast as unlimited
polymorphic and assigned to the passed actual argument. This left the
_len field indeterminate since it is not present in normal (limited?)
polymorphic objects.

Further down the way, in stsubs.F90(clone_object) an allocation is
being made using the unlimited version of 'vertex as a source. Since
the size passed to malloc for an unlimited source is, for  _len > 0,
the value of the _len multiplied by the vtable _size, the amount of
memory is also indeterminate and causes the operating system to flag a
failed allocation, pretty much at random.

The ChangeLog and the patch describe the fix sufficiently well as not
to require further explanation. I will write a testcase that tests the
tree dump for the _len field before committing the patch.

Bootstraps and regtests on FC23/x86_64 - OK for 7- and 8-branches?

If I do not receive any contrary comments, I will commit tonight.

Regards

Paul

2017-10-30  Paul Thomas  <pa...@gcc.gnu.org>

    PR fortran/80850
    * trans_expr.c (gfc_conv_procedure_call): When passing a class
    argument to an unlimited polymorphic dummy, it is wrong to cast
    the passed expression as unlimited, unless it is unlimited. The
    correct way is to assign to each of the fields and set the _len
    field to zero.
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c    (revision 254196)
--- gcc/fortran/trans-expr.c    (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5173,5182 ****
                        }
                      else
                        {
!                         gfc_add_modify (&parmse.pre, var,
!                                         fold_build1_loc (input_location,
!                                                          VIEW_CONVERT_EXPR,
!                                                          type, parmse.expr));
                          parmse.expr = gfc_build_addr_expr (NULL_TREE, var);
                        }
                    }
--- 5173,5198 ----
                        }
                      else
                        {
!                         if (!UNLIMITED_POLY (e) && UNLIMITED_POLY (fsym))
!                           {
!                             tmp = gfc_class_data_get (var);
!                             gfc_add_modify (&parmse.pre, tmp,
!                                             gfc_class_data_get (parmse.expr));
!                             tmp = gfc_class_vptr_get (var);
!                             gfc_add_modify (&parmse.pre, tmp,
!                                             gfc_class_vptr_get (parmse.expr));
!                             tmp = gfc_class_len_get (var);
!                             gfc_add_modify (&parmse.pre, tmp,
!                                             build_int_cst (TREE_TYPE (tmp), 
0));
!                           }
!                         else
!                           {
!                             tmp = fold_build1_loc (input_location,
!                                                    VIEW_CONVERT_EXPR,
!                                                    type, parmse.expr);
!                             gfc_add_modify (&parmse.pre, var, tmp);
!                                             ;
!                           }
                          parmse.expr = gfc_build_addr_expr (NULL_TREE, var);
                        }
                    }

Reply via email to