OSDN Git Service

gcc/fortran/
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-expr.c
index caf3d75..35c3f12 100644 (file)
@@ -362,6 +362,13 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
          && !sym->attr.dimension)
        se->expr = gfc_build_indirect_ref (se->expr);
 
+      /* Dereference scalar hidden result.  */
+      if (gfc_option.flag_f2c 
+         && (sym->attr.function || sym->attr.result)
+         && sym->ts.type == BT_COMPLEX
+         && !sym->attr.dimension)
+       se->expr = gfc_build_indirect_ref (se->expr);
+
       /* Dereference pointer variables.  */
       if ((sym->attr.pointer || sym->attr.allocatable)
          && (sym->attr.dummy
@@ -1138,7 +1145,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
                                      convert (gfc_charlen_type_node, len));
        }
       else
-       gcc_unreachable ();
+       {
+         gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
+
+         type = gfc_get_complex_type (sym->ts.kind);
+         var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
+         arglist = gfc_chainon_list (arglist, var);
+       }
     }
 
   formal = sym->formal;
@@ -1240,14 +1253,25 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
                     arglist, NULL_TREE);
 
+  if (sym->result)
+    sym = sym->result;
+
   /* If we have a pointer function, but we don't want a pointer, e.g.
      something like
         x = f()
      where f is pointer valued, we have to dereference the result.  */
-  if (!se->want_pointer && !byref
-      && (sym->attr.pointer || (sym->result && sym->result->attr.pointer)))
+  if (!se->want_pointer && !byref && sym->attr.pointer)
     se->expr = gfc_build_indirect_ref (se->expr);
 
+  /* f2c calling conventions require a scalar default real function to
+     return a double precision result.  Convert this back to default
+     real.  We only care about the cases that can happen in Fortran 77.
+  */
+  if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+      && sym->ts.kind == gfc_default_real_kind
+      && !sym->attr.always_explicit)
+    se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
   /* A pure function may still have side-effects - it may modify its
      parameters.  */
   TREE_SIDE_EFFECTS (se->expr) = 1;
@@ -1282,7 +1306,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
              se->string_length = len;
            }
          else
-           gcc_unreachable ();
+           {
+             gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+             se->expr = gfc_build_indirect_ref (var);
+           }
        }
     }
 }