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

re PR fortran/39996 (Double typing of function results not detected)

Browse Source 
2009-05-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39996
	* decl.c (gfc_match_function_decl): Use gfc_add_type.
	* symbol.c (gfc_add_type): Better checking for duplicate types in
	function declarations. And: Always give an error for duplicte types,
	not just a warning with -std=gnu.


2009-05-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39996
	* gfortran.dg/func_decl_2.f90: Modified (replacing warnings by errors).
	* gfortran.dg/duplicate_type_2.f90: Ditto.
	* gfortran.dg/duplicate_type_3.f90: New.

From-SVN: r147528
This commit is contained in:
Janus Weil 2009-05-14 11:41:41 +02:00
parent e1a0296342
commit 6de7294fd4
7 changed files with 90 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2009-05-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/39996
* decl.c (gfc_match_function_decl): Use gfc_add_type.
* symbol.c (gfc_add_type): Better checking for duplicate types in
function declarations. And: Always give an error for duplicte types,
not just a warning with -std=gnu.
2009-05-14 Jakub Jelinek <jakub@redhat.com>
PR fortran/39865

17
gcc/fortran/decl.c
View File

@ -4708,14 +4708,6 @@ gfc_match_function_decl (void)
|| copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
goto cleanup;
if (current_ts.type != BT_UNKNOWN && sym->ts.type != BT_UNKNOWN
&& !sym->attr.implicit_type)
{
gfc_error ("Function '%s' at %C already has a type of %s", name,
gfc_basic_typename (sym->ts.type));
goto cleanup;
}
/* Delay matching the function characteristics until after the
specification block by signalling kind=-1. */
sym->declared_at = old_loc;
@ -4726,12 +4718,17 @@ gfc_match_function_decl (void)
if (result == NULL)
{
sym->ts = current_ts;
if (current_ts.type != BT_UNKNOWN
&& gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
goto cleanup;
sym->result = sym;
}
else
{
result->ts = current_ts;
if (current_ts.type != BT_UNKNOWN
&& gfc_add_type (result, &current_ts, &gfc_current_locus)
== FAILURE)
goto cleanup;
sym->result = result;
}

31
gcc/fortran/symbol.c
View File

@ -1559,31 +1559,30 @@ gfc_try
gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
{
sym_flavor flavor;
bt type;
if (where == NULL)
where = &gfc_current_locus;
if (sym->ts.type != BT_UNKNOWN)
if (sym->result)
type = sym->result->ts.type;
else
type = sym->ts.type;
if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
type = sym->ns->proc_name->ts.type;
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type))
{
const char *msg = "Symbol '%s' at %L already has basic type of %s";
if (!(sym->ts.type == ts->type && sym->attr.result)
|| gfc_notification_std (GFC_STD_GNU) == ERROR
|| pedantic)
{
gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
return FAILURE;
}
if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
gfc_basic_typename (sym->ts.type)) == FAILURE)
return FAILURE;
if (gfc_option.warn_surprising)
gfc_warning (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
where, gfc_basic_typename (type));
return FAILURE;
}
if (sym->attr.procedure && sym->ts.interface)
{
gfc_error ("Procedure '%s' at %L may not have basic type of %s", sym->name, where,
gfc_basic_typename (ts->type));
gfc_error ("Procedure '%s' at %L may not have basic type of %s",
sym->name, where, gfc_basic_typename (ts->type));
return FAILURE;
}

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2009-05-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/39996
* gfortran.dg/func_decl_2.f90: Modified (replacing warnings by errors).
* gfortran.dg/duplicate_type_2.f90: Ditto.
* gfortran.dg/duplicate_type_3.f90: New.
2009-05-14 Laurent GUERBY <laurent@guerby.net>
* ada/acats/tests/c3/c38202a.ada: Use Impdef.

6
gcc/testsuite/gfortran.dg/duplicate_type_2.f90
View File

@ -7,14 +7,14 @@
INTEGER FUNCTION foo ()
IMPLICIT NONE
INTEGER :: foo ! { dg-warning "basic type of" }
INTEGER :: foo ! { dg-warning "basic type of" }
INTEGER :: foo ! { dg-error "basic type of" }
INTEGER :: foo ! { dg-error "basic type of" }
foo = 42
END FUNCTION foo
INTEGER FUNCTION bar () RESULT (x)
IMPLICIT NONE
INTEGER :: x ! { dg-warning "basic type of" }
INTEGER :: x ! { dg-error "basic type of" }
INTEGER :: y
INTEGER :: y ! { dg-error "basic type of" }

48
gcc/testsuite/gfortran.dg/duplicate_type_3.f90 Normal file
View File

@ -0,0 +1,48 @@
! { dg-do compile }
!
! PR 39996: Double typing of function results not detected
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
interface
real function A ()
end function
end interface
real :: A ! { dg-error "already has basic type of" }
real :: B
interface
real function B () ! { dg-error "already has basic type of" }
end function ! { dg-error "Expecting END INTERFACE statement" }
end interface
interface
function C ()
real :: C
end function
end interface
real :: C ! { dg-error "already has basic type of" }
real :: D
interface
function D ()
real :: D ! { dg-error "already has basic type of" }
end function
end interface
interface
function E () result (s)
real ::s
end function
end interface
real :: E ! { dg-error "already has basic type of" }
real :: F
interface
function F () result (s)
real ::s ! { dg-error "already has basic type of" }
end function F
end interface
end

6
gcc/testsuite/gfortran.dg/func_decl_2.f90
View File

@ -1,8 +1,6 @@
! { dg-do compile }
! Test fix for PR16943 in which the double typing of
! N caused an error. This is a common extension to the
! F95 standard, so the error is only thrown for -std=f95
! or -pedantic.
! N caused an error.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
@ -14,7 +12,7 @@
integer function bugf(M) result (N)
integer, intent (in) :: M
integer :: N ! { dg-warning "already has basic type of INTEGER" }
integer :: N ! { dg-error "already has basic type of INTEGER" }
N = M
return
end function bugf