procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/39850 (Too strict checking for procedures as actual argument)

Browse source 
2009-06-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39850
	* interface.c (gfc_compare_interfaces): Take care of implicit typing
	when checking the function attribute. Plus another bugfix.
	(compare_parameter): Set attr.function and attr.subroutine according
	to the usage of a procedure as actual argument.


2009-06-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39850
	* gfortran.dg/interface_19.f90: Add 'cleanup-modules'.
	* gfortran.dg/interface_20.f90: Ditto.
	* gfortran.dg/interface_21.f90: Ditto.
	* gfortran.dg/interface_22.f90: Ditto.
	* gfortran.dg/interface_30.f90: New.
	* gfortran.dg/proc_ptr_11.f90: Fix invalid test case.

From-SVN: r148767
This commit is contained in:
Janus Weil 2009-06-21 21:05:35 +02:00
parent 45a1ba933e
commit 9b63f28250
9 changed files with 80 additions and 5 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-06-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/39850
* interface.c (gfc_compare_interfaces): Take care of implicit typing
when checking the function attribute. Plus another bugfix.
(compare_parameter): Set attr.function and attr.subroutine according
to the usage of a procedure as actual argument.
2009-06-20 Tobias Burnus <burnus@net-b.de>
PR fortran/40452

16
gcc/fortran/interface.c
View file

@ -939,7 +939,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag,
{
gfc_formal_arglist *f1, *f2;
if (s1->attr.function && !s2->attr.function)
if (s1->attr.function && (s2->attr.subroutine
|| (!s2->attr.function && s2->ts.type == BT_UNKNOWN
&& gfc_get_default_type (s2->name, s2->ns)->type == BT_UNKNOWN)))
{
if (errmsg != NULL)
snprintf (errmsg, err_len, "'%s' is not a function", s2->name);
@ -967,8 +969,6 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag,
"of '%s'", s2->name);
return 0;
}
if (s1->attr.if_source == IFSRC_DECL)
return 1;
}
if (s1->attr.if_source == IFSRC_UNKNOWN
@ -1388,6 +1388,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
if (actual->ts.type == BT_PROCEDURE)
{
char err[200];
gfc_symbol *act_sym = actual->symtree->n.sym;
if (formal->attr.flavor != FL_PROCEDURE)
{
@ -1396,7 +1397,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
return 0;
}
if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1, err,
if (!gfc_compare_interfaces (formal, act_sym, 0, 1, err,
sizeof(err)))
{
if (where)
@ -1405,6 +1406,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
return 0;
}
if (formal->attr.function && !act_sym->attr.function)
gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at);
if (formal->attr.subroutine && !act_sym->attr.subroutine)
gfc_add_subroutine (&act_sym->attr, act_sym->name,
&act_sym->declared_at);
return 1;
}

10
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,13 @@
2009-06-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/39850
* gfortran.dg/interface_19.f90: Add 'cleanup-modules'.
* gfortran.dg/interface_20.f90: Ditto.
* gfortran.dg/interface_21.f90: Ditto.
* gfortran.dg/interface_22.f90: Ditto.
* gfortran.dg/interface_30.f90: New.
* gfortran.dg/proc_ptr_11.f90: Fix invalid test case.
2009-06-21 Uros Bizjak <ubizjak@gmail.com>
* gcc.dg/tree-ssa/fre-vce-1.c: Cleanup "fre" tree dump.

3
gcc/testsuite/gfortran.dg/interface_19.f90
View file

@ -27,3 +27,6 @@ intrinsic dcos
call sub()
call sub(dcos)
end
! { dg-final { cleanup-modules "m" } }

3
gcc/testsuite/gfortran.dg/interface_20.f90
View file

@ -18,3 +18,6 @@ implicit none
intrinsic cos
call sub(cos) ! { dg-error "wrong number of arguments" }
end
! { dg-final { cleanup-modules "m" } }

3
gcc/testsuite/gfortran.dg/interface_21.f90
View file

@ -20,3 +20,6 @@ implicit none
EXTERNAL foo ! implicit interface is undefined
call sub(foo) ! { dg-error "is not a function" }
end
! { dg-final { cleanup-modules "m" } }

3
gcc/testsuite/gfortran.dg/interface_22.f90
View file

@ -23,3 +23,6 @@ module gswap
module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
end interface swap
end module gswap
! { dg-final { cleanup-modules "foo g gswap" } }

37
gcc/testsuite/gfortran.dg/interface_30.f90 Normal file
View file

@ -0,0 +1,37 @@
! { dg-do compile }
!
! PR39850: Too strict checking for procedures as actual argument
!
! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
! Modified by Janus Weil <janus@gcc.gnu.org>
real function func()
print *,"func"
func = 42.0
end function func
program test
external func1,func2,func3,func4 ! subroutine or implicitly typed real function
call sub1(func1)
call sub2(func2)
call sub1(func3)
call sub2(func3) ! { dg-error "Type mismatch in argument" }
call sub2(func4)
call sub1(func4) ! { dg-error "Interface mismatch in dummy procedure" }
contains
subroutine sub1(a1)
interface
real function a1()
end function
end interface
print *, a1()
end subroutine sub1
subroutine sub2(a2)
interface
subroutine a2
end subroutine
end interface
call a2()
end subroutine
end

2
gcc/testsuite/gfortran.dg/proc_ptr_11.f90
View file

@ -55,7 +55,7 @@ program bsp
end function add
integer function f(x)
integer :: x
integer,intent(in) :: x
f = 317 + x
end function