[gomp4] update parsing for the bind clause in fortran

[Cesar Philippidis <cesar at codesourcery dot com>]

This patch does the following:

 * Update gfortran's bind parser to allow the bind with a string
   argument to be used with 'implicit none'
 * Teaches gfortran how to lower the bind clause like the c and c++
   front ends.

Note that the bind clause still isn't implemented in the middle end.
Also, due to the parsing changes, I had to xfail routine-8.f90 because
it no longer fails to compile. However, because bind is unimplemented in
the ME, this test fails to link since the bound names are missing.

I'll apply this patch to gomp-4_0-branch shortly.

Cesar

2017-03-31  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran
	* gfortran.h (struct gfc_omp_clauses): Add bind_name member.
	* match.c (gfc_match_call_name): New function.
	(gfc_match_call): Break out function name parsing to
	gfc_match_call_name.  Call it.
	* match.h (gfc_match_call_named): Declare.
	* openmp.c (gfc_match_oacc_bind_clause): New function.
	(gfc_match_omp_clauses): Call it to parse the bind clause.
	* trans-openmp.c (gfc_trans_omp_clauses_1): Lower OMP_CLAUSE_BIND.

	gcc/testsuite/
	* gfortran.dg/goacc/routine-bind-1.f90: New test.

	libgomp/
	* testsuite/libgomp.oacc-fortran/routine-8.f90: Adjust xfails.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9a7cb45..2adbe4c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1315,7 +1315,7 @@ typedef struct gfc_omp_clauses
   unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
   unsigned wait:1, par_auto:1, gang_static:1, nohost:1, acc_collapse:1, bind:1;
   locus loc;
-
+  char bind_name[GFC_MAX_SYMBOL_LEN+1];
 }
 gfc_omp_clauses;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8470229..ddf2560 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4476,6 +4476,52 @@ match_typebound_call (gfc_symtree* varst)
   return MATCH_YES;
 }
 
+match
+gfc_match_call_name (char *name, gfc_symbol **sym, gfc_symtree **st, bool &exit)
+{
+  exit = true;
+
+  if (gfc_get_ha_sym_tree (name, st))
+    return MATCH_ERROR;
+
+  *sym = (*st)->n.sym;
+
+  /* If this is a variable of derived-type, it probably starts a type-bound
+     procedure call.  */
+  if (((*sym)->attr.flavor != FL_PROCEDURE
+       || gfc_is_function_return_value (*sym, gfc_current_ns))
+      && ((*sym)->ts.type == BT_DERIVED || (*sym)->ts.type == BT_CLASS))
+    return match_typebound_call (*st);
+
+  /* If it does not seem to be callable (include functions so that the
+     right association is made.  They are thrown out in resolution.)
+     ...  */
+  if (!(*sym)->attr.generic
+      && !(*sym)->attr.subroutine
+      && !(*sym)->attr.function)
+    {
+      if (!((*sym)->attr.external && !(*sym)->attr.referenced))
+	{
+	  /* ...create a symbol in this scope...  */
+	  if ((*sym)->ns != gfc_current_ns
+	        && gfc_get_sym_tree (name, NULL, st, false) == 1)
+            return MATCH_ERROR;
+
+	  if (*sym != (*st)->n.sym)
+	    *sym = (*st)->n.sym;
+	}
+
+      /* ...and then to try to make the symbol into a subroutine.  */
+      if (!gfc_add_subroutine (&(*sym)->attr, (*sym)->name, NULL))
+	return MATCH_ERROR;
+    }
+
+  gfc_set_sym_referenced (*sym);
+  exit = false;
+
+  return MATCH_YES;
+}
+
 
 /* Match a CALL statement.  The tricky part here are possible
    alternate return specifiers.  We handle these by having all
@@ -4495,6 +4541,7 @@ gfc_match_call (void)
   gfc_code *c;
   match m;
   int i;
+  bool exit;
 
   arglist = NULL;
 
@@ -4504,42 +4551,9 @@ gfc_match_call (void)
   if (m != MATCH_YES)
     return m;
 
-  if (gfc_get_ha_sym_tree (name, &st))
-    return MATCH_ERROR;
-
-  sym = st->n.sym;
-
-  /* If this is a variable of derived-type, it probably starts a type-bound
-     procedure call.  */
-  if ((sym->attr.flavor != FL_PROCEDURE
-       || gfc_is_function_return_value (sym, gfc_current_ns))
-      && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
-    return match_typebound_call (st);
-
-  /* If it does not seem to be callable (include functions so that the
-     right association is made.  They are thrown out in resolution.)
-     ...  */
-  if (!sym->attr.generic
-	&& !sym->attr.subroutine
-	&& !sym->attr.function)
-    {
-      if (!(sym->attr.external && !sym->attr.referenced))
-	{
-	  /* ...create a symbol in this scope...  */
-	  if (sym->ns != gfc_current_ns
-	        && gfc_get_sym_tree (name, NULL, &st, false) == 1)
-            return MATCH_ERROR;
-
-	  if (sym != st->n.sym)
-	    sym = st->n.sym;
-	}
-
-      /* ...and then to try to make the symbol into a subroutine.  */
-      if (!gfc_add_subroutine (&sym->attr, sym->name, NULL))
-	return MATCH_ERROR;
-    }
-
-  gfc_set_sym_referenced (sym);
+  m = gfc_match_call_name (name, &sym, &st, exit);
+  if (exit)
+    return m;
 
   if (gfc_match_eos () != MATCH_YES)
     {
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index c348113..d7d4394 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -95,6 +95,7 @@ match gfc_match_nullify (void);
 match gfc_match_deallocate (void);
 match gfc_match_return (void);
 match gfc_match_call (void);
+match gfc_match_call_name (char *, gfc_symbol **, gfc_symtree **, bool &);
 
 /* We want to use this function to check for a common-block-name
    that can exist in a bind statement, so removed the "static"
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 10c7f97..354e6ff 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -736,6 +736,26 @@ cleanup:
   return MATCH_ERROR;
 }
 
+static match
+gfc_match_oacc_bind_clause (gfc_omp_clauses *clauses)
+{
+  if (gfc_match (" %n )", clauses->bind_name) == MATCH_YES)
+    {
+      gfc_symbol *sym;
+      gfc_symtree *st;
+      bool exit;
+      match m = gfc_match_call_name (clauses->bind_name, &sym, &st, exit);
+
+      if (exit)
+	return m;
+    }
+  else if (gfc_match (" \"%n\" )", clauses->bind_name) != MATCH_YES)
+    return MATCH_ERROR;
+
+  clauses->bind = 1;
+  return MATCH_YES;
+}
+
 /* OpenMP 4.5 clauses.  */
 enum omp_mask1
 {
@@ -1027,11 +1047,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, omp_mask mask,
 	  break;
 	case 'b':
 	  if ((mask & OMP_CLAUSE_BIND) && c->routine_bind == NULL
-	      && gfc_match ("bind ( %s )", &c->routine_bind) == MATCH_YES)
-	    {
-	      c->bind = 1;
-	      continue;
-	    }
+	      && gfc_match ("bind (") == MATCH_YES
+	      && gfc_match_oacc_bind_clause (c))
+	    continue;
 	  break;
 	case 'c':
 	  if ((mask & OMP_CLAUSE_COLLAPSE)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f3e1773..53d6ff8 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3033,6 +3033,12 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
       //TODO
       gcc_unreachable();
     }
+  if (clauses->bind)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_BIND);
+      OMP_CLAUSE_BIND_NAME (c) = get_identifier (clauses->bind_name);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
 
   return nreverse (omp_clauses);
 }
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-bind-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-bind-1.f90
new file mode 100644
index 0000000..ae4d553
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-bind-1.f90
@@ -0,0 +1,43 @@
+! Test if the bind clause accepts named arguments in quotes, and
+! implicit none symbols.
+
+module routines
+implicit none
+contains
+
+  subroutine sr1 (a)
+    implicit none
+    !$acc routine seq
+    integer a
+
+    a = 1
+  end subroutine sr1
+  
+  subroutine sr (a)
+    implicit none
+    !$acc routine seq bind(sr1)
+    integer a
+    
+    a = 0
+  end subroutine sr
+
+  integer function f1 (a)
+    implicit none
+    !$acc routine seq bind("f")
+    integer a
+    f1 = -1
+  end function f1
+end module routines
+
+program main
+  use routines
+  implicit none
+
+  integer z
+
+  !$acc parallel copyout (z)
+  call sr (z)
+  !$acc end parallel
+
+  print *, z
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-8.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-8.f90
index 5c58b43..4a8cbe9 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-8.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-8.f90
@@ -1,6 +1,8 @@
+! Test the bind clause.  Note that bind is currently unimplemented in
+! the middle end.
 
 ! { dg-do run } 
-! { dg-error "Invalid" "TODO" { xfail *-*-* } 51 }
+! { dg-xfail-if "TODO" { *-*-* } }
 
 program main
   integer, parameter :: n = 10