diff options
Diffstat (limited to 'gcc/fortran/module.c')
| -rw-r--r-- | gcc/fortran/module.c | 60 |
1 files changed, 59 insertions, 1 deletions
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 89281a5..4afe467 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1673,7 +1673,7 @@ typedef enum AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_POINTER_COMP, AB_PROC_POINTER_COMP, AB_PRIVATE_COMP, - AB_VALUE, AB_VOLATILE, AB_PROTECTED, + AB_VALUE, AB_VOLATILE, AB_PROTECTED, AB_LOCK_COMP, 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_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, @@ -1716,6 +1716,7 @@ static const mstring attr_bits[] = minit ("VALUE", AB_VALUE), minit ("ALLOC_COMP", AB_ALLOC_COMP), minit ("COARRAY_COMP", AB_COARRAY_COMP), + minit ("LOCK_COMP", AB_LOCK_COMP), minit ("POINTER_COMP", AB_POINTER_COMP), minit ("PROC_POINTER_COMP", AB_PROC_POINTER_COMP), minit ("PRIVATE_COMP", AB_PRIVATE_COMP), @@ -1889,6 +1890,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits); if (attr->coarray_comp) MIO_NAME (ab_attribute) (AB_COARRAY_COMP, attr_bits); + if (attr->lock_comp) + MIO_NAME (ab_attribute) (AB_LOCK_COMP, attr_bits); if (attr->zero_comp) MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits); if (attr->is_class) @@ -2028,6 +2031,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_COARRAY_COMP: attr->coarray_comp = 1; break; + case AB_LOCK_COMP: + attr->lock_comp = 1; + break; case AB_POINTER_COMP: attr->pointer_comp = 1; break; @@ -5469,6 +5475,37 @@ create_int_parameter_array (const char *name, int size, gfc_expr *value, } +/* Add an derived type for a given module. */ + +static void +create_derived_type (const char *name, 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, false); + sym = tmp_symtree->n.sym; + + sym->module = gfc_get_string (modname); + sym->from_intmod = module; + sym->intmod_sym_id = id; + sym->attr.flavor = FL_DERIVED; + sym->attr.private_comp = 1; + sym->attr.zero_comp = 1; + sym->attr.use_assoc = 1; +} + + /* USE the ISO_FORTRAN_ENV intrinsic module. */ @@ -5489,6 +5526,9 @@ use_iso_fortran_env_module (void) #define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d }, #include "iso-fortran-env.def" #undef NAMED_KINDARRAY +#define NAMED_DERIVED_TYPE(a,b,c,d) { a, b, 0, d }, +#include "iso-fortran-env.def" +#undef NAMED_DERIVED_TYPE #define NAMED_FUNCTION(a,b,c,d) { a, b, c, d }, #include "iso-fortran-env.def" #undef NAMED_FUNCTION @@ -5573,6 +5613,16 @@ use_iso_fortran_env_module (void) #include "iso-fortran-env.def" #undef NAMED_KINDARRAY +#define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \ + case a: +#include "iso-fortran-env.def" + create_derived_type (u->local_name[0] ? u->local_name + : u->use_name, + mod, INTMOD_ISO_FORTRAN_ENV, + symbol[i].id); + break; +#undef NAMED_DERIVED_TYPE + #define NAMED_FUNCTION(a,b,c,d) \ case a: #include "iso-fortran-env.def" @@ -5626,6 +5676,14 @@ use_iso_fortran_env_module (void) #include "iso-fortran-env.def" #undef NAMED_KINDARRAY +#define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \ + case a: +#include "iso-fortran-env.def" + create_derived_type (symbol[i].name, mod, INTMOD_ISO_FORTRAN_ENV, + symbol[i].id); + break; +#undef NAMED_DERIVED_TYPE + #define NAMED_FUNCTION(a,b,c,d) \ case a: #include "iso-fortran-env.def" |