2011-05-04 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* 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.
@@ -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 *);
@@ -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:
@@ -4463,10 +4452,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;
@@ -4478,19 +4473,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;
- gfort_gvar_caf_num_images = gfc_create_var (integer_type_node,
- PREFIX("caf_num_images"));
+ 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
+ = 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;
@@ -4584,7 +4597,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),
@@ -935,7 +935,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)
@@ -1228,7 +1228,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;
}
@@ -1248,7 +1248,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;
}
@@ -1549,7 +1549,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,
@@ -1565,7 +1565,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,
@@ -452,9 +452,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);