* trans-expr.c: Do not include convert.h, ggc.h, real.h, and gimple.h.

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

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 4d461cf..53ce4ff 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1,5 +1,6 @@
 /* OpenMP directive translation -- generate GCC trees from gfc_code.
-   Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
    Contributed by Jakub Jelinek <jakub@redhat.com>
 
 This file is part of GCC.
@@ -23,10 +24,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
-#include "gimple.h"
-#include "ggc.h"
+#include "gimple.h"    /* For create_tmp_var_raw.  */
 #include "toplev.h"
-#include "real.h"
 #include "gfortran.h"
 #include "trans.h"
 #include "trans-stmt.h"
@@ -57,7 +56,8 @@ gfc_omp_privatize_by_reference (const_tree decl)
       if (GFC_POINTER_TYPE_P (type))
        return false;
 
-      if (!DECL_ARTIFICIAL (decl))
+      if (!DECL_ARTIFICIAL (decl)
+         && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
        return true;
 
       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
@@ -96,6 +96,15 @@ gfc_omp_predetermined_sharing (tree decl)
         == NULL)
     return OMP_CLAUSE_DEFAULT_SHARED;
 
+  /* Dummy procedures aren't considered variables by OpenMP, thus are
+     disallowed in OpenMP clauses.  They are represented as PARM_DECLs
+     in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
+     to avoid complaining about their uses with default(none).  */
+  if (TREE_CODE (decl) == PARM_DECL
+      && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+      && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+    return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
+
   /* COMMON and EQUIVALENCE decls are shared.  They
      are only referenced through DECL_VALUE_EXPR of the variables
      contained in them.  If those are privatized, they will not be
@@ -624,11 +633,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
                                            build_int_cst (pvoid_type_node, 0),
                                            size, NULL, NULL);
       gfc_conv_descriptor_data_set (&block, decl, ptr);
-      gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false));
+      gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false,
+                            false));
       stmt = gfc_finish_block (&block);
     }
   else
-    stmt = gfc_trans_assignment (e1, e2, false);
+    stmt = gfc_trans_assignment (e1, e2, false, false);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
   else
@@ -645,12 +655,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
       stmtblock_t block;
 
       gfc_start_block (&block);
-      gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false));
+      gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false,
+                            true));
       gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl));
       stmt = gfc_finish_block (&block);
     }
   else
-    stmt = gfc_trans_assignment (e3, e4, false);
+    stmt = gfc_trans_assignment (e3, e4, false, true);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
   else
@@ -700,7 +711,7 @@ static tree
 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                       locus where)
 {
-  tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
+  tree omp_clauses = NULL_TREE, chunk_size, c;
   int list;
   enum omp_clause_code clause_code;
   gfc_se se;
@@ -759,7 +770,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
            default:
              gcc_unreachable ();
            }
-         old_clauses = omp_clauses;
          omp_clauses
            = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
                                            where);
@@ -1134,14 +1144,13 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
   stmtblock_t block;
   stmtblock_t body;
   gfc_omp_clauses *clauses = code->ext.omp_clauses;
-  gfc_code *outermost;
   int i, collapse = clauses->collapse;
   tree dovar_init = NULL_TREE;
 
   if (collapse <= 0)
     collapse = 1;
 
-  outermost = code = code->block->next;
+  code = code->block->next;
   gcc_assert (code->op == EXEC_DO);
 
   init = make_tree_vec (collapse);
@@ -1160,6 +1169,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
     {
       int simple = 0;
       int dovar_found = 0;
+      tree dovar_decl;
 
       if (clauses)
        {
@@ -1200,12 +1210,19 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
       gfc_conv_expr_val (&se, code->ext.iterator->step);
       gfc_add_block_to_block (pblock, &se.pre);
       step = gfc_evaluate_now (se.expr, pblock);
+      dovar_decl = dovar;
 
       /* Special case simple loops.  */
-      if (integer_onep (step))
-       simple = 1;
-      else if (tree_int_cst_equal (step, integer_minus_one_node))
-       simple = -1;
+      if (TREE_CODE (dovar) == VAR_DECL)
+       {
+         if (integer_onep (step))
+           simple = 1;
+         else if (tree_int_cst_equal (step, integer_minus_one_node))
+           simple = -1;
+       }
+      else
+       dovar_decl
+         = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
 
       /* Loop body.  */
       if (simple)
@@ -1249,7 +1266,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
       if (!dovar_found)
        {
          tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
-         OMP_CLAUSE_DECL (tmp) = dovar;
+         OMP_CLAUSE_DECL (tmp) = dovar_decl;
          omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
        }
       else if (dovar_found == 2)
@@ -1269,7 +1286,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
              tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp);
              for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
                if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
-                   && OMP_CLAUSE_DECL (c) == dovar)
+                   && OMP_CLAUSE_DECL (c) == dovar_decl)
                  {
                    OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
                    break;
@@ -1279,11 +1296,11 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
            {
              for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
                if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
-                   && OMP_CLAUSE_DECL (c) == dovar)
+                   && OMP_CLAUSE_DECL (c) == dovar_decl)
                  {
                    tree l = build_omp_clause (input_location,
                                               OMP_CLAUSE_LASTPRIVATE);
-                   OMP_CLAUSE_DECL (l) = dovar;
+                   OMP_CLAUSE_DECL (l) = dovar_decl;
                    OMP_CLAUSE_CHAIN (l) = omp_clauses;
                    OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
                    omp_clauses = l;