[Bug fortran/55072] [4.5/4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type

["burnus at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55072

Tobias Burnus <burnus at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |burnus at gcc dot gnu.org,
                   |                            |janus at gcc dot gnu.org,
                   |                            |pault at gcc dot gnu.org
   Target Milestone|---                         |4.6.4

--- Comment #1 from Tobias Burnus <burnus at gcc dot gnu.org> 2012-10-25 09:30:30 UTC ---
The issue seems to be the following in trans-array.c's
gfc_conv_array_parameter:

  ultimate_ptr_comp = false;
...
  for (ref = expr->ref; ref; ref = ref->next)
    {
      if (ref->next == NULL)
        break;

      if (ref->type == REF_COMPONENT)
        {
          ultimate_ptr_comp = ref->u.c.component->attr.pointer;
          ultimate_alloc_comp = ref->u.c.component->attr.allocatable;
        }
    }
...
  if (expr->expr_type == EXPR_VARIABLE && ref && !ultimate_ptr_comp)
    full_array_var = gfc_full_array_ref_p (ref, &contiguous);

where "ref" is:
(gdb) p expr->ref->type 
$6 = REF_ARRAY
(gdb) p expr->ref->u.ar.type 
$7 = AR_FULL



Possibly patch. I think it needs some audit whether ultimate_alloc_comp  has to
be handled as well and whether other BT_CLASS updates are required as well
further down.

--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6957,6 +6957,11 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
   ultimate_ptr_comp = false;
   ultimate_alloc_comp = false;

+  if (expr->symtree)
+    ultimate_ptr_comp = expr->symtree->n.sym->ts.type == BT_CLASS
+                       ? CLASS_DATA (expr->symtree->n.sym)->attr.class_pointer
+                       : expr->symtree->n.sym->attr.pointer;
+
   for (ref = expr->ref; ref; ref = ref->next)
     {
       if (ref->next == NULL)