Patchwork [Fortran] PR 40632 - Add CONTIGUOUS attribute (part 1)

login
register
mail settings
Submitter Tobias Burnus
Date June 18, 2010, 10:57 p.m.
Message ID <4C1BF9BE.3010209@net-b.de>
Download mbox | patch
Permalink /patch/56228/
State New
Headers show

Comments

Tobias Burnus - June 18, 2010, 10:57 p.m.
Tobias Burnus wrote:
> The patch implements the parsing and the constraint checking. The next
> step is to use it also for procedure calls and for array operations

This patch now does this; the right-most stride (dim[0]) is now one and
there is no (un)pack done for procedure calls. Additionally, I added
module and dump-parse-tree support, which I initially forgot.

While the patch should be OK, I would be happy if someone could
carefully read the patch; especially, the constraints, the
simply-contiguous conditions and the trans*c part.

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

Tobias
Mikael Morin - June 19, 2010, 7:45 a.m.
On 19.06.2010 00:57, Tobias Burnus wrote:
> Tobias Burnus wrote:
>> The patch implements the parsing and the constraint checking. The next
>> step is to use it also for procedure calls and for array operations
>
> This patch now does this; the right-most stride (dim[0]) is now one and
> there is no (un)pack done for procedure calls. Additionally, I added
> module and dump-parse-tree support, which I initially forgot.
>
> While the patch should be OK, I would be happy if someone could
> carefully read the patch; especially, the constraints, the
> simply-contiguous conditions and the trans*c part.
>
> Build and currently regtesting on x86-64-linux.
> OK for the trunk?
>
> Tobias
Hello,

I have little time, so this is FastReview(TM).

> Index: gcc/fortran/interface.c
> ===================================================================
> --- gcc/fortran/interface.c	(Revision 161011)
> +++ gcc/fortran/interface.c	(Arbeitskopie)
> @@ -1435,6 +1435,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 +1512,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;
>      }
The error message is a bit cryptic to me.

> Index: gcc/fortran/expr.c
> ===================================================================
> --- gcc/fortran/expr.c	(Revision 161011)
> +++ gcc/fortran/expr.c	(Arbeitskopie)
> @@ -4080,3 +4080,95 @@ gfc_has_ultimate_pointer (gfc_expr *e)
>    else
>      return false;
>  }
> +
> +
> +/* 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. */
I think this should be outside the else block. For array(:)%component cases.

> +	  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);
You can even assert that ar->type == AR_SECTION.


> +
> +  /* 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 || ar->stride[i]->expr_type != EXPR_CONSTANT
> +			    || ar->stride[i]->ts.type != BT_INTEGER
> +			    || mpz_cmp_si (expr->value.integer, 1) != 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;
> +}
I think you are not rejecting the case array(:,1,:)

Otherwise OK.
Thanks,

Mikael
Tobias Burnus - June 19, 2010, 9:02 a.m.
Hi Mikael,

thanks for the fast review!

I agree that the error message is a bit cryptic, but do you (or anyone
else) have a better suggestion? The constraints are also rather lengthy
and convoluted:

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.

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.

Mikael Morin wrote:
>> +  /* 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->typI have to checke != 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;
>>      }
> The error message is a bit cryptic to me. 

It becomes a bit clearer if one replaces "both" by "actual and dummy
argument" - but that's even longer.

 * * *

> I think you are not rejecting the case array(:,1,:)

I have to check. I think you are right. Additionally, the following
program give the wrong result; I don't know whether it should be
accepted with copy-in/copy-out or whether it should be rejected at
compiler time, but instead of 1,3,5,7 it prints with the patch 1,2,3,4.
(The program might even be invalid, but then it can and should be
rejected at compile time. crayftn accepts it,)

Thus, back to the standard and the drawing board - I need to recheck
again what has to be done and think about what should be done. Somehow
the concept of being "contiguous" sounds so simple, but specifying it
(in the standard) and implementing it, is more difficult than expected -
especially, in the general case, it is impossible to tell at compile
time whether an object is contiguous or not - only whether it is simply
contiguous can be checked.

implicit none
integer :: a(8),i
a = [(i,i=1,8)]
call foo(a(::2))
contains
subroutine foo(x)
  integer, contiguous :: x(:)
  print *, x
  if (any (x != [1,3,5,7])) call abort()
end subroutine
end

Tobias

Patch

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

	PR fortran/40632
	* interface.c (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.
	* resolve.c (resolve_fl_derived, resolve_symbol): Handle
	contiguous.
	* gfortran.h (symbol_attribute): Add contiguous.
	(gfc_is_simply_contiguous): Add prototype.
	(gfc_add_contiguous): Add prototype.
	* match.h (gfc_match_contiguous): Add prototype. 
	* parse.c (decode_specification_statement,
	decode_statement): Handle contiguous attribute.
	* expr.c (gfc_is_simply_contiguous): New function.
	* dump-parse-tree.c (show_attr): Handle contiguous.
	* module.c (ab_attribute, attr_bits, mio_symbol_attribute):
	Ditto.
	* trans-expr.c (gfc_add_interface_mapping): Copy
	attr.contiguous.
	* trans-array.c (gfc_conv_descriptor_stride_get,
	gfc_conv_array_parameter): Handle contiguous arrays.
	* trans-types.c (gfc_build_array_type, gfc_build_array_type,
	gfc_sym_type, gfc_get_derived_type, gfc_get_array_descr_info):
	Ditto.
	* trans.h (gfc_array_kind): Ditto.
	* trans-decl.c (gfc_get_symbol_decl): Ditto.

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

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

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 161011)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -1435,6 +1435,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 +1512,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/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 161011)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1718,6 +1718,7 @@  gfc_add_interface_mapping (gfc_interface
   new_sym->as = gfc_copy_array_spec (sym->as);
   new_sym->attr.referenced = 1;
   new_sym->attr.dimension = sym->attr.dimension;
+  new_sym->attr.contiguous = sym->attr.contiguous;
   new_sym->attr.codimension = sym->attr.codimension;
   new_sym->attr.pointer = sym->attr.pointer;
   new_sym->attr.allocatable = sym->attr.allocatable;
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 161011)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -285,7 +285,9 @@  gfc_conv_descriptor_stride_get (tree des
   tree type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
   if (integer_zerop (dim)
-      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+      && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
     return gfc_index_one_node;
 
   return gfc_conv_descriptor_stride (desc, dim);
@@ -5515,6 +5517,7 @@  gfc_conv_array_parameter (gfc_se * se, g
   bool array_constructor;
   bool good_allocatable;
   bool ultimate_ptr_comp;
+  bool ultimate_contiguous;
   bool ultimate_alloc_comp;
   gfc_symbol *sym;
   stmtblock_t block;
@@ -5522,6 +5525,10 @@  gfc_conv_array_parameter (gfc_se * se, g
 
   ultimate_ptr_comp = false;
   ultimate_alloc_comp = false;
+  ultimate_contiguous = (expr->expr_type == EXPR_VARIABLE
+			 || expr->expr_type == EXPR_FUNCTION)
+			? expr->symtree->n.sym->attr.contiguous : false;
+
   for (ref = expr->ref; ref; ref = ref->next)
     {
       if (ref->next == NULL)
@@ -5530,6 +5537,7 @@  gfc_conv_array_parameter (gfc_se * se, g
       if (ref->type == REF_COMPONENT)
 	{
 	  ultimate_ptr_comp = ref->u.c.component->attr.pointer;
+	  ultimate_contiguous = ref->u.c.component->attr.contiguous;
 	  ultimate_alloc_comp = ref->u.c.component->attr.allocatable;
 	}
     }
@@ -5608,7 +5616,7 @@  gfc_conv_array_parameter (gfc_se * se, g
   contiguous = g77 && !this_array_result && contiguous;
 
   /* There is no need to pack and unpack the array, if it is contiguous
-     and not deferred or assumed shape.  */
+     and not a non-CONTIGUOUS deferred- or assumed-shape array.  */
   no_pack = ((sym && sym->as
 		  && !sym->attr.pointer
 		  && sym->as->type != AS_DEFERRED
@@ -5616,7 +5624,9 @@  gfc_conv_array_parameter (gfc_se * se, g
 		      ||
 	     (ref && ref->u.ar.as
 		  && ref->u.ar.as->type != AS_DEFERRED
-		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE));
+		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
+		      ||
+	     ultimate_contiguous);
 
   no_pack = contiguous && no_pack;
 
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 161011)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -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 161011)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -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/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c	(Revision 161011)
+++ gcc/fortran/dump-parse-tree.c	(Arbeitskopie)
@@ -598,6 +598,8 @@  show_attr (symbol_attribute *attr)
     fputs (" CODIMENSION", dumpfile);
   if (attr->dimension)
     fputs (" DIMENSION", dumpfile);
+  if (attr->contiguous)
+    fputs (" CONTIGUOUS", dumpfile);
   if (attr->external)
     fputs (" EXTERNAL", dumpfile);
   if (attr->intrinsic)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 161011)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -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 *);
@@ -2614,6 +2616,7 @@  void gfc_free_actual_arglist (gfc_actual
 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
 const char *gfc_extract_int (gfc_expr *, int *);
 bool is_subref_array (gfc_expr *);
+bool gfc_is_simply_contiguous (gfc_expr *, bool);
 
 gfc_expr *gfc_build_conversion (gfc_expr *);
 void gfc_free_ref_list (gfc_ref *);
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(Revision 161011)
+++ gcc/fortran/expr.c	(Arbeitskopie)
@@ -4080,3 +4080,95 @@  gfc_has_ultimate_pointer (gfc_expr *e)
   else
     return false;
 }
+
+
+/* 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 || ar->stride[i]->expr_type != EXPR_CONSTANT
+			    || ar->stride[i]->ts.type != BT_INTEGER
+			    || mpz_cmp_si (expr->value.integer, 1) != 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/module.c
===================================================================
--- gcc/fortran/module.c	(Revision 161011)
+++ gcc/fortran/module.c	(Arbeitskopie)
@@ -1675,7 +1675,7 @@  typedef enum
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
   AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
   AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
-  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB
+  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS
 }
 ab_attribute;
 
@@ -1685,6 +1685,7 @@  static const mstring attr_bits[] =
     minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
     minit ("DIMENSION", AB_DIMENSION),
     minit ("CODIMENSION", AB_CODIMENSION),
+    minit ("CONTIGUOUS", AB_CONTIGUOUS),
     minit ("EXTERNAL", AB_EXTERNAL),
     minit ("INTRINSIC", AB_INTRINSIC),
     minit ("OPTIONAL", AB_OPTIONAL),
@@ -1807,6 +1808,8 @@  mio_symbol_attribute (symbol_attribute *
 	MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
       if (attr->codimension)
 	MIO_NAME (ab_attribute) (AB_CODIMENSION, attr_bits);
+      if (attr->contiguous)
+	MIO_NAME (ab_attribute) (AB_CONTIGUOUS, attr_bits);
       if (attr->external)
 	MIO_NAME (ab_attribute) (AB_EXTERNAL, attr_bits);
       if (attr->intrinsic)
@@ -1915,6 +1918,9 @@  mio_symbol_attribute (symbol_attribute *
 	    case AB_CODIMENSION:
 	      attr->codimension = 1;
 	      break;
+	    case AB_CONTIGUOUS:
+	      attr->contiguous = 1;
+	      break;
 	    case AB_EXTERNAL:
 	      attr->external = 1;
 	      break;
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(Revision 161011)
+++ gcc/fortran/trans-types.c	(Arbeitskopie)
@@ -1202,7 +1202,8 @@  gfc_is_nodesc_array (gfc_symbol * sym)
 
 static tree
 gfc_build_array_type (tree type, gfc_array_spec * as,
-		      enum gfc_array_kind akind, bool restricted)
+		      enum gfc_array_kind akind, bool restricted,
+		      bool contiguous)
 {
   tree lbound[GFC_MAX_DIMENSIONS];
   tree ubound[GFC_MAX_DIMENSIONS];
@@ -1219,7 +1220,8 @@  gfc_build_array_type (tree type, gfc_arr
     }
 
   if (as->type == AS_ASSUMED_SHAPE)
-    akind = GFC_ARRAY_ASSUMED_SHAPE;
+    akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
+		       : GFC_ARRAY_ASSUMED_SHAPE;
   return gfc_get_array_type_bounds (type, as->rank, as->corank, lbound,
 				    ubound, 0, akind, restricted);
 }
@@ -1799,10 +1801,12 @@  gfc_sym_type (gfc_symbol * sym)
 	{
 	  enum gfc_array_kind akind = GFC_ARRAY_UNKNOWN;
 	  if (sym->attr.pointer)
-	    akind = GFC_ARRAY_POINTER;
+	    akind = sym->attr.contiguous ? GFC_ARRAY_POINTER_CONT
+					 : GFC_ARRAY_POINTER;
 	  else if (sym->attr.allocatable)
 	    akind = GFC_ARRAY_ALLOCATABLE;
-	  type = gfc_build_array_type (type, sym->as, akind, restricted);
+	  type = gfc_build_array_type (type, sym->as, akind, restricted,
+				       sym->attr.contiguous);
 	}
     }
   else
@@ -2121,14 +2125,16 @@  gfc_get_derived_type (gfc_symbol * deriv
 	    {
 	      enum gfc_array_kind akind;
 	      if (c->attr.pointer)
-		akind = GFC_ARRAY_POINTER;
+		akind = c->attr.contiguous ? GFC_ARRAY_POINTER_CONT
+					   : GFC_ARRAY_POINTER;
 	      else
 		akind = GFC_ARRAY_ALLOCATABLE;
 	      /* Pointers to arrays aren't actually pointer types.  The
 	         descriptors are separate, but the data is common.  */
 	      field_type = gfc_build_array_type (field_type, c->as, akind,
 						 !c->attr.target
-						 && !c->attr.pointer);
+						 && !c->attr.pointer,
+						 c->attr.contiguous);
 	    }
 	  else
 	    field_type = gfc_get_nodesc_array_type (field_type, c->as,
@@ -2516,7 +2522,8 @@  gfc_get_array_descr_info (const_tree typ
   if (int_size_in_bytes (etype) <= 0)
     return false;
   /* Nor non-constant lower bounds in assumed shape arrays.  */
-  if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE)
+  if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE
+      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT)
     {
       for (dim = 0; dim < rank; dim++)
 	if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE
@@ -2565,7 +2572,8 @@  gfc_get_array_descr_info (const_tree typ
   if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     info->allocated = build2 (NE_EXPR, boolean_type_node,
 			      info->data_location, null_pointer_node);
-  else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER)
+  else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
+	   || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
     info->associated = build2 (NE_EXPR, boolean_type_node,
 			       info->data_location, null_pointer_node);
 
@@ -2579,7 +2587,8 @@  gfc_get_array_descr_info (const_tree typ
 		  size_binop (PLUS_EXPR, dim_off, upper_suboff));
       t = build1 (INDIRECT_REF, gfc_array_index_type, t);
       info->dimen[dim].upper_bound = t;
-      if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE)
+      if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE
+	  || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT)
 	{
 	  /* Assumed shape arrays have known lower bounds.  */
 	  info->dimen[dim].upper_bound
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 161011)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -620,14 +620,17 @@  extern GTY(()) tree gfor_fndecl_sr_kind;
 /* True if node is an integer constant.  */
 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
 
-/* G95-specific declaration information.  */
+/* gfortran-specific declaration information, the _CONT versions denote
+   arrays with CONTIGUOUS attribute.  */
 
 enum gfc_array_kind
 {
   GFC_ARRAY_UNKNOWN,
   GFC_ARRAY_ASSUMED_SHAPE,
+  GFC_ARRAY_ASSUMED_SHAPE_CONT,
   GFC_ARRAY_ALLOCATABLE,
-  GFC_ARRAY_POINTER
+  GFC_ARRAY_POINTER,
+  GFC_ARRAY_POINTER_CONT
 };
 
 /* Array types only.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 161011)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -10826,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)
@@ -11397,6 +11405,7 @@  resolve_symbol (gfc_symbol *sym)
 	  sym->attr.pure = ifc->attr.pure;
 	  sym->attr.elemental = ifc->attr.elemental;
 	  sym->attr.dimension = ifc->attr.dimension;
+	  sym->attr.contiguous = ifc->attr.contiguous;
 	  sym->attr.recursive = ifc->attr.recursive;
 	  sym->attr.always_explicit = ifc->attr.always_explicit;
           sym->attr.ext_attr |= ifc->attr.ext_attr;
@@ -11442,6 +11451,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;
 
@@ -11500,6 +11521,7 @@  resolve_symbol (gfc_symbol *sym)
 		  sym->attr.dimension = sym->result->attr.dimension;
 		  sym->attr.pointer = sym->result->attr.pointer;
 		  sym->attr.allocatable = sym->result->attr.allocatable;
+		  sym->attr.contiguous = sym->result->attr.contiguous;
 		}
 	    }
 	}
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 161011)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -1213,7 +1213,8 @@  gfc_get_symbol_decl (gfc_symbol * sym)
       /* Create variables to hold the non-constant bits of array info.  */
       gfc_build_qualified_array (decl, sym);
 
-      if ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer)
+      if (sym->attr.contiguous
+	  || ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer))
 	GFC_DECL_PACKED_ARRAY (decl) = 1;
     }
 
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(Revision 161011)
+++ gcc/fortran/match.h	(Arbeitskopie)
@@ -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 161011)
+++ gcc/fortran/parse.c	(Arbeitskopie)
@@ -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 161011)
+++ gcc/fortran/dependency.c	(Arbeitskopie)
@@ -1588,4 +1588,3 @@  gfc_dep_resolver (gfc_ref *lref, gfc_ref
 
   return fin_dep == GFC_DEP_OVERLAP;
 }
-
Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h	(Revision 161011)
+++ gcc/fortran/dependency.h	(Arbeitskopie)
@@ -43,3 +43,4 @@  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 *);
+
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
Index: gcc/testsuite/gfortran.dg/contiguous_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/contiguous_3.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/contiguous_3.f90	(Revision 0)
@@ -0,0 +1,35 @@ 
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests: Check that contigous
+! works properly.
+
+subroutine t(a,b)
+  integer, pointer, contiguous :: a(:)
+  call foo(a)
+  call foo(a(::1))
+  call foo(a(::2))
+contains
+  subroutine foo(b)
+    integer :: b(*)
+  end subroutine foo
+end subroutine t
+
+subroutine t2(a1,b1,c2,d2)
+  integer, pointer, contiguous :: a1(:), b1(:)
+  integer, pointer :: c2(:), d2(:)
+  a1 = b1
+  c2 = d2
+end subroutine t2
+
+! { dg-final { scan-tree-dump-times "_internal_pack" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_internal_unpack" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "= a1->dim.0..stride;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "= b1->dim.0..stride;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "= c2->dim.0..stride;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "= d2->dim.0..stride;" 1 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }