diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index aedee5e979d..3f36021c0a1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-11-25 Paul Thomas + + PR fortran/33499 + * decl.c (get_proc_name): If ENTRY statement occurs before type + specification, set the symbol untyped and ensure that it is in + the procedure namespace. + 2007-11-24 Paul Thomas PR fortran/33541 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d66ea533ca7..ca17829cb87 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -715,9 +715,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (*result == NULL) rc = gfc_get_symbol (name, NULL, result); - else if (gfc_get_symbol (name, NULL, &sym) == 0 - && sym - && sym->ts.type != BT_UNKNOWN + else if (!gfc_get_symbol (name, NULL, &sym) && sym && (*result)->ts.type == BT_UNKNOWN && sym->attr.flavor == FL_UNKNOWN) /* Pick up the typespec for the entry, if declared in the function @@ -726,13 +724,24 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) is set to point to the module symbol and a unique symtree to the local version. This latter ensures a correct clearing of the symbols. */ - { + { + /* If the ENTRY proceeds its specification, we need to ensure + that this does not raise a "has no IMPLICIT type" error. */ + if (sym->ts.type == BT_UNKNOWN) + sym->attr.untyped = 1; + (*result)->ts = sym->ts; - gfc_find_sym_tree (name, gfc_current_ns, 0, &st); - st->n.sym = *result; - st = gfc_get_unique_symtree (gfc_current_ns); - st->n.sym = sym; - } + + /* Put the symbol in the procedure namespace so that, should + the ENTRY preceed its specification, the specification + can be applied. */ + (*result)->ns = gfc_current_ns; + + gfc_find_sym_tree (name, gfc_current_ns, 0, &st); + st->n.sym = *result; + st = gfc_get_unique_symtree (gfc_current_ns); + st->n.sym = sym; + } } else rc = gfc_get_symbol (name, gfc_current_ns->parent, result); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c09ab0d08b0..9ec0be0e38e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-11-25 Paul Thomas + + PR fortran/33499 + * gfortran.dg/entry_16.f90: New test. + 2007-11-24 Tobias Burnus PR fortran/34192 diff --git a/gcc/testsuite/gfortran.dg/entry_16.f90 b/gcc/testsuite/gfortran.dg/entry_16.f90 new file mode 100644 index 00000000000..ba8eff86b8d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_16.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! Tests the fix for PR33499 in which the ENTRY cx_radc was not +! getting its TYPE. +! +! Contributed by Michael Richmond +! +MODULE complex + IMPLICIT NONE + PRIVATE + PUBLIC :: cx, OPERATOR(+), OPERATOR(.eq.) + TYPE cx + integer :: re + integer :: im + END TYPE cx + INTERFACE OPERATOR (+) + MODULE PROCEDURE cx_cadr, cx_radc + END INTERFACE + INTERFACE OPERATOR (.eq.) + MODULE PROCEDURE cx_eq + END INTERFACE + CONTAINS + FUNCTION cx_cadr(z, r) + ENTRY cx_radc(r, z) + TYPE (cx) :: cx_cadr, cx_radc + TYPE (cx), INTENT(IN) :: z + integer, INTENT(IN) :: r + cx_cadr%re = z%re + r + cx_cadr%im = z%im + END FUNCTION cx_cadr + FUNCTION cx_eq(u, v) + TYPE (cx), INTENT(IN) :: u, v + logical :: cx_eq + cx_eq = (u%re .eq. v%re) .and. (u%im .eq. v%im) + END FUNCTION cx_eq +END MODULE complex + + use complex + type(cx) :: a = cx (1, 2), c, d + logical :: f + integer :: b = 3 + if (.not.((a + b) .eq. (b + a))) call abort () + if (.not.((a + b) .eq. cx (4, 2))) call abort () +end