diff options
Diffstat (limited to 'gcc/fortran/module.c')
-rw-r--r-- | gcc/fortran/module.c | 41 |
1 files changed, 39 insertions, 2 deletions
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index bdd9961..ec67960 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3136,6 +3136,7 @@ static const mstring intrinsics[] = minit ("LE", INTRINSIC_LE_OS), minit ("NOT", INTRINSIC_NOT), minit ("PARENTHESES", INTRINSIC_PARENTHESES), + minit ("USER", INTRINSIC_USER), minit (NULL, -1) }; @@ -3172,7 +3173,8 @@ fix_mio_expr (gfc_expr *e) && !e->symtree->n.sym->attr.dummy) e->symtree = ns_st; } - else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) + else if (e->expr_type == EXPR_FUNCTION + && (e->value.function.name || e->value.function.isym)) { gfc_symbol *sym; @@ -3287,6 +3289,32 @@ mio_expr (gfc_expr **ep) mio_expr (&e->value.op.op2); break; + case INTRINSIC_USER: + /* INTRINSIC_USER should not appear in resolved expressions, + though for UDRs we need to stream unresolved ones. */ + if (iomode == IO_OUTPUT) + write_atom (ATOM_STRING, e->value.op.uop->name); + else + { + char *name = read_string (); + const char *uop_name = find_use_name (name, true); + if (uop_name == NULL) + { + size_t len = strlen (name); + char *name2 = XCNEWVEC (char, len + 2); + memcpy (name2, name, len); + name2[len] = ' '; + name2[len + 1] = '\0'; + free (name); + uop_name = name = name2; + } + e->value.op.uop = gfc_get_uop (uop_name); + free (name); + } + mio_expr (&e->value.op.op1); + mio_expr (&e->value.op.op2); + break; + default: bad_module ("Bad operator"); } @@ -3305,6 +3333,8 @@ mio_expr (gfc_expr **ep) flag = 1; else if (e->ref) flag = 2; + else if (e->value.function.isym == NULL) + flag = 3; else flag = 0; mio_integer (&flag); @@ -3316,6 +3346,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: write_atom (ATOM_STRING, e->value.function.isym->name); } @@ -3323,7 +3355,10 @@ mio_expr (gfc_expr **ep) else { require_atom (ATOM_STRING); - e->value.function.name = gfc_get_string (atom_string); + if (atom_string[0] == '\0') + e->value.function.name = NULL; + else + e->value.function.name = gfc_get_string (atom_string); free (atom_string); mio_integer (&flag); @@ -3335,6 +3370,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: require_atom (ATOM_STRING); e->value.function.isym = gfc_find_function (atom_string); |