Re: [PATCH] Fix PR40005

[Richard Guenther <rguenther at suse dot de>]

On Sat, 25 Jul 2009, Tobias Burnus wrote:

> Richard Guenther schrieb:
> > Bootstrap and regtest running on x86_64-unknown-linux-gnu, ok for trunk?
> >   
> OK - but you might want to fill in the "()" in the ChangeLog.

It didn't quite work - we fold_convert array descriptors which only
worked because they all had the same TYPE_MAIN_VARIANT.  The following
is an adjusted version that doesn't do this.

Bootstrapped on x86_64-unknown-linux-gnu, testing in progress.

Ok?

Thanks,
Richard.

2009-07-25  Richard Guenther  <rguenther@suse.de>

	PR fortran/40005
	* trans-types.c (gfc_get_array_type_bounds): Use
	build_distinct_type_copy with a proper TYPE_CANONICAL and
	re-use the type-decl of the original type.
	* trans-decl.c (build_entry_thunks): Signal cgraph we may not
	garbage collect.
	(create_main_function): Likewise.
	(gfc_generate_function_code): Likewise.
	* trans-expr.c (gfc_trans_subcomponent_assign): Do not use
	fold_convert on record types.

Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c	(revision 150077)
--- gcc/fortran/trans-types.c	(working copy)
*************** gfc_get_array_type_bounds (tree etype, i
*** 1602,1608 ****
    int n;
  
    base_type = gfc_get_array_descriptor_base (dimen);
!   fat_type = build_variant_type_copy (base_type);
  
    tmp = TYPE_NAME (etype);
    if (tmp && TREE_CODE (tmp) == TYPE_DECL)
--- 1602,1610 ----
    int n;
  
    base_type = gfc_get_array_descriptor_base (dimen);
!   fat_type = build_distinct_type_copy (base_type);
!   TYPE_CANONICAL (fat_type) = base_type;
!   TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
  
    tmp = TYPE_NAME (etype);
    if (tmp && TREE_CODE (tmp) == TYPE_DECL)
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 150077)
--- gcc/fortran/trans-decl.c	(working copy)
*************** build_entry_thunks (gfc_namespace * ns)
*** 2032,2038 ****
  
        current_function_decl = NULL_TREE;
  
!       cgraph_finalize_function (thunk_fndecl, false);
  
        /* We share the symbols in the formal argument list with other entry
  	 points and the master function.  Clear them so that they are
--- 2032,2038 ----
  
        current_function_decl = NULL_TREE;
  
!       cgraph_finalize_function (thunk_fndecl, true);
  
        /* We share the symbols in the formal argument list with other entry
  	 points and the master function.  Clear them so that they are
*************** create_main_function (tree fndecl)
*** 4114,4120 ****
    /* Output the GENERIC tree.  */
    dump_function (TDI_original, ftn_main);
  
!   cgraph_finalize_function (ftn_main, false);
  
    if (old_context)
      {
--- 4114,4120 ----
    /* Output the GENERIC tree.  */
    dump_function (TDI_original, ftn_main);
  
!   cgraph_finalize_function (ftn_main, true);
  
    if (old_context)
      {
*************** gfc_generate_function_code (gfc_namespac
*** 4385,4391 ****
         added to our parent's nested function list.  */
      (void) cgraph_node (fndecl);
    else
!     cgraph_finalize_function (fndecl, false);
  
    gfc_trans_use_stmts (ns);
    gfc_traverse_ns (ns, gfc_emit_parameter_debug_info);
--- 4385,4391 ----
         added to our parent's nested function list.  */
      (void) cgraph_node (fndecl);
    else
!     cgraph_finalize_function (fndecl, true);
  
    gfc_trans_use_stmts (ns);
    gfc_traverse_ns (ns, gfc_emit_parameter_debug_info);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 150077)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_trans_subcomponent_assign (tree dest
*** 3763,3771 ****
  	  se.want_pointer = 0;
  	  gfc_conv_expr_descriptor (&se, expr, rss);
  	  gfc_add_block_to_block (&block, &se.pre);
! 
! 	  tmp = fold_convert (TREE_TYPE (dest), se.expr);
! 	  gfc_add_modify (&block, dest, tmp);
  
  	  if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
  	    tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
--- 3763,3769 ----
  	  se.want_pointer = 0;
  	  gfc_conv_expr_descriptor (&se, expr, rss);
  	  gfc_add_block_to_block (&block, &se.pre);
! 	  gfc_add_modify (&block, dest, se.expr);
  
  	  if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
  	    tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,