re PR fortran/40995 (Spurious "Type specified for intrinsic function...ignored" message)

2009-08-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40995
	* resolve.c (resolve_symbol): Move some checking code to
	resolve_intrinsic, and call this from here.
	(resolve_intrinsic): Some checking code moved here from resolve_symbol.
	Make sure each intrinsic is only resolved once.

2009-08-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40995
	* gfortran.dg/intrinsic_4.f90: New.
	* gfortran.dg/intrinsic_subroutine.f90: An error message moved to a
	different line.

From-SVN: r150716
This commit is contained in:
Janus Weil 2009-08-13 13:16:16 +02:00
parent e5fdcd8cc5
commit f6038131ce
5 changed files with 79 additions and 54 deletions

View File

@ -1,3 +1,11 @@
2009-08-13 Janus Weil <janus@gcc.gnu.org>
PR fortran/40995
* resolve.c (resolve_symbol): Move some checking code to
resolve_intrinsic, and call this from here.
(resolve_intrinsic): Some checking code moved here from resolve_symbol.
Make sure each intrinsic is only resolved once.
2009-08-12 Tobias Burnus <burnus@net-b.de>
PR fortran/41034

View File

@ -1148,24 +1148,64 @@ is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
static gfc_try
resolve_intrinsic (gfc_symbol *sym, locus *loc)
{
gfc_intrinsic_sym *isym = gfc_find_function (sym->name);
if (isym)
gfc_intrinsic_sym* isym;
const char* symstd;
if (sym->formal)
return SUCCESS;
/* We already know this one is an intrinsic, so we don't call
gfc_is_intrinsic for full checking but rather use gfc_find_function and
gfc_find_subroutine directly to check whether it is a function or
subroutine. */
if ((isym = gfc_find_function (sym->name)))
{
if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
&& !sym->attr.implicit_type)
gfc_warning ("Type specified for intrinsic function '%s' at %L is"
" ignored", sym->name, &sym->declared_at);
if (!sym->attr.function &&
gfc_add_function (&sym->attr, sym->name, loc) == FAILURE)
return FAILURE;
sym->ts = isym->ts;
}
else
else if ((isym = gfc_find_subroutine (sym->name)))
{
isym = gfc_find_subroutine (sym->name);
gcc_assert (isym);
if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
{
gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
" specifier", sym->name, &sym->declared_at);
return FAILURE;
}
if (!sym->attr.subroutine &&
gfc_add_subroutine (&sym->attr, sym->name, loc) == FAILURE)
return FAILURE;
}
if (!sym->formal)
gfc_copy_formal_args_intr (sym, isym);
else
{
gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name,
&sym->declared_at);
return FAILURE;
}
gfc_copy_formal_args_intr (sym, isym);
/* Check it is actually available in the standard settings. */
if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)
== FAILURE)
{
gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
" available in the current standard settings but %s. Use"
" an appropriate -std=* option or enable -fall-intrinsics"
" in order to use it.",
sym->name, &sym->declared_at, symstd);
return FAILURE;
}
return SUCCESS;
}
@ -9944,51 +9984,9 @@ resolve_symbol (gfc_symbol *sym)
/* Make sure that the intrinsic is consistent with its internal
representation. This needs to be done before assigning a default
type to avoid spurious warnings. */
if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic)
{
gfc_intrinsic_sym* isym;
const char* symstd;
/* We already know this one is an intrinsic, so we don't call
gfc_is_intrinsic for full checking but rather use gfc_find_function and
gfc_find_subroutine directly to check whether it is a function or
subroutine. */
if ((isym = gfc_find_function (sym->name)))
{
if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
&& !sym->attr.implicit_type)
gfc_warning ("Type specified for intrinsic function '%s' at %L is"
" ignored", sym->name, &sym->declared_at);
}
else if ((isym = gfc_find_subroutine (sym->name)))
{
if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
{
gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
" specifier", sym->name, &sym->declared_at);
return;
}
}
else
{
gfc_error ("'%s' declared INTRINSIC at %L does not exist",
sym->name, &sym->declared_at);
return;
}
/* Check it is actually available in the standard settings. */
if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)
== FAILURE)
{
gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
" available in the current standard settings but %s. Use"
" an appropriate -std=* option or enable -fall-intrinsics"
" in order to use it.",
sym->name, &sym->declared_at, symstd);
return;
}
}
if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
&& resolve_intrinsic (sym, &sym->declared_at) == FAILURE)
return;
/* Assign default type to symbols that need one and don't have one. */
if (sym->ts.type == BT_UNKNOWN)

View File

@ -1,3 +1,10 @@
2009-08-13 Janus Weil <janus@gcc.gnu.org>
PR fortran/40995
* gfortran.dg/intrinsic_4.f90: New.
* gfortran.dg/intrinsic_subroutine.f90: An error message moved to a
different line.
2009-08-13 Richard Guenther <rguenther@suse.de>
PR middle-end/41047

View File

@ -0,0 +1,12 @@
! { dg-do compile }
! { dg-options "-Wsurprising" }
!
! PR 40995: [4.5 Regression] Spurious "Type specified for intrinsic function...ignored" message
!
! Contributed by Mat Cross <mathewc@nag.co.uk>
subroutine sub(n,x)
intrinsic abs
integer n, x(abs(n))
end

View File

@ -1,7 +1,7 @@
! { dg-do compile }
! PR 33229
implicit none
intrinsic cpu_time
intrinsic cpu_time ! { dg-error "attribute conflicts with" }
real :: time
print *, CPU_TIME(TIME) ! { dg-error "attribute conflicts with" }
print *, CPU_TIME(TIME) ! { dg-error "is not a function" }
end