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

	PR fortran/40632
	* interface.c: Include dependency.h.
	(compare_parameter): Add gfc_is_simply_contiguous checks.
	* symbol.c (gfc_add_contiguous): New function.
	(gfc_copy_attr, check_conflict): Handle contiguous attribute.
	* decl.c (match_attr_spec): Ditto.
	(gfc_match_contiguous): New function.
	* Make-lang.in (F95_PARSER_OBJS): Add dependency.h for
	interface.c.
	* resolve.c (resolve_fl_derived, resolve_symbol): Handle
	contiguous.
	* gfortran.h (symbol_attribute): Add contiguous.
	(gfc_add_contiguous): Add prototype.
	* match.h (gfc_match_contiguous): Add prototype. 
	* parse.c (decode_specification_statement,
	decode_statement): Handle contiguous attribute.
	* dependency.c (gfc_is_simply_contiguous): New function.
	* dependency.h (gfc_is_simply_contiguous): Add prototype.

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

	PR fortran/40632
	* gfortran.dg/contiguous_1.f90: New.
	* gfortran.dg/contiguous_2.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 160998)
+++ gcc/fortran/interface.c	(working copy)
@@ -69,6 +69,7 @@ along with GCC; see the file COPYING3.
 #include "system.h"
 #include "gfortran.h"
 #include "match.h"
+#include "dependency.h"  /* For gfc_is_simply_contiguous.  */
 
 /* The current_interface structure holds information about the
    interface currently being parsed.  This structure is saved and
@@ -1435,6 +1436,16 @@ compare_parameter (gfc_symbol *formal, g
       return 1;
     }
 
+  /* F2008, C1241.  */
+  if (formal->attr.pointer && formal->attr.contiguous
+      && !gfc_is_simply_contiguous (actual, true))
+    {
+      if (where)
+	gfc_error ("Actual argument to contiguous pointer dummy '%s' at %L "
+		   "must be simply contigous", formal->name, &actual->where);
+      return 0;
+    }
+
   if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
       && !gfc_compare_types (&formal->ts, &actual->ts))
     {
@@ -1502,6 +1513,34 @@ compare_parameter (gfc_symbol *formal, g
 			: actual->symtree->n.sym->as->corank);
 	  return 0;
 	}
+
+      /* F2008, 12.5.2.8.  */
+      if (formal->attr.dimension
+	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
+	  && !gfc_is_simply_contiguous (actual, true))
+	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must be simply "
+		       "contiguous", formal->name, &actual->where);
+	  return 0;
+	}
+    }
+
+  /* F2008, C1239/C1240.  */
+  if (actual->expr_type == EXPR_VARIABLE
+      && (actual->symtree->n.sym->attr.asynchronous
+         || actual->symtree->n.sym->attr.volatile_)
+      &&  (formal->attr.asynchronous || formal->attr.volatile_)
+      && actual->rank && !gfc_is_simply_contiguous (actual, true)
+      && ((formal->as->type != AS_ASSUMED_SHAPE && !formal->attr.pointer)
+	  || formal->attr.contiguous))
+    {
+      if (where)
+	gfc_error ("Dummy argument '%s' has to be a pointer or assumed-shape "
+		   "array without CONTIGUOUS attribute as actual argument at "
+		   "%L is not not simply contiguous and both are ASYNCHRONOUS "
+		   "or VOLATILE", formal->name, &actual->where);
+      return 0;
     }
 
   if (symbol_rank (formal) == actual->rank)
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 160998)
+++ gcc/fortran/symbol.c	(working copy)
@@ -372,7 +372,8 @@ check_conflict (symbol_attribute *attr,
     *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
     *volatile_ = "VOLATILE", *is_protected = "PROTECTED",
     *is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
-    *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION";
+    *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION",
+    *contiguous = "CONTIGUOUS";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -518,6 +519,7 @@ check_conflict (symbol_attribute *attr,
   conf (cray_pointer, cray_pointee);
   conf (cray_pointer, dimension);
   conf (cray_pointer, codimension);
+  conf (cray_pointer, contiguous);
   conf (cray_pointer, pointer);
   conf (cray_pointer, target);
   conf (cray_pointer, allocatable);
@@ -529,6 +531,7 @@ check_conflict (symbol_attribute *attr,
   conf (cray_pointer, entry);
 
   conf (cray_pointee, allocatable);
+  conf (cray_pointer, contiguous);
   conf (cray_pointer, codimension);
   conf (cray_pointee, intent);
   conf (cray_pointee, optional);
@@ -613,6 +616,7 @@ check_conflict (symbol_attribute *attr,
       conf2 (dummy);
       conf2 (volatile_);
       conf2 (asynchronous);
+      conf2 (contiguous);
       conf2 (pointer);
       conf2 (is_protected);
       conf2 (target);
@@ -720,6 +724,7 @@ check_conflict (symbol_attribute *attr,
       conf2 (function);
       conf2 (subroutine);
       conf2 (entry);
+      conf2 (contiguous);
       conf2 (pointer);
       conf2 (is_protected);
       conf2 (target);
@@ -928,6 +933,18 @@ gfc_add_dimension (symbol_attribute *att
 
 
 gfc_try
+gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  attr->contiguous = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
 gfc_add_external (symbol_attribute *attr, locus *where)
 {
 
@@ -1715,6 +1732,8 @@ gfc_copy_attr (symbol_attribute *dest, s
     goto fail;
   if (src->codimension && gfc_add_codimension (dest, NULL, where) == FAILURE)
     goto fail;
+  if (src->contiguous && gfc_add_contiguous (dest, NULL, where) == FAILURE)
+    goto fail;
   if (src->optional && gfc_add_optional (dest, where) == FAILURE)
     goto fail;
   if (src->pointer && gfc_add_pointer (dest, where) == FAILURE)
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 160998)
+++ gcc/fortran/decl.c	(working copy)
@@ -2875,8 +2875,8 @@ match_attr_spec (void)
     DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
     DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
     DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
-    DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_NONE,
-    GFC_DECL_END /* Sentinel */
+    DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS,
+    DECL_NONE, GFC_DECL_END /* Sentinel */
   }
   decl_types;
 
@@ -2939,6 +2939,7 @@ match_attr_spec (void)
 		    }
 		  break;
 		}
+	      break;
 
 	    case 'b':
 	      /* Try and match the bind(c).  */
@@ -2950,8 +2951,24 @@ match_attr_spec (void)
 	      break;
 
 	    case 'c':
-	      if (match_string_p ("codimension"))
-		d = DECL_CODIMENSION;
+	      gfc_next_ascii_char ();
+	      if ('o' != gfc_next_ascii_char ())
+		break;
+	      switch (gfc_next_ascii_char ())
+		{
+		case 'd':
+		  if (match_string_p ("imension"))
+		    {
+		      d = DECL_CODIMENSION;
+		      break;
+		    }
+		case 'n':
+		  if (match_string_p ("tiguous"))
+		    {
+		      d = DECL_CONTIGUOUS;
+		      break;
+		    }
+		}
 	      break;
 
 	    case 'd':
@@ -3144,6 +3161,9 @@ match_attr_spec (void)
 	  case DECL_CODIMENSION:
 	    attr = "CODIMENSION";
 	    break;
+	  case DECL_CONTIGUOUS:
+	    attr = "CONTIGUOUS";
+	    break;
 	  case DECL_DIMENSION:
 	    attr = "DIMENSION";
 	    break;
@@ -3214,7 +3234,7 @@ match_attr_spec (void)
       if (gfc_current_state () == COMP_DERIVED
 	  && d != DECL_DIMENSION && d != DECL_CODIMENSION
 	  && d != DECL_POINTER   && d != DECL_PRIVATE
-	  && d != DECL_PUBLIC && d != DECL_NONE)
+	  && d != DECL_PUBLIC && d != DECL_CONTIGUOUS && d != DECL_NONE)
 	{
 	  if (d == DECL_ALLOCATABLE)
 	    {
@@ -3283,6 +3303,15 @@ match_attr_spec (void)
 	  t = gfc_add_codimension (&current_attr, NULL, &seen_at[d]);
 	  break;
 
+	case DECL_CONTIGUOUS:
+	  if (gfc_notify_std (GFC_STD_F2008,
+			      "Fortran 2008: CONTIGUOUS attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_contiguous (&current_attr, NULL, &seen_at[d]);
+	  break;
+
 	case DECL_DIMENSION:
 	  t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
 	  break;
@@ -6118,6 +6147,20 @@ gfc_match_codimension (void)
 
   return attr_decl ();
 }
+
+
+match
+gfc_match_contiguous (void)
+{
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTIGUOUS statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_clear_attr (&current_attr);
+  current_attr.contiguous = 1;
+
+  return attr_decl ();
+}
 
 
 match
Index: gcc/fortran/Make-lang.in
===================================================================
--- gcc/fortran/Make-lang.in	(revision 160998)
+++ gcc/fortran/Make-lang.in	(working copy)
@@ -324,7 +324,8 @@ $(F95_PARSER_OBJS): fortran/gfortran.h f
 		fortran/parse.h fortran/arith.h fortran/target-memory.h \
 		$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
 		$(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \
-		$(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) 
+		$(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) \
+		fortran/dependency.h
 fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h
 
 GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/libgfortran.h \
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 160998)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -665,7 +665,8 @@ typedef struct
   unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
     optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
-    implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1;
+    implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
+    contiguous:1;
 
   /* For CLASS containers, the pointer attribute is sometimes set internally
      even though it was not directly specified.  In this case, keep the
@@ -2437,6 +2438,7 @@ gfc_try gfc_add_attribute (symbol_attrib
 gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
 gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
 gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
 gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
 gfc_try gfc_add_external (symbol_attribute *, locus *);
 gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 160998)
+++ gcc/fortran/resolve.c	(working copy)
@@ -10784,6 +10826,14 @@ resolve_fl_derived (gfc_symbol *sym)
 	  return FAILURE;
 	}
 
+      /* F2008, C448.  */
+      if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
+	{
+	  gfc_error ("Component '%s' at %L has the CONTIGUOUS attribute but "
+		     "is not an array pointer", c->name, &c->loc);
+	  return FAILURE;
+	}
+
       if (c->attr.proc_pointer && c->ts.interface)
 	{
 	  if (c->ts.interface->attr.procedure && !sym->attr.vtype)
@@ -11400,6 +11450,18 @@ resolve_symbol (gfc_symbol *sym)
       return;
     }
 
+
+  /* F2008, C530. */
+  if (sym->attr.contiguous
+      && (!sym->attr.dimension || (sym->as->type != AS_ASSUMED_SHAPE
+				   && !sym->attr.pointer)))
+    {
+      gfc_error ("'%s' at %L has the CONTIGUOUS attribute but is not an "
+		  "array pointer or an assumed-shape array", sym->name,
+		  &sym->declared_at);
+      return;
+    }
+
   if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE)
     return;
 
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 160998)
+++ gcc/fortran/match.h	(working copy)
@@ -168,6 +168,7 @@ void gfc_set_constant_character_len (int
 match gfc_match_allocatable (void);
 match gfc_match_asynchronous (void);
 match gfc_match_codimension (void);
+match gfc_match_contiguous (void);
 match gfc_match_dimension (void);
 match gfc_match_external (void);
 match gfc_match_gcc_attributes (void);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 160998)
+++ gcc/fortran/parse.c	(working copy)
@@ -139,6 +139,7 @@ decode_specification_statement (void)
 
     case 'c':
       match ("codimension", gfc_match_codimension, ST_ATTR_DECL);
+      match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
       break;
 
     case 'd':
@@ -346,6 +347,7 @@ decode_statement (void)
       match ("call", gfc_match_call, ST_CALL);
       match ("close", gfc_match_close, ST_CLOSE);
       match ("continue", gfc_match_continue, ST_CONTINUE);
+      match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
       match ("cycle", gfc_match_cycle, ST_CYCLE);
       match ("case", gfc_match_case, ST_CASE);
       match ("common", gfc_match_common, ST_COMMON);
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 160998)
+++ gcc/fortran/dependency.c	(working copy)
@@ -1589,3 +1589,92 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref
   return fin_dep == GFC_DEP_OVERLAP;
 }
 
+
+/* Check whether an expression is "simply contiguous", cf. F2008, 6.5.4.
+   Note: A scalar is not regarded as "simply contiguous" by the standard.
+   if bool is not strict, some futher checks are done - for instance,
+   a "(::1)" is accepted.  */
+
+bool
+gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
+{
+  bool colon;
+  int i;
+  gfc_array_ref *ar = NULL;
+  gfc_ref *ref, *part_ref = NULL;
+
+  if (expr->expr_type == EXPR_FUNCTION)
+    return expr->symtree->n.sym->result->attr.contiguous;
+  else if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (expr->rank == 0)
+    return false;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT)
+	part_ref  = ref;
+      else if (ref->type == REF_SUBSTRING)
+	  return false;
+      else
+	{
+	  if (ar)
+	    return false; /* Array shall be last part-ref. */
+	  if (ref->u.ar.type != AR_ELEMENT)
+	    ar = &ref->u.ar;
+	}
+    }
+
+  if ((part_ref && !part_ref->u.c.component->attr.contiguous
+       && part_ref->u.c.component->attr.pointer)
+      || (!part_ref && !expr->symtree->n.sym->attr.contiguous
+	  && (expr->symtree->n.sym->attr.pointer
+	      || expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)))
+    return false;
+
+  if (!ar || ar->type == AR_FULL)
+    return true;
+
+  gcc_assert (ar->type != AR_UNKNOWN);
+
+  /* Check for simply contiguous array */
+  colon = true;  
+  for (i = 0; i < ar->dimen; i++)
+    {
+      gcc_assert (ar->dimen_type[i] != DIMEN_UNKNOWN);
+
+      if (ar->dimen_type[i] == DIMEN_VECTOR)
+	return false;
+
+      /* Element or section. Following the standard, "(::1)" or - if known at
+	 compile time - "(lbound:ubound)" are not simply contigous; if strict
+	 is false, they are regarded as simple contiguous.  */
+
+      if (ar->stride[i] && (strict || gfc_expr_is_one (ar->stride[i], 0)))
+	return false;
+
+      if (ar->start[i]
+	  && (strict || ar->start[i]->expr_type != EXPR_CONSTANT
+	      || ar->as->lower[i]->expr_type != EXPR_CONSTANT
+	      || mpz_cmp (ar->start[i]->value.integer,
+			  ar->as->lower[i]->value.integer) != 0))
+	{ 
+	  if (!colon)
+	    return false;
+	  colon = false;
+	}
+      if (ar->end[i]
+	  && (strict || ar->end[i]->expr_type != EXPR_CONSTANT
+	      || ar->as->upper[i]->expr_type != EXPR_CONSTANT
+	      || mpz_cmp (ar->end[i]->value.integer,
+			  ar->as->upper[i]->value.integer) != 0))
+	{
+	  if (!colon)
+	    return false;
+	  colon = false;
+	}
+    }
+  
+  return true;
+}
Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h	(revision 160998)
+++ gcc/fortran/dependency.h	(working copy)
@@ -43,3 +43,5 @@ int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *);
 int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
+bool gfc_is_simply_contiguous (gfc_expr *, bool);
+
Index: gcc/testsuite/gfortran.dg/contiguous_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/contiguous_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/contiguous_1.f90	(revision 0)
@@ -0,0 +1,165 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests
+!
+
+! C448: Must be an array with POINTER attribute
+type t1
+  integer, contiguous :: ca(5) ! { dg-error "Component .ca. at .1. has the CONTIGUOUS" }
+end type t1
+type t2
+  integer, contiguous, allocatable :: cb(:) ! { dg-error "Component .cb. at .1. has the CONTIGUOUS" }
+end type t2
+type t3
+  integer, contiguous, pointer :: cc(:) ! OK
+end type t3
+type t4
+  integer, pointer, contiguous :: cd ! { dg-error "Component .cd. at .1. has the CONTIGUOUS" }
+end type t4
+end
+
+! C530: Must be an array and (a) a POINTER or (b) assumed shape.
+subroutine test(x, y)
+  integer, pointer :: x(:)
+  integer, intent(in) :: y(:)
+  contiguous :: x, y
+
+  integer, contiguous :: a(5) ! { dg-error ".a. at .1. has the CONTIGUOUS attribute" }
+  integer, contiguous, allocatable :: b(:) ! { dg-error ".b. at .1. has the CONTIGUOUS attribute" }
+  integer, contiguous, pointer :: c(:) ! OK
+  integer, pointer, contiguous :: d ! { dg-error ".d. at .1. has the CONTIGUOUS attribute" }
+end
+
+! Pointer assignment check:
+! If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous.
+! Note: This is not compile-time checkable; but F2008, 5.3.7 except in a very few cases.
+subroutine ptr_assign()
+  integer, pointer, contiguous :: ptr1(:)
+  integer, target :: tgt(5)
+  ptr1 => tgt
+end subroutine
+
+
+! C1239 (R1223) If an actual argument is a nonpointer array that has the ASYNCHRONOUS or VOLATILE
+! attribute but is not simply contiguous (6.5.4), and the corresponding dummy argument has either the
+! VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an assumed-shape array
+! that does not have the CONTIGUOUS attribute.
+
+subroutine C1239
+  type t
+    integer :: e(4)
+  end type t
+  type(t), volatile :: f
+  integer, asynchronous :: a(4), b(4)
+  integer, volatile :: c(4), d(4)
+  call test (a,b,c)      ! OK
+  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test (a,b,f%e)      ! OK
+  call test (a,f%e,c)      ! OK
+  call test (f%e,b,c)      ! OK
+  call test (a,b,f%e(::2)) ! OK
+  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+contains
+  subroutine test(u, v, w)
+    integer, asynchronous :: u(:), v(*)
+    integer, volatile :: w(:)
+    contiguous :: u
+  end subroutine test
+end subroutine C1239
+
+
+! C1240 (R1223) If an actual argument is an array pointer that has the ASYNCHRONOUS or VOLATILE
+! attribute but does not have the CONTIGUOUS attribute, and the corresponding dummy argument has
+! either the VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an array pointer
+! or an assumed-shape array that does not have the CONTIGUOUS attribute.
+
+subroutine C1240
+  type t
+    integer,pointer :: e(:)
+  end type t
+  type(t), volatile :: f
+  integer, pointer, asynchronous :: a(:), b(:)
+  integer,pointer, volatile :: c(:), d(:)
+  call test (a,b,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test (a,b,f%e)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,f%e,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e,b,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,b,f%e(::2)) ! { dg-error "array without CONTIGUOUS" }
+  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test2(a,b)
+  call test3(a,b)
+  call test2(c,d)
+  call test3(c,d)
+  call test2(f%e,d)
+  call test3(c,f%e)
+contains
+  subroutine test(u, v, w)
+    integer, asynchronous :: u(:), v(*)
+    integer, volatile :: w(:)
+    contiguous :: u
+  end subroutine test
+  subroutine test2(x,y)
+    integer, asynchronous :: x(:)
+    integer, volatile :: y(:)
+  end subroutine test2 
+  subroutine test3(x,y)
+    integer, pointer, asynchronous :: x(:)
+    integer, pointer, volatile :: y(:)
+  end subroutine test3
+end subroutine C1240
+
+
+
+! 12.5.2.7 Pointer dummy variables
+! C1241 The actual argument corresponding to a dummy pointer with the CONTIGUOUS attribute shall be
+! simply contiguous (6.5.4).
+
+subroutine C1241
+  integer, pointer, contiguous :: a(:)
+  integer, pointer :: b(:)
+  call test(a)
+  call test(b) ! { dg-error "must be simply contigous" }
+contains
+  subroutine test(x)
+    integer, pointer, contiguous :: x(:)
+  end subroutine test
+end subroutine C1241
+
+
+! 12.5.2.8 Coarray dummy variables
+! If the dummy argument is an array coarray that has the CONTIGUOUS attribute or is not of assumed shape,
+! the corresponding actual argument shall be simply contiguous
+
+subroutine sect12528(cob)
+  integer, save :: coa(6)[*]
+  integer :: cob(:)[*]
+
+  call test(coa)
+  call test2(coa)
+  call test3(coa)
+
+  call test(cob) ! { dg-error "must be simply contiguous" }
+  call test2(cob) ! { dg-error "must be simply contiguous" }
+  call test3(cob)
+contains
+  subroutine test(x)
+    integer, contiguous :: x(:)[*]
+  end subroutine test
+  subroutine test2(x)
+    integer :: x(*)[*]
+  end subroutine test2
+  subroutine test3(x)
+    integer :: x(:)[*]
+  end subroutine test3
+end subroutine sect12528
Index: gcc/testsuite/gfortran.dg/contiguous_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/contiguous_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/contiguous_2.f90	(revision 0)
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests
+!
+
+integer, pointer, contiguous :: a(:) ! { dg-error "Fortran 2008:" }
+integer, pointer :: b(:)
+contiguous :: b ! { dg-error "Fortran 2008:" }
+end