space is set to point to the master function, so that the fake
result mechanism can work. */
if (module_fcn_entry)
- rc = gfc_get_symbol (name, NULL, result);
+ {
+ /* Present if entry is declared to be a module procedure. */
+ rc = gfc_find_symbol (name, gfc_current_ns->parent, 0, result);
+ if (*result == NULL)
+ rc = gfc_get_symbol (name, NULL, result);
+ }
else
rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
/* Module function entries will already have a symtree in
the current namespace but will need one at module level. */
if (module_fcn_entry)
- st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
+ {
+ /* Present if entry is declared to be a module procedure. */
+ rc = gfc_find_sym_tree (name, gfc_current_ns->parent, 0, &st);
+ if (st == NULL)
+ st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
+ }
else
st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
/* See if the procedure should be a module procedure */
if (((sym->ns->proc_name != NULL
- && sym->ns->proc_name->attr.flavor == FL_MODULE
- && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
- && gfc_add_procedure (&sym->attr, PROC_MODULE,
- sym->name, NULL) == FAILURE)
+ && sym->ns->proc_name->attr.flavor == FL_MODULE
+ && sym->attr.proc != PROC_MODULE)
+ || (module_fcn_entry && sym->attr.proc != PROC_MODULE))
+ && gfc_add_procedure (&sym->attr, PROC_MODULE,
+ sym->name, NULL) == FAILURE)
rc = 2;
return rc;
--- /dev/null
+! { dg-do run }
+! Test fix for PR31474, in which the use of ENTRYs as module
+! procedures in a generic interface would cause an internal error.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+module a
+ interface b
+ module procedure c, d
+ end interface
+contains
+ real function d (i)
+ real c, i
+ integer j
+ d = 1.0
+ return
+ entry c (j)
+ d = 2.0
+ end function
+ real function e (i)
+ real f, i
+ integer j
+ e = 3.0
+ return
+ entry f (j)
+ e = 4.0
+ end function
+end module
+
+ use a
+ if (b (1.0) .ne. 1.0) call abort ()
+ if (b (1 ) .ne. 2.0) call abort ()
+ if (e (1.0) .ne. 3.0) call abort ()
+ if (f (1 ) .ne. 4.0) call abort ()
+end
+! { dg-final { cleanup-modules "a" } }