diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1a0ec410cf801ef39b03e9d3423c6abb2524626f..489ae1bc0cb4ea95ae28196e124de308d94d3e71 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/72714
+	* resolve.c (resolve_allocate_expr): Add some tests for coarrays.
+
 2019-03-02  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/89516
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 422cec29cdd9d17669f9f65ef161fcb942b456b7..955978bf1ec6561d08926248727bf9e110981526 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7766,13 +7766,54 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 
   if (codimension)
     for (i = ar->dimen; i < ar->dimen + ar->codimen; i++)
-      if (ar->dimen_type[i] == DIMEN_THIS_IMAGE)
-	{
-	  gfc_error ("Coarray specification required in ALLOCATE statement "
-		     "at %L", &e->where);
-	  goto failure;
-	}
+      {
+	switch (ar->dimen_type[i])
+	  {
+	  case DIMEN_THIS_IMAGE:
+	    gfc_error ("Coarray specification required in ALLOCATE statement "
+		       "at %L", &e->where);
+	    goto failure;
+
+	  case  DIMEN_RANGE:
+	    if (ar->start[i] == 0 || ar->end[i] == 0)
+	      {
+		/* If ar->stride[i] is NULL, we issued a previous error.  */
+		if (ar->stride[i] == NULL)
+		  gfc_error ("Bad array specification in ALLOCATE statement "
+			     "at %L", &e->where);
+		goto failure;
+	      }
+	    else if (gfc_dep_compare_expr (ar->start[i], ar->end[i]) == 1)
+	      {
+		gfc_error ("Upper cobound is less than lower cobound at %L",
+			   &ar->start[i]->where);
+		goto failure;
+	      }
+	    break;
+
+	  case DIMEN_ELEMENT:
+	    if (ar->start[i]->expr_type == EXPR_CONSTANT)
+	      {
+		gcc_assert (ar->start[i]->ts.type == BT_INTEGER);
+		if (mpz_cmp_si (ar->start[i]->value.integer, 1) < 0)
+		  {
+		    gfc_error ("Upper cobound is less than lower cobound "
+			       " of 1 at %L", &ar->start[i]->where);
+		    goto failure;
+		  }
+	      }
+	    break;
+
+	  case DIMEN_STAR:
+	    break;
 
+	  default:
+	    gfc_error ("Bad array specification in ALLOCATE statement at %L",
+		       &e->where);
+	    goto failure;
+
+	  }
+      }
   for (i = 0; i < ar->dimen; i++)
     {
       if (ar->type == AR_ELEMENT || ar->type == AR_FULL)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 92c9b1e8f7f62adf62869d5f9feb766a17269098..e7b54ea788216df7dff1cb8dd42a73d0ac509037 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/72714
+	* gfortran.dg/coarray_allocate_11.f90: New test.
+
 2019-03-02  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/89516
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90 b/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0e806f0955b3ce27cb77bbe9551ca1c6bf161cfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-additional-options -fcoarray=single }
+program p
+   integer, allocatable :: z[:,:]
+   integer :: i
+   allocate (z[1:,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
+   allocate (z[:2,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
+   allocate (z[2:1,*]) ! { dg-error "Upper cobound is less than lower cobound" }
+   allocate (z[:0,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
+   allocate (z[0,*]) ! { dg-error "Upper cobound is less than lower cobound" }
+   allocate (z[1,*]) ! This is OK
+   allocate (z[1:1,*]) ! This is OK
+   allocate (z[i:i,*]) ! This is OK
+   allocate (z[i:i-1,*]) ! { dg-error "Upper cobound is less than lower cobound" }
+end