+ filename_tmp, strerror (errno));
+
+ /* Read the MD5 from the header of the old module file and compare. */
+ if (read_md5_from_module_file (filename, md5_old) != 0
+ || memcmp (md5_old, md5_new, sizeof (md5_old)) != 0)
+ {
+ /* Module file have changed, replace the old one. */
+ unlink (filename);
+ rename (filename_tmp, filename);
+ }
+ else
+ unlink (filename_tmp);
+}
+
+
+static void
+sort_iso_c_rename_list (void)
+{
+ gfc_use_rename *tmp_list = NULL;
+ gfc_use_rename *curr;
+ gfc_use_rename *kinds_used[ISOCBINDING_NUMBER] = {NULL};
+ int c_kind;
+ int i;
+
+ for (curr = gfc_rename_list; curr; curr = curr->next)
+ {
+ c_kind = get_c_kind (curr->use_name, c_interop_kinds_table);
+ if (c_kind == ISOCBINDING_INVALID || c_kind == ISOCBINDING_LAST)
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", curr->use_name,
+ &curr->where);
+ }
+ else
+ /* Put it in the list. */
+ kinds_used[c_kind] = curr;
+ }
+
+ /* Make a new (sorted) rename list. */
+ i = 0;
+ while (i < ISOCBINDING_NUMBER && kinds_used[i] == NULL)
+ i++;
+
+ if (i < ISOCBINDING_NUMBER)
+ {
+ tmp_list = kinds_used[i];
+
+ i++;
+ curr = tmp_list;
+ for (; i < ISOCBINDING_NUMBER; i++)
+ if (kinds_used[i] != NULL)
+ {
+ curr->next = kinds_used[i];
+ curr = curr->next;
+ curr->next = NULL;
+ }
+ }
+
+ gfc_rename_list = tmp_list;
+}
+
+
+/* Import the intrinsic ISO_C_BINDING module, generating symbols in
+ the current namespace for all named constants, pointer types, and
+ procedures in the module unless the only clause was used or a rename
+ list was provided. */
+
+static void
+import_iso_c_binding_module (void)
+{
+ gfc_symbol *mod_sym = NULL;
+ gfc_symtree *mod_symtree = NULL;
+ const char *iso_c_module_name = "__iso_c_binding";
+ gfc_use_rename *u;
+ int i;
+ char *local_name;
+
+ /* Look only in the current namespace. */
+ mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
+
+ if (mod_symtree == NULL)
+ {
+ /* symtree doesn't already exist in current namespace. */
+ gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree);
+
+ if (mod_symtree != NULL)
+ mod_sym = mod_symtree->n.sym;
+ else
+ gfc_internal_error ("import_iso_c_binding_module(): Unable to "
+ "create symbol for %s", iso_c_module_name);
+
+ mod_sym->attr.flavor = FL_MODULE;
+ mod_sym->attr.intrinsic = 1;
+ mod_sym->module = gfc_get_string (iso_c_module_name);
+ mod_sym->from_intmod = INTMOD_ISO_C_BINDING;
+ }
+
+ /* Generate the symbols for the named constants representing
+ the kinds for intrinsic data types. */
+ if (only_flag)
+ {
+ /* Sort the rename list because there are dependencies between types
+ and procedures (e.g., c_loc needs c_ptr). */
+ sort_iso_c_rename_list ();
+
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ i = get_c_kind (u->use_name, c_interop_kinds_table);
+
+ if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST)
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", u->use_name,
+ &u->where);
+ continue;
+ }
+
+ generate_isocbinding_symbol (iso_c_module_name, i, u->local_name);
+ }
+ }
+ else
+ {
+ for (i = 0; i < ISOCBINDING_NUMBER; i++)
+ {
+ local_name = NULL;
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
+ {
+ local_name = u->local_name;
+ u->found = 1;
+ break;
+ }
+ }
+ generate_isocbinding_symbol (iso_c_module_name, i, local_name);
+ }
+
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (u->found)
+ continue;
+
+ gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+ "module ISO_C_BINDING", u->use_name, &u->where);
+ }
+ }
+}
+
+
+/* Add an integer named constant from a given module. */
+
+static void
+create_int_parameter (const char *name, int value, const char *modname,
+ intmod_id module, int id)
+{
+ gfc_symtree *tmp_symtree;
+ gfc_symbol *sym;
+
+ tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ if (tmp_symtree != NULL)
+ {
+ if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
+ return;
+ else
+ gfc_error ("Symbol '%s' already declared", name);
+ }
+
+ gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree);
+ sym = tmp_symtree->n.sym;
+
+ sym->module = gfc_get_string (modname);
+ sym->attr.flavor = FL_PARAMETER;
+ sym->ts.type = BT_INTEGER;
+ sym->ts.kind = gfc_default_integer_kind;
+ sym->value = gfc_int_expr (value);
+ sym->attr.use_assoc = 1;
+ sym->from_intmod = module;
+ sym->intmod_sym_id = id;
+}
+
+
+/* USE the ISO_FORTRAN_ENV intrinsic module. */
+
+static void
+use_iso_fortran_env_module (void)
+{
+ static char mod[] = "iso_fortran_env";
+ const char *local_name;
+ gfc_use_rename *u;
+ gfc_symbol *mod_sym;
+ gfc_symtree *mod_symtree;
+ int i;
+
+ intmod_sym symbol[] = {
+#define NAMED_INTCST(a,b,c) { a, b, 0 },
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+ { ISOFORTRANENV_INVALID, NULL, -1234 } };
+
+ i = 0;
+#define NAMED_INTCST(a,b,c) symbol[i++].value = c;
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+
+ /* Generate the symbol for the module itself. */
+ mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod);
+ if (mod_symtree == NULL)
+ {
+ gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree);
+ gcc_assert (mod_symtree);
+ mod_sym = mod_symtree->n.sym;
+
+ mod_sym->attr.flavor = FL_MODULE;
+ mod_sym->attr.intrinsic = 1;
+ mod_sym->module = gfc_get_string (mod);
+ mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV;
+ }
+ else
+ if (!mod_symtree->n.sym->attr.intrinsic)
+ gfc_error ("Use of intrinsic module '%s' at %C conflicts with "
+ "non-intrinsic module name used previously", mod);
+
+ /* Generate the symbols for the module integer named constants. */
+ if (only_flag)
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ for (i = 0; symbol[i].name; i++)
+ if (strcmp (symbol[i].name, u->use_name) == 0)
+ break;
+
+ if (symbol[i].name == NULL)
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_FORTRAN_ENV", u->use_name,
+ &u->where);
+ continue;
+ }
+
+ if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
+ && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
+ gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
+ "from intrinsic module ISO_FORTRAN_ENV at %L is "
+ "incompatible with option %s", &u->where,
+ gfc_option.flag_default_integer
+ ? "-fdefault-integer-8" : "-fdefault-real-8");
+
+ create_int_parameter (u->local_name[0] ? u->local_name
+ : symbol[i].name,
+ symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
+ symbol[i].id);
+ }
+ else
+ {
+ for (i = 0; symbol[i].name; i++)
+ {
+ local_name = NULL;
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (strcmp (symbol[i].name, u->use_name) == 0)
+ {
+ local_name = u->local_name;
+ u->found = 1;
+ break;
+ }
+ }
+
+ if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
+ && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
+ gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
+ "from intrinsic module ISO_FORTRAN_ENV at %C is "
+ "incompatible with option %s",
+ gfc_option.flag_default_integer
+ ? "-fdefault-integer-8" : "-fdefault-real-8");
+
+ create_int_parameter (local_name ? local_name : symbol[i].name,
+ symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
+ symbol[i].id);
+ }
+
+ for (u = gfc_rename_list; u; u = u->next)
+ {
+ if (u->found)
+ continue;
+
+ gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+ "module ISO_FORTRAN_ENV", u->use_name, &u->where);
+ }
+ }