re PR libfortran/15234 (libgfortran doesn't compile on Tru64 UNIX V4.0F)

 PR fortran/15234
* trans-array.c gfc_trans_g77_array,
gfc_trans_dummy_array_bias): Don't call gfc_trans_string_init
for assumed length characters.
(gfc_conv_expr_descriptor): Set se->string_length if dealing
with a character expression.
(gfc_cvonv_array_parameter): Pass string length when passing
character array according to g77 conventions.

From-SVN: r84752

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 083f59f0fdf64f2cf1f95d87987c64e07cdf6d2c..687eeab4449db2ad69a089c19c4d0ff78ef7e347 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2004-07-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/15234
+       * trans-array.c gfc_trans_g77_array,
+       gfc_trans_dummy_array_bias): Don't call gfc_trans_string_init
+       for assumed length characters.
+       (gfc_conv_expr_descriptor): Set se->string_length if dealing
+       with a character expression.
+       (gfc_cvonv_array_parameter): Pass string length when passing
+       character array according to g77 conventions.
+
 2004-07-12  Paul Brook  <paul@codesourcery.com>
 
        * expr.c (gfc_check_assign_symbol): Handle pointer assignments.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 88e286544ef23306cb2d10fdca75b53f901a82a2..7ba677ea82ce363ab2d300a2165733beed64b7f6 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2947,7 +2947,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER
-      && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+      && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
     gfc_trans_init_string_length (sym->ts.cl, &block);
 
   /* Evaluate the bounds of the array.  */
@@ -3026,7 +3026,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER
-      && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+      && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
     gfc_trans_init_string_length (sym->ts.cl, &block);
 
   checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check);
@@ -3359,6 +3359,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
            {
              se->expr = desc;
            }
+         if (expr->ts.type == BT_CHARACTER)
+           se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
          return;
        }
     }
@@ -3390,7 +3392,12 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       loop.temp_ss->type = GFC_SS_TEMP;
       loop.temp_ss->next = gfc_ss_terminator;
       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
-      loop.temp_ss->data.temp.string_length = NULL;
+      /* Which can hold our string, if present.  */
+      if (expr->ts.type == BT_CHARACTER)
+       se->string_length = loop.temp_ss->data.temp.string_length
+         = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+      else
+       loop.temp_ss->data.temp.string_length = NULL;
       loop.temp_ss->data.temp.dimen = loop.dimen;
       gfc_add_ss_to_loop (&loop, loop.temp_ss);
     }
@@ -3451,6 +3458,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       tree to;
       tree base;
 
+      /* set the string_length for a character array.  */
+      if (expr->ts.type == BT_CHARACTER)
+       se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
+
       /* Otherwise make a new descriptor and point it at the section we
          want.  The loop variable limits will be the limits of the section.
        */
@@ -3625,6 +3636,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
     {
       sym = expr->symtree->n.sym;
       tmp = gfc_get_symbol_decl (sym);
+      if (sym->ts.type == BT_CHARACTER)
+       se->string_length = sym->ts.cl->backend_decl;
       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
           && !sym->attr.allocatable)
         {