Patchwork [Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

login
register
mail settings
Submitter Tobias Burnus
Date May 24, 2011, 10:05 p.m.
Message ID <4DDC2BB3.7020007@net-b.de>
Download mbox | patch
Permalink /patch/97237/
State New
Headers show

Comments

Tobias Burnus - May 24, 2011, 10:05 p.m.
Instead of a ping, an updated patch. This one additionally supports 
registering of nonallocatable coarrays also in MODULE and in BLOCK plus 
a test case.

(Changes to gfc_generate_module_vars and gfc_process_block_locals and 
cgraph call in generate_coarray_init; some functions were moved up in 
the trans-decl.c file.)

OK for the trunk?

Tobias

On 22 May 2011, Tobias Burnus wrote:
> The following applies to -fcoarray=lib; for -fcoarray=single there 
> should be no change.
>
> The coarray communication library needs to know about the coarrays 
> even before the function containing them has been invoked. Thus, the 
> coarrays (of all translation units) need to be registered at start up.
>
> This patch handles this by creating a _caf_init function with 
> constructor attribute, which is nested in the the parent's procedure 
> if the latter contains local nonallocatable (and thus: static/SAVE) 
> coarrays variables.
>
> At the same time, all (nonallocatable) coarrays have been turned into 
> pointers - to allow the communication library to allocate the memory. 
> This allows optimizations, e.g., by allocating in memory which is 
> available for all images on the same node (cf. MPI_Alloc_mem).
>
> Additionally, a "token" is saved with the coarray, which allows the 
> coarray library to identify the coarray. In a simple implementation, 
> it could simply use the base_addr of the coarray or enumerate them 
> through.
>
>
> Example: The small example program
>
> ------------- < test.f90 >-----------------
> program caf_program
>   integer :: a[*] = 7
>   a = 8
> end program caf_program
> ------------- </ test.f90 >-----------------
>
> is turned into the following tree (-fdump-tree-original)
>
> ------------- < test.f90.003t.original >-----------------
> _caf_init.1 ()
> {
>   a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, 
> &caf_token.0, 0B, 0B, 0);
>   *a = 7;
> }
>
> caf_program ()
> {
>   static void * caf_token.0;
>   static integer(kind=4) * restrict a;
>   void _caf_init.1 (void);
>
>   (integer(kind=4)) *a = 8;
> }
>
> main (integer(kind=4) argc, character(kind=1) * * argv)
> {
>   static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
>
>   _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, 
> &_gfortran_caf_num_images);
>   _gfortran_set_args (argc, argv);
>   _gfortran_set_options (8, &options.2[0]);
>   _gfortran_caf_sync_all (0B, 0);
>   caf_program ();
>   __sync_synchronize ();
>   _gfortran_caf_finalize ();
>   return 0;
> }
> ------------- </ test.f90.003t.original >-----------------
>
> Note: By construction, _gfortran_caf_register is called before 
> _gfortran_caf_init; thus, the MPI library will be initialized by the 
> first _gfortran_caf_register call, unless the program does not have 
> any nonallocatable coarrays.
>
> No test cases, but the ones in gfortran.dg/coarray/ should already 
> test this functionality.
>
> To be done in later patches:
> - Coarrays declared in modules (module variables)
> - Allocatable coarrays
>
> Note: As constructors are never optimized away [unless they are 
> pure/const], static coarrays and also uncalled functions containing 
> static coarrays will not be optimized away. (Cf. PRs middle-end/49106 
> and middle-end/49108.)
>
> Bootstrapped and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
Tobias Burnus - May 26, 2011, 6 a.m.
ping**0.3

http://gcc.gnu.org/ml/fortran/2011-05/msg00176.html

Tobias Burnus wrote:
> Instead of a ping, an updated patch. This one additionally supports 
> registering of nonallocatable coarrays also in MODULE and in BLOCK 
> plus a test case.
>
> (Changes to gfc_generate_module_vars and gfc_process_block_locals and 
> cgraph call in generate_coarray_init; some functions were moved up in 
> the trans-decl.c file.)
>
> OK for the trunk?
>
> Tobias
>
> On 22 May 2011, Tobias Burnus wrote:
>> The following applies to -fcoarray=lib; for -fcoarray=single there 
>> should be no change.
>>
>> The coarray communication library needs to know about the coarrays 
>> even before the function containing them has been invoked. Thus, the 
>> coarrays (of all translation units) need to be registered at start up.
>>
>> This patch handles this by creating a _caf_init function with 
>> constructor attribute, which is nested in the the parent's procedure 
>> if the latter contains local nonallocatable (and thus: static/SAVE) 
>> coarrays variables.
>>
>> At the same time, all (nonallocatable) coarrays have been turned into 
>> pointers - to allow the communication library to allocate the memory. 
>> This allows optimizations, e.g., by allocating in memory which is 
>> available for all images on the same node (cf. MPI_Alloc_mem).
>>
>> Additionally, a "token" is saved with the coarray, which allows the 
>> coarray library to identify the coarray. In a simple implementation, 
>> it could simply use the base_addr of the coarray or enumerate them 
>> through.
>>
>>
>> Example: The small example program
>>
>> ------------- < test.f90 >-----------------
>> program caf_program
>>   integer :: a[*] = 7
>>   a = 8
>> end program caf_program
>> ------------- </ test.f90 >-----------------
>>
>> is turned into the following tree (-fdump-tree-original)
>>
>> ------------- < test.f90.003t.original >-----------------
>> _caf_init.1 ()
>> {
>>   a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, 
>> &caf_token.0, 0B, 0B, 0);
>>   *a = 7;
>> }
>>
>> caf_program ()
>> {
>>   static void * caf_token.0;
>>   static integer(kind=4) * restrict a;
>>   void _caf_init.1 (void);
>>
>>   (integer(kind=4)) *a = 8;
>> }
>>
>> main (integer(kind=4) argc, character(kind=1) * * argv)
>> {
>>   static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
>>
>>   _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, 
>> &_gfortran_caf_num_images);
>>   _gfortran_set_args (argc, argv);
>>   _gfortran_set_options (8, &options.2[0]);
>>   _gfortran_caf_sync_all (0B, 0);
>>   caf_program ();
>>   __sync_synchronize ();
>>   _gfortran_caf_finalize ();
>>   return 0;
>> }
>> ------------- </ test.f90.003t.original >-----------------
>>
>> Note: By construction, _gfortran_caf_register is called before 
>> _gfortran_caf_init; thus, the MPI library will be initialized by the 
>> first _gfortran_caf_register call, unless the program does not have 
>> any nonallocatable coarrays.
>>
>> No test cases, but the ones in gfortran.dg/coarray/ should already 
>> test this functionality.
>>
>> To be done in later patches:
>> - Coarrays declared in modules (module variables)
>> - Allocatable coarrays
>>
>> Note: As constructors are never optimized away [unless they are 
>> pure/const], static coarrays and also uncalled functions containing 
>> static coarrays will not be optimized away. (Cf. PRs middle-end/49106 
>> and middle-end/49108.)
>>
>> Bootstrapped and regtested on x86-64-linux.
>> OK for the trunk?
>>
>> Tobias
>
Paul Richard Thomas - May 26, 2011, 12:55 p.m.
Dear Tobias,

This looks fine to me.  It does the things that you described and is
well hidden behind the co-array associated conditions.  Thus it is OK
for trunk.

Maybe I am being stupid but what is the call, in the testcase, to
subroutine test for?

Cheers

Paul

Patch

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

	PR fortran/18918
	* trans-array.c (gfc_conv_array_ref): Handle pointer coarrays.
	* trans-decl.c (has_coarray_vars, caf_init_block,
	gfor_fndecl_caf_register): New file-global variables.
	(gfc_finish_var_decl): Make sure that coarrays in main are static.
	(gfc_build_qualified_array): Generate coarray token variable.
	(gfc_get_symbol_decl): Don't use a static initializer for coarrays.
	(gfc_build_builtin_function_decls): Set gfor_fndecl_caf_register.
	(gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Skip for
	static coarrays.
	(generate_local_decl): Check for local coarrays.
	(create_main_function): SYNC ALL before calling MAIN.
	(generate_coarray_sym_init): Register static coarray.
	(generate_coarray_init): Generate CAF registering constructor
	function.
	(gfc_generate_function_code): Call it, if needed, do not create
	cgraph twice.
	(gfc_generate_module_vars, gfc_process_block_locals): Call
	generate_coarray_init.
	* trans-types.c (gfc_get_nodesc_array_type): Generate pointers for
	-fcoarray=lib.
	* trans.h (gfor_fndecl_caf_register): New variable.
	(lang_type): New element caf_token.
	(GFC_TYPE_ARRAY_CAF_TOKEN): New macro.

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

	PR fortran/18918
	* gfortran.dg/coarray/registering_1.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78d65a6..29c7f83 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,6 +2623,10 @@  gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   if (ar->dimen == 0)
     {
       gcc_assert (ar->codimen);
+      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 (TREE_TYPE (TREE_TYPE (se->expr)), se->expr);
       return;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d771484..299f224 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -78,6 +78,12 @@  static gfc_namespace *module_namespace;
 static gfc_symbol* current_procedure_symbol = NULL;
 
 
+/* With -fcoarray=lib: For generating the registering call
+   of static coarrays.  */
+static bool has_coarray_vars;
+static stmtblock_t caf_init_block;
+
+
 /* List of static constructor functions.  */
 
 tree gfc_static_ctors;
@@ -114,6 +120,7 @@  tree gfor_fndecl_associated;
 /* Coarray run-time library function decls.  */
 tree gfor_fndecl_caf_init;
 tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_critical;
 tree gfor_fndecl_caf_end_critical;
 tree gfor_fndecl_caf_sync_all;
@@ -566,7 +573,9 @@  gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      SAVE_EXPLICIT.  */
   if (!sym->attr.use_assoc
 	&& (sym->attr.save != SAVE_NONE || sym->attr.data
-	      || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+	    || (sym->value && sym->ns->proc_name->attr.is_main_program)
+	    || (gfc_option.coarray == GFC_FCOARRAY_LIB
+		&& sym->attr.codimension && !sym->attr.allocatable)))
     TREE_STATIC (decl) = 1;
 
   if (sym->attr.volatile_)
@@ -745,6 +754,18 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
   nest = (procns->proc_name->backend_decl != current_function_decl)
 	 && !sym->attr.contained;
 
+  if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB
+      && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
+    {
+      tree token;
+
+      token = gfc_create_var_np (pvoid_type_node, "caf_token");
+      GFC_TYPE_ARRAY_CAF_TOKEN (type) = token;
+      DECL_ARTIFICIAL (token) = 1;
+      TREE_STATIC (token) = 1;
+      gfc_add_decl_to_function (token);
+    }
+
   for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
     {
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
@@ -1403,7 +1424,8 @@  gfc_get_symbol_decl (gfc_symbol * sym)
       && !(sym->attr.use_assoc && !intrinsic_array_parameter)
       && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
 	  || gfc_option.flag_max_stack_var_size == 0
-	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
+	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
+      && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension))
     {
       /* Add static initializer. For procedures, it is only needed if
 	 SAVE is specified otherwise they need to be reinitialized
@@ -3025,6 +3047,11 @@  gfc_build_builtin_function_decls (void)
       gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
 
+      gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
+        size_type_node, integer_type_node, ppvoid_type_node, pint_type,
+        build_pointer_type (pchar_type_node), integer_type_node);
+
       gfor_fndecl_caf_critical = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_critical")), void_type_node, 0);
 
@@ -3458,7 +3485,7 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
-	      else
+	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
 		{
 		  gfc_save_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
@@ -3864,6 +3891,10 @@  gfc_create_module_variable (gfc_symbol * sym)
           rest_of_decl_compilation (length, 1, 0);
         }
     }
+
+  if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+      && sym->attr.referenced && !sym->attr.use_assoc)
+    has_coarray_vars = true;
 }
 
 /* Emit debug information for USE statements.  */
@@ -4066,6 +4097,9 @@  gfc_emit_parameter_debug_info (gfc_symbol *sym)
 				   sym->attr.dimension, false))
     return;
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+    return;
+
   /* Create the decl for the variable or constant.  */
   decl = build_decl (input_location,
 		     sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL,
@@ -4087,6 +4121,120 @@  gfc_emit_parameter_debug_info (gfc_symbol *sym)
   debug_hooks->global_decl (decl);
 }
 
+
+static void
+generate_coarray_sym_init (gfc_symbol *sym)
+{
+  tree tmp, size, decl, token;
+
+  if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
+      || sym->attr.use_assoc || !sym->attr.referenced) 
+    return;
+
+  decl = sym->backend_decl;
+  TREE_USED(decl) = 1;
+  gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+
+  /* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108
+     to make sure the variable is not optimized away.  */
+  DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1;
+
+  size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
+
+  if (GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)))
+    {
+      tmp = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (decl));
+      size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			      fold_convert (size_type_node, tmp),
+			      fold_convert (size_type_node, size));
+    }
+
+  gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE);
+  token = gfc_build_addr_expr (ppvoid_type_node,
+			       GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
+			     build_int_cst (integer_type_node, 0), /* type.  */
+			     token, null_pointer_node, /* token, stat.  */
+			     null_pointer_node, /* errgmsg, errmsg_len.  */
+			     build_int_cst (integer_type_node, 0));
+  
+  gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
+
+
+  /* Handle "static" initializer.  */
+  if (sym->value)
+    {
+      sym->attr.pointer = 1;
+      tmp = gfc_trans_assignment (gfc_lval_expr_from_sym (sym), sym->value,
+				  true, false);
+      sym->attr.pointer = 0;
+      gfc_add_expr_to_block (&caf_init_block, tmp);
+    }
+}
+
+
+/* Generate constructor function to initialize static, nonallocatable
+   coarrays.  */
+
+static void
+generate_coarray_init (gfc_namespace * ns __attribute((unused)))
+{
+  tree fndecl, tmp, decl, save_fn_decl;
+
+  save_fn_decl = current_function_decl;
+  push_function_context ();
+
+  tmp = build_function_type_list (void_type_node, NULL_TREE);
+  fndecl = build_decl (input_location, FUNCTION_DECL,
+		       create_tmp_var_name ("_caf_init"), tmp);
+
+  DECL_STATIC_CONSTRUCTOR (fndecl) = 1;
+  SET_DECL_INIT_PRIORITY (fndecl, DEFAULT_INIT_PRIORITY);
+
+  decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+  DECL_CONTEXT (decl) = fndecl;
+  DECL_RESULT (fndecl) = decl;
+
+  pushdecl (fndecl);
+  current_function_decl = fndecl;
+  announce_function (fndecl);
+
+  rest_of_decl_compilation (fndecl, 0, 0);
+  make_decl_rtl (fndecl);
+  init_function_start (fndecl);
+
+  pushlevel (0);
+  gfc_init_block (&caf_init_block);
+
+  gfc_traverse_ns (ns, generate_coarray_sym_init);
+
+  DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block);
+  decl = getdecls ();
+
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+                DECL_INITIAL (fndecl));
+  dump_function (TDI_original, fndecl);
+
+  cfun->function_end_locus = input_location;
+  set_cfun (NULL);
+
+  if (decl_function_context (fndecl))
+    (void) cgraph_create_node (fndecl);
+  else
+    cgraph_finalize_function (fndecl, true);
+
+  pop_function_context ();
+  current_function_decl = save_fn_decl;
+}
+
+
 /* Generate all the required code for module variables.  */
 
 void
@@ -4101,9 +4249,14 @@  gfc_generate_module_vars (gfc_namespace * ns)
   /* Generate COMMON blocks.  */
   gfc_trans_common (ns);
 
+  has_coarray_vars = false;
+
   /* Create decls for all the module variables.  */
   gfc_traverse_ns (ns, gfc_create_module_variable);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   cur_module = NULL;
 
   gfc_trans_use_stmts (ns);
@@ -4200,6 +4353,10 @@  generate_local_decl (gfc_symbol * sym)
 {
   if (sym->attr.flavor == FL_VARIABLE)
     {
+      if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+	  && sym->attr.referenced && !sym->attr.use_assoc)
+	has_coarray_vars = true;
+
       if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
 	generate_dependency_declarations (sym);
 
@@ -4897,8 +5054,12 @@  gfc_generate_function_code (gfc_namespace * ns)
   nonlocal_dummy_decls = NULL;
   nonlocal_dummy_decl_pset = NULL;
 
+  has_coarray_vars = false;
   generate_local_vars (ns);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   /* Keep the parent fake result declaration in module functions
      or external procedures.  */
   if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
@@ -5062,9 +5223,13 @@  gfc_generate_function_code (gfc_namespace * ns)
     }
   current_function_decl = old_context;
 
-  if (decl_function_context (fndecl))
+  if (decl_function_context (fndecl) && !gfc_option.coarray == GFC_FCOARRAY_LIB
+      && has_coarray_vars)
     /* Register this function with cgraph just far enough to get it
-       added to our parent's nested function list.  */
+       added to our parent's nested function list.
+       If there are static coarrays in this function, the nested _caf_init
+       function has already called cgraph_create_node, which also created
+       the cgraph node for this function.  */
     (void) cgraph_create_node (fndecl);
   else
     cgraph_finalize_function (fndecl, true);
@@ -5190,8 +5355,13 @@  gfc_process_block_locals (gfc_namespace* ns)
   tree decl;
 
   gcc_assert (saved_local_decls == NULL_TREE);
+  has_coarray_vars = false;
+
   generate_local_vars (ns);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   decl = saved_local_decls;
   while (decl)
     {
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1165926..9c4f5f6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1542,13 +1542,13 @@  gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
 
   if (as->rank == 0)
     {
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	type = build_pointer_type (type);
 
       if (restricted)
         type = build_qualified_type (type, TYPE_QUAL_RESTRICT);	
 
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	{
 	  GFC_ARRAY_TYPE_P (type) = 1;
 	  TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type)); 
@@ -1596,7 +1596,8 @@  gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
       DECL_ORIGINAL_TYPE (type_decl) = gtype;
     }
 
-  if (packed != PACKED_STATIC || !known_stride)
+  if (packed != PACKED_STATIC || !known_stride
+      || (as->corank && gfc_option.coarray == GFC_FCOARRAY_LIB))
     {
       /* For dummy arrays and automatic (heap allocated) arrays we
 	 want a pointer to the array.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2b06d80..95cd9fb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -617,6 +617,7 @@  extern GTY(()) tree gfor_fndecl_associated;
 /* Coarray run-time library function decls.  */
 extern GTY(()) tree gfor_fndecl_caf_init;
 extern GTY(()) tree gfor_fndecl_caf_finalize;
+extern GTY(()) tree gfor_fndecl_caf_register;
 extern GTY(()) tree gfor_fndecl_caf_critical;
 extern GTY(()) tree gfor_fndecl_caf_end_critical;
 extern GTY(()) tree gfor_fndecl_caf_sync_all;
@@ -722,6 +723,7 @@  struct GTY((variable_size))	lang_type	 {
   tree span;
   tree base_decl[2];
   tree nonrestricted_type;
+  tree caf_token;
 };
 
 struct GTY((variable_size)) lang_decl {
@@ -766,6 +768,7 @@  struct GTY((variable_size)) lang_decl {
   (TYPE_LANG_SPECIFIC(node)->stride[dim])
 #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_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-05-24 21:36:28.023892895 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/registering_1.f90	2011-05-24 23:46:25.000000000 +0200
@@ -0,0 +1,41 @@ 
+! { dg-do run }
+!
+! PR fortran/18918
+!
+! Check whether registering coarrays works
+!
+module m
+  integer :: a(1)[*] = 7
+end module m
+
+use m
+if (any (a /= 7)) call abort()
+a = 88
+if (any (a /= 88)) call abort()
+
+ block
+   integer :: b[*] = 8494
+   if (b /= 8494) call abort()
+ end block
+
+if (any (a /= 88)) call abort()
+call test ()
+end
+
+subroutine test()
+  complex :: z = (1,1)
+  if (z /= (1,1)) call abort()
+  call sub1()
+contains
+  subroutine sub1
+    real :: r = -1
+    if (r /= -1) call abort
+    r = 10
+    if (r /= 10) call abort
+  end subroutine sub1
+
+  subroutine uncalled()
+     integer :: not_refed = 784
+     if (not_refed /= 784) call abort()
+  end subroutine uncalled
+end subroutine test