2010-02-20 Paul Thomas <pault@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index ae39aed..2ea978d 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5459,7 +5459,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size)
 /* TODO: Optimize passing g77 arrays.  */
 
 void
 /* TODO: Optimize passing g77 arrays.  */
 
 void

-gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
+gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,

                          const gfc_symbol *fsym, const char *proc_name,
                          tree *size)
 {
                          const gfc_symbol *fsym, const char *proc_name,
                          tree *size)
 {


@@ -5471,6 +5471,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
   bool full_array_var;
   bool this_array_result;
   bool contiguous;
   bool full_array_var;
   bool this_array_result;
   bool contiguous;

+  bool no_pack;

   gfc_symbol *sym;
   stmtblock_t block;
   gfc_ref *ref;
   gfc_symbol *sym;
   stmtblock_t block;
   gfc_ref *ref;


@@ -5519,8 +5520,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
          return;
        }
 
          return;
        }
 

-      if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
-          && !sym->attr.allocatable)
+      if (!sym->attr.pointer
+           && sym->as
+           && sym->as->type != AS_ASSUMED_SHAPE 
+            && !sym->attr.allocatable)

         {
          /* Some variables are declared directly, others are declared as
             pointers and allocated on the heap.  */
         {
          /* Some variables are declared directly, others are declared as
             pointers and allocated on the heap.  */


@@ -5547,8 +5550,32 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
         }
     }
 
         }
     }
 

-  if (contiguous && g77 && !this_array_result
-       && !expr->symtree->n.sym->attr.dummy)
+  /* There is no need to pack and unpack the array, if it is an array
+     constructor or contiguous and not deferred or assumed shape.  */
+  no_pack = ((sym && sym->as
+                 && !sym->attr.pointer
+                 && sym->as->type != AS_DEFERRED
+                 && sym->as->type != AS_ASSUMED_SHAPE)
+                     ||
+            (ref && ref->u.ar.as
+                 && ref->u.ar.as->type != AS_DEFERRED
+                 && ref->u.ar.as->type != AS_ASSUMED_SHAPE));
+
+  no_pack = g77 && !this_array_result
+               && (expr->expr_type == EXPR_ARRAY || (contiguous && no_pack));
+
+  if (no_pack)
+    {
+      gfc_conv_expr_descriptor (se, expr, ss);
+      if (expr->ts.type == BT_CHARACTER)
+       se->string_length = expr->ts.u.cl->backend_decl;
+      if (size)
+       array_parameter_size (se->expr, expr, size);
+      se->expr = gfc_conv_array_data (se->expr);
+      return;
+    }
+
+  if (expr->expr_type == EXPR_ARRAY && g77)

     {
       gfc_conv_expr_descriptor (se, expr, ss);
       if (expr->ts.type == BT_CHARACTER)
     {
       gfc_conv_expr_descriptor (se, expr, ss);
       if (expr->ts.type == BT_CHARACTER)


@@ -5601,7 +5628,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
     {
       desc = se->expr;
       /* Repack the array.  */
     {
       desc = se->expr;
       /* Repack the array.  */

-

       if (gfc_option.warn_array_temp)
        {
          if (fsym)
       if (gfc_option.warn_array_temp)
        {
          if (fsym)