re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

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

        PR fortran/18918
        PR fortran/48919
        * trans.h: Move gfc_init_coarray_decl prototype ...
        * gfortran.h: ... to here.
        * parse.c (translate_all_program_units): Call
        * gfc_init_coarray_decl.
        (gfc_parse_file): Update translate_all_program_units call.
        * trans-decl.c (gfc_init_coarray_decl): Fix variable
        * declaration,
        new argument whether DECL_EXTERNAL should be used.
        (create_main_function): Update gfc_init_coarray_decl call.
        * trans-intrinsic.c (trans_this_image, trans_image_index,
        conv_intrinsic_cobound): Ditto.

From-SVN: r173528

gcc/fortran/ChangeLog

+2011-05-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	PR fortran/48919
+	* trans.h: Move gfc_init_coarray_decl prototype ...
+	* gfortran.h: ... to here.
+	* parse.c (translate_all_program_units): Call gfc_init_coarray_decl.
+	(gfc_parse_file): Update translate_all_program_units call.
+	* trans-decl.c (gfc_init_coarray_decl): Fix variable declaration,
+	new argument whether DECL_EXTERNAL should be used.
+	(create_main_function): Update gfc_init_coarray_decl call.
+	* trans-intrinsic.c (trans_this_image, trans_image_index,
+	conv_intrinsic_cobound): Ditto.
+
 2011-05-06  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/18918

gcc/fortran/gfortran.h

@@ -2851,6 +2851,7 @@ bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
 /* trans.c */
 void gfc_generate_code (gfc_namespace *);
 void gfc_generate_module_code (gfc_namespace *);
+void gfc_init_coarray_decl (bool);
 
 /* bbt.c */
 typedef int (*compare_fn) (void *, void *);

gcc/fortran/parse.c

@@ -4231,13 +4231,19 @@ clean_up_modules (gfc_gsymbol *gsym)
    is active. This could be in a different order to resolution if
    there are forward references in the file.  */
 static void
-translate_all_program_units (gfc_namespace *gfc_global_ns_list)
+translate_all_program_units (gfc_namespace *gfc_global_ns_list,
+			     bool main_in_tu)
 {
   int errors;
 
   gfc_current_ns = gfc_global_ns_list;
   gfc_get_errors (NULL, &errors);
 
+  /* If the main program is in the translation unit and we have
+     -fcoarray=libs, generate the static variables.  */
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && main_in_tu)
+    gfc_init_coarray_decl (true);
+
   /* We first translate all modules to make sure that later parts
      of the program can use the decl. Then we translate the nonmodules.  */
 
@@ -4475,7 +4481,7 @@ prog_units:
       }
 
   /* Do the translation.  */
-  translate_all_program_units (gfc_global_ns_list);
+  translate_all_program_units (gfc_global_ns_list, seen_program);
 
 termination:
 

gcc/fortran/trans-decl.c

@@ -4454,10 +4454,16 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 }
 
 
+/* Generate the _gfortran_caf_this_image and _gfortran_caf_num_images
+   global variables for -fcoarray=lib. They are placed into the translation
+   unit of the main program.  Make sure that in one TU (the one of the main
+   program), the first call to gfc_init_coarray_decl is done with true.
+   Otherwise, expect link errors.  */
+
 void
-gfc_init_coarray_decl (void)
+gfc_init_coarray_decl (bool main_tu)
 {
-  tree save_fn_decl = current_function_decl;
+  tree save_fn_decl;
 
   if (gfc_option.coarray != GFC_FCOARRAY_LIB)
     return;
@@ -4469,19 +4475,37 @@ gfc_init_coarray_decl (void)
   current_function_decl = NULL_TREE;
   push_cfun (cfun);
 
-  gfort_gvar_caf_this_image = gfc_create_var (integer_type_node,
-					      PREFIX("caf_this_image"));
+  gfort_gvar_caf_this_image
+	= build_decl (input_location, VAR_DECL,
+		      get_identifier (PREFIX("caf_this_image")),
+		      integer_type_node);
   DECL_ARTIFICIAL (gfort_gvar_caf_this_image) = 1;
   TREE_USED (gfort_gvar_caf_this_image) = 1;
   TREE_PUBLIC (gfort_gvar_caf_this_image) = 1;
-  TREE_STATIC (gfort_gvar_caf_this_image) = 1;
+  TREE_READONLY (gfort_gvar_caf_this_image) = 0;
+
+  if (main_tu)
+    TREE_STATIC (gfort_gvar_caf_this_image) = 1;
+  else
+    DECL_EXTERNAL (gfort_gvar_caf_this_image) = 1;
+
+  pushdecl_top_level (gfort_gvar_caf_this_image);
 
-  gfort_gvar_caf_num_images = gfc_create_var (integer_type_node,
-					      PREFIX("caf_num_images"));
+  gfort_gvar_caf_num_images
+	= build_decl (input_location, VAR_DECL,
+		      get_identifier (PREFIX("caf_num_images")),
+		      integer_type_node);
   DECL_ARTIFICIAL (gfort_gvar_caf_num_images) = 1;
   TREE_USED (gfort_gvar_caf_num_images) = 1;
   TREE_PUBLIC (gfort_gvar_caf_num_images) = 1;
-  TREE_STATIC (gfort_gvar_caf_num_images) = 1;
+  TREE_READONLY (gfort_gvar_caf_num_images) = 0;
+
+  if (main_tu)
+    TREE_STATIC (gfort_gvar_caf_num_images) = 1;
+  else
+    DECL_EXTERNAL (gfort_gvar_caf_num_images) = 1;
+
+  pushdecl_top_level (gfort_gvar_caf_num_images);
 
   pop_cfun ();
   current_function_decl = save_fn_decl;
@@ -4575,7 +4599,7 @@ create_main_function (tree fndecl)
       pppchar_type
 	= build_pointer_type (build_pointer_type (pchar_type_node));
 
-      gfc_init_coarray_decl ();
+      gfc_init_coarray_decl (true);
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 4,
 		gfc_build_addr_expr (pint_type, argc),
 		gfc_build_addr_expr (pppchar_type, argv),

gcc/fortran/trans-intrinsic.c

@@ -952,7 +952,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* The case -fcoarray=single is handled elsewhere.  */
   gcc_assert (gfc_option.coarray != GFC_FCOARRAY_SINGLE);
 
-  gfc_init_coarray_decl ();
+  gfc_init_coarray_decl (false);
 
   /* Argument-free version: THIS_IMAGE().  */
   if (expr->value.function.actual->expr == NULL)
@@ -1252,7 +1252,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
     num_images = build_int_cst (type, 1);
   else
     {
-      gfc_init_coarray_decl ();
+      gfc_init_coarray_decl (false);
       num_images = gfort_gvar_caf_num_images;
     }
 
@@ -1272,7 +1272,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 static void
 trans_num_images (gfc_se * se)
 {
-  gfc_init_coarray_decl ();
+  gfc_init_coarray_decl (false);
   se->expr = gfort_gvar_caf_num_images;
 }
 
@@ -1575,7 +1575,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
 	{
           tree cosize;
 
-	  gfc_init_coarray_decl ();
+	  gfc_init_coarray_decl (false);
 	  cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
 
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1591,7 +1591,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
       else if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
 	{
 	  /* ubound = lbound + num_images() - 1.  */
-	  gfc_init_coarray_decl ();
+	  gfc_init_coarray_decl (false);
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				 gfc_array_index_type,
 				 gfort_gvar_caf_num_images,

gcc/fortran/trans.h

@@ -449,9 +449,6 @@ bool gfc_get_module_backend_decl (gfc_symbol *);
 /* Return the variable decl for a symbol.  */
 tree gfc_get_symbol_decl (gfc_symbol *);
 
-/* Initialize coarray global variables.  */
-void gfc_init_coarray_decl (void);
-
 /* Build a static initializer.  */
 tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool);