OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/33499 (Rejects valid module with a contained function with an ENTRY)

Browse Source 
2007-11-25  Paul Thomas  <pault@gcc.gnu.org>

	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-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33499
	* gfortran.dg/entry_16.f90: New test.

From-SVN: r130403
This commit is contained in:
Paul Thomas 2007-11-25 09:59:42 +00:00
parent 1bfcad84ab
commit 2e32a71e41
4 changed files with 73 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2007-11-25 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/33541

27
gcc/fortran/decl.c
View File

@ -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);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-11-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33499
* gfortran.dg/entry_16.f90: New test.
2007-11-24 Tobias Burnus <burnus@net-b.de>
PR fortran/34192

43
gcc/testsuite/gfortran.dg/entry_16.f90 Normal file
View File

@ -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 <michael.a.richmond@nasa.gov>
!
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