* g++.dg/ipa/iinline-1.C: Remove -c flag, add -fpie for PIC

[pf3gnuchains/gcc-fork.git] / gcc / fortran / iresolve.c

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 4b7e17d..619d7e9 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -75,11 +75,8 @@ check_charlen_present (gfc_expr *source)
       source->rank = 0;
     }
   else if (source->expr_type == EXPR_ARRAY)
-    {
-      source->ts.cl->length =
+    source->ts.cl->length =
        gfc_int_expr (source->value.constructor->expr->value.character.length);
-      source->rank = 1;
-    }
 }
 
 /* Helper function for resolving the "mask" argument.  */
@@ -109,7 +106,7 @@ resolve_mask_arg (gfc_expr *mask)
       /* In the library, we access the mask with a GFC_LOGICAL_1
         argument.  No need to waste memory if we are about to create
         a temporary array.  */
-      if (mask->expr_type == EXPR_OP)
+      if (mask->expr_type == EXPR_OP && mask->ts.kind != 1)
        {
          ts.type = BT_LOGICAL;
          ts.kind = 1;
@@ -630,9 +627,19 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
         }
     }
 
-  f->value.function.name
-    = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind,
-                     array->ts.type == BT_CHARACTER ? "_char" : "");
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+       f->value.function.name
+         = gfc_get_string (PREFIX ("cshift%d_%d_char"), n, shift->ts.kind);
+      else
+       f->value.function.name
+         = gfc_get_string (PREFIX ("cshift%d_%d_char%d"), n, shift->ts.kind,
+                           array->ts.kind);
+    }
+  else
+    f->value.function.name
+       = gfc_get_string (PREFIX ("cshift%d_%d"), n, shift->ts.kind);
 }
 
 
@@ -698,7 +705,7 @@ gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b)
 
   temp.expr_type = EXPR_OP;
   gfc_clear_ts (&temp.ts);
-  temp.value.op.operator = INTRINSIC_NONE;
+  temp.value.op.op = INTRINSIC_NONE;
   temp.value.op.op1 = a;
   temp.value.op.op2 = b;
   gfc_type_convert_binary (&temp);
@@ -771,9 +778,19 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
         }
     }
 
-  f->value.function.name
-    = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind,
-                     array->ts.type == BT_CHARACTER ? "_char" : "");
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+       f->value.function.name
+         = gfc_get_string (PREFIX ("eoshift%d_%d_char"), n, shift->ts.kind);
+      else
+       f->value.function.name
+         = gfc_get_string (PREFIX ("eoshift%d_%d_char%d"), n, shift->ts.kind,
+                           array->ts.kind);
+    }
+  else
+    f->value.function.name
+       = gfc_get_string (PREFIX ("eoshift%d_%d"), n, shift->ts.kind);
 }
 
 
@@ -1315,7 +1332,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
     {
       temp.expr_type = EXPR_OP;
       gfc_clear_ts (&temp.ts);
-      temp.value.op.operator = INTRINSIC_NONE;
+      temp.value.op.op = INTRINSIC_NONE;
       temp.value.op.op1 = a;
       temp.value.op.op2 = b;
       gfc_type_convert_binary (&temp);
@@ -1324,6 +1341,34 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
 
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
 
+  if (a->rank == 2 && b->rank == 2)
+    {
+      if (a->shape && b->shape)
+       {
+         f->shape = gfc_get_shape (f->rank);
+         mpz_init_set (f->shape[0], a->shape[0]);
+         mpz_init_set (f->shape[1], b->shape[1]);
+       }
+    }
+  else if (a->rank == 1)
+    {
+      if (b->shape)
+       {
+         f->shape = gfc_get_shape (f->rank);
+         mpz_init_set (f->shape[0], b->shape[1]);
+       }
+    }
+  else 
+    {
+      /* b->rank == 1 and a->rank == 2 here, all other cases have
+        been caught in check.c.   */
+      if (a->shape)
+       {
+         f->shape = gfc_get_shape (f->rank);
+         mpz_init_set (f->shape[0], a->shape[0]);
+       }
+    }
+
   f->value.function.name
     = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type),
                      f->ts.kind);
@@ -1743,6 +1788,7 @@ gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
+      f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
       gfc_resolve_dim_arg (dim);
     }
 
@@ -2226,6 +2272,7 @@ gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
+      f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
       gfc_resolve_dim_arg (dim);
     }
 
@@ -2561,9 +2608,43 @@ gfc_resolve_cpu_time (gfc_code *c)
 }
 
 
+/* Create a formal arglist based on an actual one and set the INTENTs given.  */
+
+static gfc_formal_arglist*
+create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints)
+{
+  gfc_formal_arglist* head;
+  gfc_formal_arglist* tail;
+  int i;
+
+  if (!actual)
+    return NULL;
+
+  head = tail = gfc_get_formal_arglist ();
+  for (i = 0; actual; actual = actual->next, tail = tail->next, ++i)
+    {
+      gfc_symbol* sym;
+
+      sym = gfc_new_symbol ("dummyarg", NULL);
+      sym->ts = actual->expr->ts;
+
+      sym->attr.intent = ints[i];
+      tail->sym = sym;
+
+      if (actual->next)
+       tail->next = gfc_get_formal_arglist ();
+    }
+
+  return head;
+}
+
+
 void
 gfc_resolve_mvbits (gfc_code *c)
 {
+  static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
+                                      INTENT_INOUT, INTENT_IN};
+
   const char *name;
   gfc_typespec ts;
   gfc_clear_ts (&ts);
@@ -2585,6 +2666,10 @@ gfc_resolve_mvbits (gfc_code *c)
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
   /* Mark as elemental subroutine as this does not happen automatically.  */
   c->resolved_sym->attr.elemental = 1;
+
+  /* Create a dummy formal arglist so the INTENTs are known later for purpose
+     of creating temporaries.  */
+  c->resolved_sym->formal = create_formal_for_intents (c->ext.actual, INTENTS);
 }