#include "match.h"
#include "parse.h" /* FIXME */
#include "md5.h"
+#include "constructor.h"
+#include "cpp.h"
#define MODULE_EXTENSION ".mod"
/* Don't put any single quote (') in MOD_VERSION,
if yout want it to be recognized. */
-#define MOD_VERSION "4"
+#define MOD_VERSION "5"
/* Structure that describes a position within a module file. */
write_char (char out)
{
if (putc (out, module_fp) == EOF)
- gfc_fatal_error ("Error writing modules file: %s", strerror (errno));
+ gfc_fatal_error ("Error writing modules file: %s", xstrerror (errno));
/* Add this to our MD5. */
md5_process_bytes (&out, sizeof (out), &ctx);
AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
- AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS
+ AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
+ AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS
}
ab_attribute;
minit ("ALLOCATABLE", AB_ALLOCATABLE),
minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
minit ("DIMENSION", AB_DIMENSION),
+ minit ("CODIMENSION", AB_CODIMENSION),
+ minit ("CONTIGUOUS", AB_CONTIGUOUS),
minit ("EXTERNAL", AB_EXTERNAL),
minit ("INTRINSIC", AB_INTRINSIC),
minit ("OPTIONAL", AB_OPTIONAL),
minit ("IS_ISO_C", AB_IS_ISO_C),
minit ("VALUE", AB_VALUE),
minit ("ALLOC_COMP", AB_ALLOC_COMP),
+ minit ("COARRAY_COMP", AB_COARRAY_COMP),
minit ("POINTER_COMP", AB_POINTER_COMP),
minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
minit ("ZERO_COMP", AB_ZERO_COMP),
minit ("IS_CLASS", AB_IS_CLASS),
minit ("PROCEDURE", AB_PROCEDURE),
minit ("PROC_POINTER", AB_PROC_POINTER),
+ minit ("VTYPE", AB_VTYPE),
+ minit ("VTAB", AB_VTAB),
minit (NULL, -1)
};
MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits);
if (attr->dimension)
MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
+ if (attr->codimension)
+ MIO_NAME (ab_attribute) (AB_CODIMENSION, attr_bits);
+ if (attr->contiguous)
+ MIO_NAME (ab_attribute) (AB_CONTIGUOUS, attr_bits);
if (attr->external)
MIO_NAME (ab_attribute) (AB_EXTERNAL, attr_bits);
if (attr->intrinsic)
MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits);
if (attr->private_comp)
MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
+ if (attr->coarray_comp)
+ MIO_NAME (ab_attribute) (AB_COARRAY_COMP, attr_bits);
if (attr->zero_comp)
MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits);
if (attr->is_class)
MIO_NAME (ab_attribute) (AB_PROCEDURE, attr_bits);
if (attr->proc_pointer)
MIO_NAME (ab_attribute) (AB_PROC_POINTER, attr_bits);
+ if (attr->vtype)
+ MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
+ if (attr->vtab)
+ MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
mio_rparen ();
case AB_DIMENSION:
attr->dimension = 1;
break;
+ case AB_CODIMENSION:
+ attr->codimension = 1;
+ break;
+ case AB_CONTIGUOUS:
+ attr->contiguous = 1;
+ break;
case AB_EXTERNAL:
attr->external = 1;
break;
case AB_ALLOC_COMP:
attr->alloc_comp = 1;
break;
+ case AB_COARRAY_COMP:
+ attr->coarray_comp = 1;
+ break;
case AB_POINTER_COMP:
attr->pointer_comp = 1;
break;
case AB_PROC_POINTER:
attr->proc_pointer = 1;
break;
+ case AB_VTYPE:
+ attr->vtype = 1;
+ break;
+ case AB_VTAB:
+ attr->vtab = 1;
+ break;
}
}
}
}
mio_integer (&as->rank);
+ mio_integer (&as->corank);
as->type = MIO_NAME (array_type) (as->type, array_spec_types);
- for (i = 0; i < as->rank; i++)
+ for (i = 0; i < as->rank + as->corank; i++)
{
mio_expr (&as->lower[i]);
mio_expr (&as->upper[i]);
static void
-mio_constructor (gfc_constructor **cp)
+mio_constructor (gfc_constructor_base *cp)
{
- gfc_constructor *c, *tail;
+ gfc_constructor *c;
mio_lparen ();
if (iomode == IO_OUTPUT)
{
- for (c = *cp; c; c = c->next)
+ for (c = gfc_constructor_first (*cp); c; c = gfc_constructor_next (c))
{
mio_lparen ();
mio_expr (&c->expr);
}
else
{
- *cp = NULL;
- tail = NULL;
-
while (peek_atom () != ATOM_RPAREN)
{
- c = gfc_get_constructor ();
-
- if (tail == NULL)
- *cp = c;
- else
- tail->next = c;
-
- tail = c;
+ c = gfc_constructor_append_expr (cp, NULL, NULL);
mio_lparen ();
mio_expr (&c->expr);
if (iomode == IO_INPUT)
{
- *proc = gfc_get_typebound_proc ();
+ *proc = gfc_get_typebound_proc (NULL);
(*proc)->where = gfc_current_locus;
}
gcc_assert (*proc);
if (st_sym == rsym)
return false;
+ if (st_sym->attr.vtab || st_sym->attr.vtype)
+ return false;
+
/* If the existing symbol is generic from a different module and
the new symbol is generic there can be no ambiguity. */
if (st_sym->attr.generic
return;
}
+ if (gfc_cpp_makedep ())
+ gfc_cpp_add_target (filename);
+
/* Write the module to the temporary file. */
module_fp = fopen (filename_tmp, "w");
if (module_fp == NULL)
gfc_fatal_error ("Can't open module file '%s' for writing at %C: %s",
- filename_tmp, strerror (errno));
+ filename_tmp, xstrerror (errno));
/* Write the header, including space reserved for the MD5 sum. */
now = time (NULL);
if (fclose (module_fp))
gfc_fatal_error ("Error writing module file '%s' for writing: %s",
- filename_tmp, strerror (errno));
+ filename_tmp, xstrerror (errno));
/* Read the MD5 from the header of the old module file and compare. */
if (read_md5_from_module_file (filename, md5_old) != 0
/* Module file have changed, replace the old one. */
if (unlink (filename) && errno != ENOENT)
gfc_fatal_error ("Can't delete module file '%s': %s", filename,
- strerror (errno));
+ xstrerror (errno));
if (rename (filename_tmp, filename))
gfc_fatal_error ("Can't rename module file '%s' to '%s': %s",
- filename_tmp, filename, strerror (errno));
+ filename_tmp, filename, xstrerror (errno));
}
else
{
if (unlink (filename_tmp))
gfc_fatal_error ("Can't delete temporary module file '%s': %s",
- filename_tmp, strerror (errno));
+ filename_tmp, xstrerror (errno));
}
}
sym->attr.flavor = FL_PARAMETER;
sym->ts.type = BT_INTEGER;
sym->ts.kind = gfc_default_integer_kind;
- sym->value = gfc_int_expr (value);
+ sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL, value);
sym->attr.use_assoc = 1;
sym->from_intmod = module;
sym->intmod_sym_id = id;
{
local_name = NULL;
- if ((gfc_option.allow_std & symbol[i].standard) == 0)
- break;
-
for (u = gfc_rename_list; u; u = u->next)
{
if (strcmp (symbol[i].name, u->use_name) == 0)
}
}
+ if (u && gfc_notify_std (symbol[i].standard, "The symbol '%s', "
+ "referrenced at %C, is not in the selected "
+ "standard", symbol[i].name) == FAILURE)
+ continue;
+ else if ((gfc_option.allow_std & symbol[i].standard) == 0)
+ 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 "
if (module_fp == NULL)
gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s",
- filename, strerror (errno));
+ filename, xstrerror (errno));
/* Check that we haven't already USEd an intrinsic module with the
same name. */