This patch handles for -fcoarray=lib the passing of the token and
offset argument nonallocatable coarrays.

The patch works fine for descriptorless arrays, but it is not well
tested.

Currently, it fails if one passes a coarray to to an assumed-shape
dummy argument. That passes a descriptor w/o cobounds/token/offset
but currently also passed hidden arguments. The proper solution is
to avoid the hidden arguments and stuff the extra information into
the descriptor.
Addtionally, OPTIONAL is not yet handled and there are probably
some other bugs lurking.

EXAMPLE:

For
  type t
    integer :: a, b
  end type t
  integer :: caf[*]
  type(t) :: caf_dt[*]
  call sub (caf)
  call sub (caf_dt%b)
the dump could look like:
  sub ((integer(kind=4) *) caf, &caf_token.0, 0);
  sub (&caf_dt->b, &caf_token.2, 4);
where the first argument is the data, the second the token and
the third the offset between the data and the address saved in
the token.


TODO:
* Handle passing OPTIONAL arguments to OPTIONAL dummies, i.e.
  offset and token might be not available.
* Decl of coarray-taking procedures
  * test of passing them on themselves
  * test for (absent) optional to optional passing
* Cleanup, test case.
* Check that assumed-shape dummies (which have explicit coshape) work

Related but not part of this patch:
* Passing TOKEN for allocatable coarrays
* Making sure the descriptor handles the offset of:
  call sub(coarray%element) where loc(coarray%element)-loc(coarray)
  needs to be stored somewhere

NOTE: The current testcase assumes that pointers are INTEGER(8) wide!
NOTE2: The array test case does not work. Replace "(:)" by, e.g., "(1)"
to make it work.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4ec892b..9caa17f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2631,10 +2631,11 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 	  if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
 	      && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
 	    se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
-	
+
 	  /* Use the actual tree type and not the wrapped coarray. */
-	  se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),
-				   se->expr);
+	  if (!se->want_pointer)
+	    se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),
+				     se->expr);
 	}
 
       return;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 65a8efa..e2ca9c4 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2106,6 +2106,45 @@ create_function_arglist (gfc_symbol * sym)
 
       arglist = chainon (arglist, parm);
       typelist = TREE_CHAIN (typelist);
+
+      if (f->sym->attr.codimension
+	  && gfc_option.coarray == GFC_FCOARRAY_LIB
+	  && !f->sym->attr.allocatable)
+	{
+	  tree caf_type;
+	  tree token;
+	  tree offset;
+
+	  gcc_assert (f->sym->backend_decl != NULL_TREE
+		      && !sym->attr.is_bind_c);
+	  caf_type = TREE_TYPE (f->sym->backend_decl);
+
+	  gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE);
+	  token = build_decl (input_location, PARM_DECL,
+			      create_tmp_var_name ("caf_token"),
+			      build_qualified_type (pvoid_type_node,
+						    TYPE_QUAL_RESTRICT));
+	  GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token;
+	  DECL_CONTEXT (token) = fndecl;
+	  DECL_ARTIFICIAL (token) = 1;
+	  DECL_ARG_TYPE (token) = TREE_VALUE (typelist);
+	  TREE_READONLY (token) = 1;
+	  hidden_arglist = chainon (hidden_arglist, token);
+	  gfc_finish_decl (token);
+
+	  gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE);
+	  offset = build_decl (input_location, PARM_DECL,
+			       create_tmp_var_name ("caf_offset"),
+			       gfc_array_index_type);
+
+	  GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) = offset;
+	  DECL_CONTEXT (offset) = fndecl;
+	  DECL_ARTIFICIAL (offset) = 1;
+	  DECL_ARG_TYPE (offset) = TREE_VALUE (typelist);
+	  TREE_READONLY (offset) = 1;
+	  hidden_arglist = chainon (hidden_arglist, offset);
+	  gfc_finish_decl (offset);
+	}
     }
 
   /* Add the hidden string length parameters, unless the procedure
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 26d4398..1689f9a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2814,6 +2814,34 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
   return 0;
 }
 
+/* FIXME: Will probably used more often. Move at a different place
+   and include in a header file (trans*.h?).  */
+
+static tree
+get_tree_for_caf_expr (gfc_expr *expr)
+{
+   tree caf_decl = NULL_TREE;
+   gfc_ref *ref;
+
+   gcc_assert (expr->expr_type == EXPR_VARIABLE);
+   if (expr->symtree->n.sym->attr.codimension)
+     caf_decl = expr->symtree->n.sym->backend_decl;
+
+   for (ref = expr->ref; ref; ref = ref->next)
+     if (ref->type == REF_COMPONENT)
+       {
+	gfc_component *comp = ref->u.c.component;
+        if (comp->attr.pointer || comp->attr.allocatable)
+	  caf_decl = NULL_TREE;
+	if (comp->attr.codimension)
+	  caf_decl = comp->backend_decl;
+       }
+
+   gcc_assert (caf_decl != NULL_TREE);
+   return caf_decl;
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -3362,6 +3390,55 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
 	VEC_safe_push (tree, gc, stringargs, parmse.string_length);
 
+      /* For descriptorless coarrays, we pass the token and the offset
+	 as additional arguments.  */
+      if (fsym && fsym->attr.codimension && !fsym->attr.allocatable
+	  && gfc_option.coarray == GFC_FCOARRAY_LIB)
+	{
+	  tree caf_decl, caf_type;
+	  tree token;
+	  tree offset;
+	  tree tmp2;
+
+	  /* FIXME: Handle Optional.  */
+          caf_decl = get_tree_for_caf_expr (arg->expr);
+
+	  caf_type = TREE_TYPE (caf_decl);
+	  gcc_assert (GFC_ARRAY_TYPE_P (caf_type)
+		      && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) != NULL_TREE);
+	  token = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type);
+	  token = gfc_build_addr_expr (NULL_TREE, token);
+	  VEC_safe_push (tree, gc, stringargs, token);
+
+	  if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE)
+	    offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type);
+	  else
+	    offset = build_int_cst (gfc_array_index_type, 0);
+
+	  gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl))
+		      && POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
+
+	  /* FIXME: That won't work in the general case ... */
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
+	    tmp = gfc_conv_array_data (parmse.expr);
+	  else
+	    tmp = parmse.expr;
+
+       	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
+	    tmp2 = gfc_conv_array_data (caf_decl);
+	  else
+	    tmp2 = caf_decl;
+
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+                                 gfc_array_index_type,
+                                 fold_convert (gfc_array_index_type, tmp),
+                                 fold_convert (gfc_array_index_type, tmp2));
+	  offset = fold_build2_loc (input_location, PLUS_EXPR,
+				    gfc_array_index_type, offset, tmp);
+
+	  VEC_safe_push (tree, gc, stringargs, offset);
+	}
+
       VEC_safe_push (tree, gc, arglist, parmse.expr);
     }
   gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c56aff8..48e054f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -736,6 +736,7 @@ struct GTY((variable_size))	lang_type	 {
   tree base_decl[2];
   tree nonrestricted_type;
   tree caf_token;
+  tree caf_offset;
 };
 
 struct GTY((variable_size)) lang_decl {
@@ -781,6 +782,7 @@ struct GTY((variable_size)) lang_decl {
 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
 #define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
+#define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset)
 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
--- /dev/null	2011-07-19 07:59:35.374731880 +0200
+++ test-token.f90	2011-07-20 14:34:27.806461441 +0200
@@ -0,0 +1,35 @@
+implicit none
+interface
+  subroutine sub(x, n, offset)
+     integer, optional :: x[*]
+     integer, value :: n
+     integer(8), value :: offset
+  end subroutine sub
+end interface
+type t
+  integer :: b, a
+end type t
+
+integer :: i
+type(t), save :: caf_dt[*]
+integer, save :: CAF[*]
+integer, save :: CAF2(20)[*]
+
+CAF2 = [(-i, i = 1, size(caf2))]
+CAF = 41
+caf_dt%b = 42
+caf_dt%a = 43
+
+call sub(CAF, 41, 0_8)
+call sub(CAF_DT%a, 43, sizeof (caf_dt%b))
+call sub(CAF_DT%b, 42, 0_8)
+
+do i = 1, size(caf2)
+  call sub(CAF2(i), -i, (i-1)*sizeof(caf))
+end do
+
+if (caf /= 41*5) call abort()
+if (caf_dt%b /= 42*5) call abort()
+if (caf_dt%a /= 43*5) call abort()
+if (any (caf2 /= [(-i*5, i = 1, size(caf2))])) call abort()
+end
--- /dev/null	2011-07-19 07:59:35.374731880 +0200
+++ sub.f90	2011-07-20 14:32:29.857116199 +0200
@@ -0,0 +1,9 @@
+subroutine sub (a, n, myoffset, token, offset)
+  integer :: a, token
+  integer(8), value :: offset, myoffset
+  integer, value :: n
+  print *, a, offset,' <-> ', n, myoffset
+  if (a /= n) call abort()
+  if (offset /= myoffset) call abort()
+  a = a * 5
+end subroutine sub
--- /dev/null	2011-07-19 07:59:35.374731880 +0200
+++ test-token_array.f90	2011-07-20 16:17:28.990868816 +0200
@@ -0,0 +1,35 @@
+implicit none
+interface
+  subroutine sub(x, n, offset)
+     integer, optional :: x(:)[*]
+     integer, value :: n
+     integer(8), value :: offset
+  end subroutine sub
+end interface
+type t
+  integer :: b(1), a(1)
+end type t
+
+integer :: i
+type(t), save :: caf_dt[*]
+integer, save :: CAF(1)[*]
+integer, save :: CAF2(20)[*]
+
+CAF2 = [(-i, i = 1, size(caf2))]
+CAF = 41
+caf_dt%b = 42
+caf_dt%a = 43
+
+call sub(CAF, 41, 0_8)
+call sub(CAF_DT%a, 43, sizeof (caf_dt%b))
+call sub(CAF_DT%b, 42, 0_8)
+
+do i = 1, size(caf2)
+  call sub(CAF2(i:i), -i, (i-1)*sizeof(caf))
+end do
+
+if (caf(1) /= 41*5) call abort()
+if (caf_dt%b(1) /= 42*5) call abort()
+if (caf_dt%a(1) /= 43*5) call abort()
+if (any (caf2 /= [(-i*5, i = 1, size(caf2))])) call abort()
+end
--- /dev/null	2011-07-19 07:59:35.374731880 +0200
+++ sub_array.f90	2011-07-20 16:17:21.147310927 +0200
@@ -0,0 +1,9 @@
+subroutine sub (a, n, myoffset, token, offset)
+  integer :: a(:), token
+  integer(8), value :: offset, myoffset
+  integer, value :: n
+  print *, a(1), offset,' <-> ', n, myoffset
+  if (a(1) /= n) call abort()
+  if (offset /= myoffset) call abort()
+  a = a * 5
+end subroutine sub