gfortran.h (gfc_omp_namespace): Add locus where member.

	gcc/fortran/
	* gfortran.h (gfc_omp_namespace): Add locus where member.
	* openmp.c (gfc_match_omp_variable_list): Set where for each list
	item found.
	(resolve_omp_clauses): Remove where argument and use the where
	gfc_omp_namespace member when reporting errors.
	(resolve_omp_do):  Update call to resolve_omp_clauses.
	(resolve_oacc_loop): Likewise.
	(gfc_resolve_oacc_directive): Likewise.
	(gfc_resolve_omp_directive): Likewise.
	(gfc_resolve_omp_declare_simd): Likewise.

	gcc/testsuite/
	* gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning.

From-SVN: r229609

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8b99c0349f7bdc20e26a51d6e79449d56b36960b..8b180ab98d861c66b8897db947d6494c8041a45d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2015-10-30  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * gfortran.h (gfc_omp_namespace): Add locus where member.
+       * openmp.c (gfc_match_omp_variable_list): Set where for each list
+       item found.
+       (resolve_omp_clauses): Remove where argument and use the where
+       gfc_omp_namespace member when reporting errors.
+       (resolve_omp_do):  Update call to resolve_omp_clauses.
+       (resolve_oacc_loop): Likewise.
+       (gfc_resolve_oacc_directive): Likewise.
+       (gfc_resolve_omp_directive): Likewise.
+       (gfc_resolve_omp_declare_simd): Likewise.
+
 2015-10-15  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/51993

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 90f63cf480771de4949a6e8ada8ebe20b7b3d34c..13e730f41b7fd241170d441d013de3f2cd682d76 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1123,6 +1123,7 @@ typedef struct gfc_omp_namelist
     } u;
   struct gfc_omp_namelist_udr *udr;
   struct gfc_omp_namelist *next;
+  locus where;
 }
 gfc_omp_namelist;
 

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 6c78c97288b248dcf577d39856aca652f63943ce..3fd19b82fa14604e779e07c37274d357b7f8993c 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -244,6 +244,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
            }
          tail->sym = sym;
          tail->expr = expr;
+         tail->where = cur_loc;
          goto next_item;
        case MATCH_NO:
          break;
@@ -278,6 +279,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
              tail = tail->next;
            }
          tail->sym = sym;
+         tail->where = cur_loc;
        }
 
     next_item:
@@ -2860,9 +2862,8 @@ oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
 /* OpenMP directive resolving routines.  */
 
 static void
-resolve_omp_clauses (gfc_code *code, locus *where,
-                    gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
-                    bool openacc = false)
+resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+                    gfc_namespace *ns, bool openacc = false)
 {
   gfc_omp_namelist *n;
   gfc_expr_list *el;
@@ -2921,7 +2922,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
          {
            if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
              gfc_error ("Variable %qs is not a dummy argument at %L",
-                        n->sym->name, where);
+                        n->sym->name, n->where);
            continue;
          }
        if (n->sym->attr.flavor == FL_PROCEDURE
@@ -2953,7 +2954,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
              }
          }
        gfc_error ("Object %qs is not a variable at %L", n->sym->name,
-                  where);
+                  &n->where);
       }
 
   for (list = 0; list < OMP_LIST_NUM; list++)
@@ -2969,7 +2970,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
          if (n->sym->mark && !oacc_compatible_clauses (omp_clauses, list,
                                                        n->sym, openacc))
            gfc_error ("Symbol %qs present on multiple clauses at %L",
-                      n->sym->name, where);
+                      n->sym->name, &n->where);
          else
            n->sym->mark = 1;
        }
@@ -2980,7 +2981,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
       if (n->sym->mark)
        {
          gfc_error ("Symbol %qs present on multiple clauses at %L",
-                    n->sym->name, where);
+                    n->sym->name, &n->where);
          n->sym->mark = 0;
        }
 
@@ -2988,7 +2989,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
        gfc_error ("Symbol %qs present on multiple clauses at %L",
-                  n->sym->name, where);
+                  n->sym->name, &n->where);
       else
        n->sym->mark = 1;
     }
@@ -2999,7 +3000,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
        gfc_error ("Symbol %qs present on multiple clauses at %L",
-                  n->sym->name, where);
+                  n->sym->name, &n->where);
       else
        n->sym->mark = 1;
     }
@@ -3011,7 +3012,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->sym->mark)
        gfc_error ("Symbol %qs present on multiple clauses at %L",
-                  n->sym->name, where);
+                  n->sym->name, &n->where);
       else
        n->sym->mark = 1;
     }
@@ -3025,7 +3026,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
     {
       if (n->expr == NULL && n->sym->mark)
        gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
-                  n->sym->name, where);
+                  n->sym->name, &n->where);
       else
        n->sym->mark = 1;
     }
@@ -3047,7 +3048,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
              {
                if (!n->sym->attr.threadprivate)
                  gfc_error ("Non-THREADPRIVATE object %qs in COPYIN clause"
-                            " at %L", n->sym->name, where);
+                            " at %L", n->sym->name, &n->where);
              }
            break;
          case OMP_LIST_COPYPRIVATE:
@@ -3055,10 +3056,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
              {
                if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
                  gfc_error ("Assumed size array %qs in COPYPRIVATE clause "
-                            "at %L", n->sym->name, where);
+                            "at %L", n->sym->name, &n->where);
                if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
                  gfc_error ("INTENT(IN) POINTER %qs in COPYPRIVATE clause "
-                            "at %L", n->sym->name, where);
+                            "at %L", n->sym->name, &n->where);
              }
            break;
          case OMP_LIST_SHARED:
@@ -3066,13 +3067,13 @@ resolve_omp_clauses (gfc_code *code, locus *where,
              {
                if (n->sym->attr.threadprivate)
                  gfc_error ("THREADPRIVATE object %qs in SHARED clause at "
-                            "%L", n->sym->name, where);
+                            "%L", n->sym->name, &n->where);
                if (n->sym->attr.cray_pointee)
                  gfc_error ("Cray pointee %qs in SHARED clause at %L",
-                           n->sym->name, where);
+                           n->sym->name, &n->where);
                if (n->sym->attr.associate_var)
                  gfc_error ("ASSOCIATE name %qs in SHARED clause at %L",
-                            n->sym->name, where);
+                            n->sym->name, &n->where);
              }
            break;
          case OMP_LIST_ALIGNED:
@@ -3088,7 +3089,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                            != ISOCBINDING_PTR)))
                  gfc_error ("%qs in ALIGNED clause must be POINTER, "
                             "ALLOCATABLE, Cray pointer or C_PTR at %L",
-                            n->sym->name, where);
+                            n->sym->name, &n->where);
                else if (n->expr)
                  {
                    gfc_expr *expr = n->expr;
@@ -3100,7 +3101,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                        || alignment <= 0)
                      gfc_error ("%qs in ALIGNED clause at %L requires a scalar "
                                 "positive constant integer alignment "
-                                "expression", n->sym->name, where);
+                                "expression", n->sym->name, &n->where);
                  }
              }
            break;
@@ -3119,10 +3120,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                        || n->expr->ref->next
                        || n->expr->ref->type != REF_ARRAY)
                      gfc_error ("%qs in %s clause at %L is not a proper "
-                                "array section", n->sym->name, name, where);
+                                "array section", n->sym->name, name,
+                                &n->where);
                    else if (n->expr->ref->u.ar.codimen)
                      gfc_error ("Coarrays not supported in %s clause at %L",
-                                name, where);
+                                name, &n->where);
                    else
                      {
                        int i;
@@ -3132,7 +3134,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                            {
                              gfc_error ("Stride should not be specified for "
                                         "array section in %s clause at %L",
-                                        name, where);
+                                        name, &n->where);
                              break;
                            }
                          else if (ar->dimen_type[i] != DIMEN_ELEMENT
@@ -3140,7 +3142,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                            {
                              gfc_error ("%qs in %s clause at %L is not a "
                                         "proper array section",
-                                        n->sym->name, name, where);
+                                        n->sym->name, name, &n->where);
                              break;
                            }
                          else if (list == OMP_LIST_DEPEND
@@ -3153,7 +3155,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                            {
                              gfc_error ("%qs in DEPEND clause at %L is a "
                                         "zero size array section",
-                                        n->sym->name, where);
+                                        n->sym->name, &n->where);
                              break;
                            }
                      }
@@ -3162,9 +3164,9 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                  {
                    if (list == OMP_LIST_MAP
                        && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR)
-                     resolve_oacc_deviceptr_clause (n->sym, *where, name);
+                     resolve_oacc_deviceptr_clause (n->sym, n->where, name);
                    else
-                     resolve_oacc_data_clauses (n->sym, *where, name);
+                     resolve_oacc_data_clauses (n->sym, n->where, name);
                  }
              }
 
@@ -3174,10 +3176,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                  n->sym->attr.referenced = 1;
                  if (n->sym->attr.threadprivate)
                    gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
-                              n->sym->name, name, where);
+                              n->sym->name, name, &n->where);
                  if (n->sym->attr.cray_pointee)
                    gfc_error ("Cray pointee %qs in %s clause at %L",
-                              n->sym->name, name, where);
+                              n->sym->name, name, &n->where);
                }
            break;
          default:
@@ -3186,35 +3188,35 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                bool bad = false;
                if (n->sym->attr.threadprivate)
                  gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
-                            n->sym->name, name, where);
+                            n->sym->name, name, &n->where);
                if (n->sym->attr.cray_pointee)
                  gfc_error ("Cray pointee %qs in %s clause at %L",
-                           n->sym->name, name, where);
+                           n->sym->name, name, &n->where);
                if (n->sym->attr.associate_var)
                  gfc_error ("ASSOCIATE name %qs in %s clause at %L",
-                            n->sym->name, name, where);
+                            n->sym->name, name, &n->where);
                if (list != OMP_LIST_PRIVATE)
                  {
                    if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION)
                      gfc_error ("Procedure pointer %qs in %s clause at %L",
-                                n->sym->name, name, where);
+                                n->sym->name, name, &n->where);
                    if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION)
                      gfc_error ("POINTER object %qs in %s clause at %L",
-                                n->sym->name, name, where);
+                                n->sym->name, name, &n->where);
                    if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION)
                      gfc_error ("Cray pointer %qs in %s clause at %L",
-                                n->sym->name, name, where);
+                                n->sym->name, name, &n->where);
                  }
                if (code
                    && (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL))
-                 check_array_not_assumed (n->sym, *where, name);
+                 check_array_not_assumed (n->sym, n->where, name);
                else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
                  gfc_error ("Assumed size array %qs in %s clause at %L",
-                            n->sym->name, name, where);
+                            n->sym->name, name, &n->where);
                if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION)
                  gfc_error ("Variable %qs in %s clause is used in "
                             "NAMELIST statement at %L",
-                            n->sym->name, name, where);
+                            n->sym->name, name, &n->where);
                if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
                  switch (list)
                    {
@@ -3223,7 +3225,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                    case OMP_LIST_LINEAR:
                    /* case OMP_LIST_REDUCTION: */
                      gfc_error ("INTENT(IN) POINTER %qs in %s clause at %L",
-                                n->sym->name, name, where);
+                                n->sym->name, name, &n->where);
                      break;
                    default:
                      break;
@@ -3317,7 +3319,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                                }
                            gfc_error ("!$OMP DECLARE REDUCTION %s not found "
                                       "for type %s at %L", udr_name,
-                                      gfc_typename (&n->sym->ts), where);
+                                      gfc_typename (&n->sym->ts), &n->where);
                          }
                        else
                          {
@@ -3339,10 +3341,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                  case OMP_LIST_LINEAR:
                    if (n->sym->ts.type != BT_INTEGER)
                      gfc_error ("LINEAR variable %qs must be INTEGER "
-                                "at %L", n->sym->name, where);
+                                "at %L", n->sym->name, &n->where);
                    else if (!code && !n->sym->attr.value)
                      gfc_error ("LINEAR dummy argument %qs must have VALUE "
-                                "attribute at %L", n->sym->name, where);
+                                "attribute at %L", n->sym->name, &n->where);
                    else if (n->expr)
                      {
                        gfc_expr *expr = n->expr;
@@ -3351,11 +3353,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                            || expr->rank != 0)
                          gfc_error ("%qs in LINEAR clause at %L requires "
                                     "a scalar integer linear-step expression",
-                                    n->sym->name, where);
+                                    n->sym->name, &n->where);
                        else if (!code && expr->expr_type != EXPR_CONSTANT)
                          gfc_error ("%qs in LINEAR clause at %L requires "
                                     "a constant integer linear-step expression",
-                                    n->sym->name, where);
+                                    n->sym->name, &n->where);
                      }
                    break;
                  /* Workaround for PR middle-end/26316, nothing really needs
@@ -3368,22 +3370,22 @@ resolve_omp_clauses (gfc_code *code, locus *where,
                          || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
                              && CLASS_DATA (n->sym)->attr.allocatable))
                        gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
-                                  n->sym->name, name, where);
+                                  n->sym->name, name, &n->where);
                      if (n->sym->attr.pointer
                          || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
                              && CLASS_DATA (n->sym)->attr.class_pointer))
                        gfc_error ("POINTER object %qs in %s clause at %L",
-                                  n->sym->name, name, where);
+                                  n->sym->name, name, &n->where);
                      if (n->sym->attr.cray_pointer)
                        gfc_error ("Cray pointer object %qs in %s clause at %L",
-                                  n->sym->name, name, where);
+                                  n->sym->name, name, &n->where);
                      if (n->sym->attr.cray_pointee)
                        gfc_error ("Cray pointee object %qs in %s clause at %L",
-                                  n->sym->name, name, where);
+                                  n->sym->name, name, &n->where);
                      /* FALLTHRU */
                  case OMP_LIST_DEVICE_RESIDENT:
-                   check_symbol_not_pointer (n->sym, *where, name);
-                   check_array_not_assumed (n->sym, *where, name);
+                   check_symbol_not_pointer (n->sym, n->where, name);
+                   check_array_not_assumed (n->sym, n->where, name);
                    break;
                  default:
                    break;
@@ -4149,7 +4151,7 @@ resolve_omp_do (gfc_code *code)
     }
 
   if (code->ext.omp_clauses)
-    resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+    resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
 
   do_code = code->block->next;
   collapse = code->ext.omp_clauses->collapse;
@@ -4587,7 +4589,7 @@ resolve_oacc_loop (gfc_code *code)
   int collapse;
 
   if (code->ext.omp_clauses)
-    resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true);
+    resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
 
   do_code = code->block->next;
   collapse = code->ext.omp_clauses->collapse;
@@ -4652,8 +4654,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_WAIT:
     case EXEC_OACC_CACHE:
-      resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
-                          true);
+      resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
       break;
     case EXEC_OACC_PARALLEL_LOOP:
     case EXEC_OACC_KERNELS_LOOP:
@@ -4711,11 +4712,11 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
     case EXEC_OMP_TEAMS:
     case EXEC_OMP_WORKSHARE:
       if (code->ext.omp_clauses)
-       resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+       resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
       break;
     case EXEC_OMP_TARGET_UPDATE:
       if (code->ext.omp_clauses)
-       resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+       resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
       if (code->ext.omp_clauses == NULL
          || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL
              && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL))
@@ -4743,7 +4744,7 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns)
        gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure "
                   "%qs at %L", ns->proc_name->name, &ods->where);
       if (ods->clauses)
-       resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns);
+       resolve_omp_clauses (NULL, ods->clauses, ns);
     }
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a82f4cb2f5ebdc1cb21959494f7e19dacfc0c190..2ec795cda2aa9811602832e1a70b767e9d735382 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2015-10-30  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * gfortran.dg/gomp/intentin1.f90: Adjust copyprivate warning.
+
 2015-10-30  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/46588

diff --git a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90 b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
index f2a2e98fd7615d46a61a9d9861b0a7d7dda16a95..8bd53aaf5622f63e5c27804df88360320aede0d5 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/intentin1.f90
@@ -11,6 +11,6 @@ subroutine foo (x)
 !$omp simd linear (x)                  ! { dg-error "INTENT.IN. POINTER" }
   do i = 1, 10
   end do
-!$omp single                           ! { dg-error "INTENT.IN. POINTER" }
-!$omp end single copyprivate (x)
+!$omp single
+!$omp end single copyprivate (x)        ! { dg-error "INTENT.IN. POINTER" }
 end