Patchwork [Fortran] (Coarray) Add parse support for LOCK/UNLOCK (part 1 of 2)

login
register
mail settings
Submitter Tobias Burnus
Date June 6, 2011, 9:40 p.m.
Message ID <4DED493E.5030705@net-b.de>
Download mbox | patch
Permalink /patch/99047/
State New
Headers show

Comments

Tobias Burnus - June 6, 2011, 9:40 p.m.
This patch adds incomplete parsing support for the LOCK and UNLOCK 
statement. Missing part 2 is the addition of the LOCK_TYPE of the 
ISO_FORTRAN_ENV.

Build and tested on x86-64-linux.
OK for the trunk?

Tobias
Daniel Kraft - June 7, 2011, 9:10 a.m.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Hi Tobias,

On 06/06/11 23:40, Tobias Burnus wrote:
> This patch adds incomplete parsing support for the LOCK and UNLOCK
> statement. Missing part 2 is the addition of the LOCK_TYPE of the
> ISO_FORTRAN_ENV.
> 
> Build and tested on x86-64-linux.
> OK for the trunk?

Ok but you could consider the comments below (all not very important,
though, and I'm fine if you check in just as it is).

Thanks for the patch!  Yours,
Daniel

+      fputs ("lock-variable=", dumpfile);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);

Why do you dump "lock-variable=" in any case, while you only print the
names for the other arguments only if present?

- -  gfc_expr *expr1, *expr2, *expr3;
+  gfc_expr *expr1, *expr2, *expr3, *expr4;

Just a side-remark, but this makes me wonder whether we should at some
point use a union there if we keep adding more and more expressions?  So
that the code can be understood more easily and it is always clear what
something like c->expr3 actually references?

+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+          tmp = NULL;
+	  break;

Looks like a white-space / tab mismatch in the tmp = NULL line.

For the same context (lock_unlock_statement function):  We're repeating
the same matching logic thrice for all stat-variables ... maybe I would
be tempted to think about a way out; possibly using a macro.  Although
this may of course also make the code harder to read.  I'm certainly ok
with the code as it is, just a thought.  (I personally don't really like
duplicating code so large, although it is a very simple and clear one.)

- -- 
http://www.pro-vegan.info/
- --
Done:  Arc-Bar-Cav-Kni-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Mon-Pri
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.2.1 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iQIVAwUBTe3rE1J+ebqjtTmYAQKkNQ/8C1UGEH3EFtsaLST+vEpU3drdgPM6XQ7v
mxRbb9RXwd6MuzgF1yBJbv+aAFxvTcpUbmlm1etuNDdnJDPEhqedHbUJOU4VjP1k
4IDGRt/YHVQyff8/kmsY9w2+ls5ETOyVpGyxL9B2HcHYWs46733WivpDE2Cvt2yb
b6VTsb03rvpJjRszSIH2XH3H9DB1udAQlAj0F17Lt+kcK07h7EodxbrEbUlQXrdh
Caqby9e5GU0dotVJdrWPax7we6wORGgQ2rI5fufSrELE3OOo3mNrnRWtidPywnbn
mM99XoR9HwHuTEFjfWgzix3js8fpqHJJWE3JECJXx5g5KIDBTN+IxruwWU/8L65O
QCPEBza3h6pb5PgkLe0QnerWDVJ/BrXynHJ9UP645R21k6VamE+/zN5E8xMMNDEq
beEvztTPHR6Ih5UmLk7leNBE0WLAhtJKRP1p529PBznQ5rAvtfXEuzsjNsvIZMsC
AIfE4/un2HHc4oGLHrGQ4YimQEVdg3Px4js1gmI6wcuXj68cpS2R6S1zih+bTcFV
+18gp6XOtGDJhrQyMO34xIGAfSLVxlIBqT/xntvT7uTYhVHtwX1Y5ih9cFZlo7kC
tN13bV1x9PdUaYtUtFTHb4Tf6GhsRMksFFUPvuh0ddzpR/peVmoB+d+U+yu0TZCm
A3U+CWmwv5o=
=sLG0
-----END PGP SIGNATURE-----
Tobias Burnus - June 8, 2011, 6:29 a.m.
Dear Daniel,

thank you for the review.

Daniel Kraft wrote:
> +      fputs ("lock-variable=", dumpfile);
> +      if (c->expr1 != NULL)
> +	show_expr (c->expr1);
>
> Why do you dump "lock-variable=" in any case, while you only print the
> names for the other arguments only if present?

The lock variable is required and thus always present; the others 
(stat=, errmgs=, and lock_acquired=) are optional.

> - -  gfc_expr *expr1, *expr2, *expr3;
> +  gfc_expr *expr1, *expr2, *expr3, *expr4;
>
> Just a side-remark, but this makes me wonder whether we should at some
> point use a union there if we keep adding more and more expressions?  So
> that the code can be understood more easily and it is always clear what
> something like c->expr3 actually references?

Maybe. Though at least expr1 and expr2 are used by most statements thus 
it will be rather invasive.

> +          tmp = NULL;
> +	  break;
>
> Looks like a white-space / tab mismatch in the tmp = NULL line.

Fixed.

> For the same context (lock_unlock_statement function):  We're repeating
> the same matching logic thrice for all stat-variables ... maybe I would
> be tempted to think about a way out; possibly using a macro.  Although
> this may of course also make the code harder to read.  I'm certainly ok
> with the code as it is, just a thought.  (I personally don't really like
> duplicating code so large, although it is a very simple and clear one.)

I left it as is. I agree that it is a code duplication, but I think a 
macro does not really make it readable and three items - all which are 
relatively short - is small enough to tolerate the duplication.

Tobias

Patch

 b/gcc/fortran/dump-parse-tree.c                  |   27 +++
 b/gcc/fortran/frontend-passes.c                  |    1 
 b/gcc/fortran/gfortran.h                         |    5 
 b/gcc/fortran/match.c                            |  202 ++++++++++++++++++++++-
 b/gcc/fortran/match.h                            |    2 
 b/gcc/fortran/parse.c                            |   14 +
 b/gcc/fortran/resolve.c                          |   39 ++++
 b/gcc/fortran/st.c                               |    2 


2011-06-06  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* gfortran.h (gfc_statement): Add ST_LOCK and ST_UNLOCK.
	(gfc_exec_op): Add EXEC_LOCK and EXEC_UNLOCK.
	(gfc_code): Add expr4.
	* match.h (gfc_match_lock, gfc_match_unlock): New prototypes.
	* match.c (gfc_match_lock, gfc_match_unlock,
	lock_unlock_statement): New functions.
	(sync_statement): Bug fix, avoiding double freeing.
	(gfc_match_if): Handle LOCK/UNLOCK statement.
	* parse.c (decode_statement, next_statement,
	gfc_ascii_statement): Ditto.
	* st.c (gfc_free_statement): Handle LOCK and UNLOCK.
	* resolve.c (resolve_lock_unlock): New function.
	(resolve_code): Call it.
	* dump-parse-tree.c (show_code_node): Handle LOCK/UNLOCK.
	* frontend-passes.c (gfc_code_walker): Optimize gfc_code's expr4.

2011-06-06  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* gfortran.dg/coarray_lock_1.f90: New.
	* gfortran.dg/coarray_lock_2.f90: New.

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c807062..87b8b68 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1396,6 +1396,33 @@  show_code_node (int level, gfc_code *c)
 	}
       break;
 
+    case EXEC_LOCK:
+    case EXEC_UNLOCK:
+      if (c->op == EXEC_LOCK)
+	fputs ("LOCK ", dumpfile);
+      else
+	fputs ("UNLOCK ", dumpfile);
+
+      fputs ("lock-variable=", dumpfile);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
+      if (c->expr4 != NULL)
+	{
+	  fputs (" acquired_lock=", dumpfile);
+	  show_expr (c->expr4);
+	}
+      if (c->expr2 != NULL)
+	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
     case EXEC_ARITHMETIC_IF:
       fputs ("IF ", dumpfile);
       show_expr (c->expr1);
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 0137a9d..f100e1f 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1190,6 +1190,7 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	  WALK_SUBEXPR (co->expr1);
 	  WALK_SUBEXPR (co->expr2);
 	  WALK_SUBEXPR (co->expr3);
+	  WALK_SUBEXPR (co->expr4);
 	  for (b = co->block; b; b = b->block)
 	    {
 	      WALK_SUBEXPR (b->expr1);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ff82424..f23fbbd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -208,7 +208,7 @@  typedef enum
   ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
   ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
   ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
-  ST_GET_FCN_CHARACTERISTICS, ST_NONE
+  ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
 }
 gfc_statement;
 
@@ -2056,6 +2056,7 @@  typedef enum
   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
+  EXEC_LOCK, EXEC_UNLOCK,
   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2074,7 +2075,7 @@  typedef struct gfc_code
 
   gfc_st_label *here, *label1, *label2, *label3;
   gfc_symtree *symtree;
-  gfc_expr *expr1, *expr2, *expr3;
+  gfc_expr *expr1, *expr2, *expr3, *expr4;
   /* A name isn't sufficient to identify a subroutine, we need the actual
      symbol for the interface definition.
   const char *sub_name;  */
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index f275239..11dee41 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1561,6 +1561,7 @@  gfc_match_if (gfc_statement *if_type)
   match ("go to", gfc_match_goto, ST_GOTO)
   match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
   match ("inquire", gfc_match_inquire, ST_INQUIRE)
+  match ("lock", gfc_match_lock, ST_LOCK)
   match ("nullify", gfc_match_nullify, ST_NULLIFY)
   match ("open", gfc_match_open, ST_OPEN)
   match ("pause", gfc_match_pause, ST_NONE)
@@ -1573,6 +1574,7 @@  gfc_match_if (gfc_statement *if_type)
   match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
   match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
   match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+  match ("unlock", gfc_match_unlock, ST_UNLOCK)
   match ("where", match_simple_where, ST_WHERE)
   match ("write", gfc_match_write, ST_WRITE)
 
@@ -2305,6 +2307,190 @@  gfc_match_error_stop (void)
 }
 
 
+/* Match LOCK/UNLOCK statement. Syntax:
+     LOCK ( lock-variable [ , lock-stat-list ] )
+     UNLOCK ( lock-variable [ , sync-stat-list ] )
+   where lock-stat is ACQUIRED_LOCK or sync-stat
+   and sync-stat is STAT= or ERRMSG=.  */
+
+static match
+lock_unlock_statement (gfc_statement st)
+{
+  match m;
+  gfc_expr *tmp, *lockvar, *acq_lock, *stat, *errmsg;
+  bool saw_acq_lock, saw_stat, saw_errmsg;
+
+  tmp = lockvar = acq_lock = stat = errmsg = NULL;
+  saw_acq_lock = saw_stat = saw_errmsg = false;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("Image control statement SYNC at %C in PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+       gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+       return MATCH_ERROR;
+    }
+
+  if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+    {
+      gfc_error ("Image control statement SYNC at %C in CRITICAL block");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  if (gfc_match ("%e", &lockvar) != MATCH_YES)
+    goto syntax;
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_char (')');
+      if (m == MATCH_YES)
+	goto done;
+      goto syntax;
+    }
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+          tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+          tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" acquired_lock = %v", &tmp);
+      if (m == MATCH_ERROR || st == ST_UNLOCK)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_acq_lock)
+	    {
+	      gfc_error ("Redundant ACQUIRED_LOCK tag found at %L ",
+			 &tmp->where);
+	      goto cleanup;
+	    }
+	  acq_lock = tmp;
+	  saw_acq_lock = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+          tmp = NULL;
+	  break;
+	}
+
+      break;
+    }
+
+  if (m == MATCH_ERROR)
+    goto syntax;
+
+  if (gfc_match (" )%t") != MATCH_YES)
+    goto syntax;
+
+done:
+  switch (st)
+    {
+    case ST_LOCK:
+      new_st.op = EXEC_LOCK;
+      break;
+    case ST_UNLOCK:
+      new_st.op = EXEC_UNLOCK;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  new_st.expr1 = lockvar;
+  new_st.expr2 = stat;
+  new_st.expr3 = errmsg;
+  new_st.expr4 = acq_lock;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (st);
+
+cleanup:
+  gfc_free_expr (tmp);
+  gfc_free_expr (lockvar);
+  gfc_free_expr (acq_lock);
+  gfc_free_expr (stat);
+  gfc_free_expr (errmsg);
+
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_lock (void)
+{
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: LOCK statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return lock_unlock_statement (ST_LOCK);
+}
+
+
+match
+gfc_match_unlock (void)
+{
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: UNLOCK statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return lock_unlock_statement (ST_UNLOCK);
+}
+
+
 /* Match SYNC ALL/IMAGES/MEMORY statement. Syntax:
      SYNC ALL [(sync-stat-list)]
      SYNC MEMORY [(sync-stat-list)]
@@ -2345,7 +2531,7 @@  sync_statement (gfc_statement st)
       gfc_error ("Image control statement SYNC at %C in CRITICAL block");
       return MATCH_ERROR;
     }
-	
+
   if (gfc_match_eos () == MATCH_YES)
     {
       if (st == ST_SYNC_IMAGES)
@@ -2396,6 +2582,9 @@  sync_statement (gfc_statement st)
 
 	  if (gfc_match_char (',') == MATCH_YES)
 	    continue;
+
+	  tmp = NULL;
+	  break;
 	}
 
       m = gfc_match (" errmsg = %v", &tmp);
@@ -2413,16 +2602,17 @@  sync_statement (gfc_statement st)
 
 	  if (gfc_match_char (',') == MATCH_YES)
 	    continue;
-	}
 
-      gfc_gobble_whitespace ();
+	  tmp = NULL;
+	  break;
+	}
 
-      if (gfc_peek_char () == ')')
 	break;
-
-      goto syntax;
     }
 
+  if (m == MATCH_ERROR)
+    goto syntax;
+
   if (gfc_match (" )%t") != MATCH_YES)
     goto syntax;
 
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 69f1d9e..5a40d7a 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -74,6 +74,7 @@  match gfc_match_associate (void);
 match gfc_match_do (void);
 match gfc_match_cycle (void);
 match gfc_match_exit (void);
+match gfc_match_lock (void);
 match gfc_match_pause (void);
 match gfc_match_stop (void);
 match gfc_match_error_stop (void);
@@ -83,6 +84,7 @@  match gfc_match_goto (void);
 match gfc_match_sync_all (void);
 match gfc_match_sync_images (void);
 match gfc_match_sync_memory (void);
+match gfc_match_unlock (void);
 
 match gfc_match_allocate (void);
 match gfc_match_nullify (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index a47b457..6013931 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -398,6 +398,10 @@  decode_statement (void)
       match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
       break;
 
+    case 'l':
+      match ("lock", gfc_match_lock, ST_LOCK);
+      break;
+
     case 'm':
       match ("module% procedure", gfc_match_modproc, ST_MODULE_PROC);
       match ("module", gfc_match_module, ST_MODULE);
@@ -449,6 +453,7 @@  decode_statement (void)
       break;
 
     case 'u':
+      match ("unlock", gfc_match_unlock, ST_UNLOCK);
       match ("use", gfc_match_use, ST_USE);
       break;
 
@@ -953,7 +958,8 @@  next_statement (void)
   case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
   case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
   case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \
-  case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY
+  case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: \
+  case ST_LOCK: case ST_UNLOCK
 
 /* Statements that mark other executable statements.  */
 
@@ -1334,6 +1340,9 @@  gfc_ascii_statement (gfc_statement st)
     case ST_INTERFACE:
       p = "INTERFACE";
       break;
+    case ST_LOCK:
+      p = "LOCK";
+      break;
     case ST_PARAMETER:
       p = "PARAMETER";
       break;
@@ -1394,6 +1403,9 @@  gfc_ascii_statement (gfc_statement st)
     case ST_TYPE:
       p = "TYPE";
       break;
+    case ST_UNLOCK:
+      p = "UNLOCK";
+      break;
     case ST_USE:
       p = "USE";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6ca98f2..b2c3189 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8199,6 +8199,40 @@  find_reachable_labels (gfc_code *block)
 
 
 static void
+resolve_lock_unlock (gfc_code *code)
+{
+  /* FIXME: Add more lock-variable checks. For now, always reject it.
+     Note that ISO_FORTRAN_ENV's LOCK_TYPE is not yet available.  */
+  /* if (code->expr2->ts.type != BT_DERIVED
+	 || code->expr2->rank != 0
+	 || code->expr2->expr_type != EXPR_VARIABLE)  */
+  gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
+	     &code->expr1->where);
+
+  /* Check STAT.  */
+  if (code->expr2
+      && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
+	  || code->expr2->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr2->where);
+
+  /* Check ERRMSG.  */
+  if (code->expr3
+      && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
+	  || code->expr3->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr3->where);
+
+  /* Check ACQUIRED_LOCK.  */
+  if (code->expr4
+      && (code->expr4->ts.type != BT_LOGICAL || code->expr4->rank != 0
+	  || code->expr4->expr_type != EXPR_VARIABLE))
+    gfc_error ("ACQUIRED_LOCK= argument at %L must be a scalar LOGICAL "
+	       "variable", &code->expr4->where);
+}
+
+
+static void
 resolve_sync (gfc_code *code)
 {
   /* Check imageset. The * case matches expr1 == NULL.  */
@@ -9065,6 +9099,11 @@  resolve_code (gfc_code *code, gfc_namespace *ns)
 	  resolve_sync (code);
 	  break;
 
+	case EXEC_LOCK:
+	case EXEC_UNLOCK:
+	  resolve_lock_unlock (code);
+	  break;
+
 	case EXEC_ENTRY:
 	  /* Keep track of which entry we are up to.  */
 	  current_entry_id = code->ext.entry->id;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 6f8a234..cedb97c 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -113,6 +113,8 @@  gfc_free_statement (gfc_code *p)
     case EXEC_SYNC_ALL:
     case EXEC_SYNC_IMAGES:
     case EXEC_SYNC_MEMORY:
+    case EXEC_LOCK:
+    case EXEC_UNLOCK:
       break;
 
     case EXEC_BLOCK:
--- /dev/null	2011-06-06 07:23:08.586867510 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_1.f90	2011-06-06 23:24:56.000000000 +0200
@@ -0,0 +1,15 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=single -std=f2008" }
+!
+! LOCK/UNLOCK intrinsics
+!
+! PR fortran/18918
+!
+integer :: a[*]
+integer :: s
+character(len=3) :: c
+logical :: bool
+
+LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
+UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
+end
--- /dev/null	2011-06-06 07:23:08.586867510 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_2.f90	2011-06-06 23:24:33.000000000 +0200
@@ -0,0 +1,15 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=single -std=f2003" }
+!
+! LOCK/UNLOCK intrinsics
+!
+! PR fortran/18918
+!
+integer :: a[*] ! { dg-error "Fortran 2008: Coarray declaration" }
+integer :: s
+character(len=3) :: c
+logical :: bool
+
+LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "Fortran 2008: LOCK statement" }
+UNLOCK (a, stat=s, errmsg=c) ! { dg-error "Fortran 2008: UNLOCK statement" }
+end