mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 12:01:06 +08:00
Code Issues Packages Projects Releases Wiki Activity

resolve.c (resolve_fl_procedure): Allow private dummies for Fortran 2003.

Browse Source 
2007-09-17  Tobias Burnus  <burnus@net-b.de>

	* resolve.c (resolve_fl_procedure): Allow private dummies
	for Fortran 2003.

2007-09-17  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/interface_15.f90: Compile with -std=f95.
	* gfortran.dg/private_type_1.f90: Ditto
	* gfortran.dg/interface_18.f90: New.
	* gfortran.dg/private_type_8.f90: New.

From-SVN: r128541
This commit is contained in:
Tobias Burnus 2007-09-17 12:12:06 +02:00 committed by Tobias Burnus
parent dfcf0b12d1
commit 0ab7816b23
7 changed files with 76 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2007-09-17 Tobias Burnus <burnus@net-b.de>
* resolve.c (resolve_fl_procedure): Allow private dummies
for Fortran 2003.
2007-09-17 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* trans-types.c (gfc_get_desc_dim_type): Do not to try

35
gcc/fortran/resolve.c
View File

@ -6885,12 +6885,13 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.derived->attr.use_assoc
&& !gfc_check_access (arg->sym->ts.derived->attr.access,
arg->sym->ts.derived->ns->default_access))
arg->sym->ts.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
"PRIVATE type and cannot be a dummy argument"
" of '%s', which is PUBLIC at %L",
arg->sym->name, sym->name, &sym->declared_at)
== FAILURE)
{
gfc_error_now ("'%s' is of a PRIVATE type and cannot be "
"a dummy argument of '%s', which is "
"PUBLIC at %L", arg->sym->name, sym->name,
&sym->declared_at);
/* Stop this message from recurring. */
arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;
@ -6907,12 +6908,14 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.derived->attr.use_assoc
&& !gfc_check_access (arg->sym->ts.derived->attr.access,
arg->sym->ts.derived->ns->default_access))
arg->sym->ts.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
"PRIVATE", iface->sym->name, sym->name,
&iface->sym->declared_at,
gfc_typename (&arg->sym->ts)) == FAILURE)
{
gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes "
"dummy arguments of '%s' which is PRIVATE",
iface->sym->name, sym->name, &iface->sym->declared_at,
gfc_typename(&arg->sym->ts));
/* Stop this message from recurring. */
arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;
@ -6930,12 +6933,14 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.derived->attr.use_assoc
&& !gfc_check_access (arg->sym->ts.derived->attr.access,
arg->sym->ts.derived->ns->default_access))
arg->sym->ts.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
"PRIVATE", iface->sym->name, sym->name,
&iface->sym->declared_at,
gfc_typename (&arg->sym->ts)) == FAILURE)
{
gfc_error_now ("Procedure '%s' in PUBLIC interface '%s' at %L takes "
"dummy arguments of '%s' which is PRIVATE",
iface->sym->name, sym->name, &iface->sym->declared_at,
gfc_typename(&arg->sym->ts));
/* Stop this message from recurring. */
arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2007-09-17 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/interface_15.f90: Compile with -std=f95.
* gfortran.dg/private_type_1.f90: Ditto
* gfortran.dg/interface_18.f90: New.
* gfortran.dg/private_type_8.f90: New.
2007-09-16 Paolo Carlini <pcarlini@suse.de>
PR c++/33124

2
gcc/testsuite/gfortran.dg/interface_15.f90
View File

@ -1,5 +1,5 @@
! { dg-do compile }
! { dg-options "-c" }
! { dg-options "-c -std=f95" }
! Testcase from PR fortran/25094
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>

21
gcc/testsuite/gfortran.dg/interface_18.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! Public procedures with private types for the dummies
! is valid F2003, but invalid per Fortran 95, Sect. 5.2.3
! See interface_15.f90 for the F95 test case.
!
module mytype_application
implicit none
private
public :: mytype_test
type :: mytype_type
integer :: i=0
end type mytype_type
contains
subroutine mytype_test( mytype )
type(mytype_type), intent(in out) :: mytype
end subroutine mytype_test
end module mytype_application
! { dg-final { cleanup-modules "mytype_application" } }

1
gcc/testsuite/gfortran.dg/private_type_1.f90
View File

@ -1,4 +1,5 @@
! { dg-do compile }
! { dg-options "-std=f95" }
! PR21986 - test based on original example.
! A public subroutine must not have private-type, dummy arguments.
! Contributed by Paul Thomas <pault@gcc.gnu.org>

21
gcc/testsuite/gfortran.dg/private_type_8.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
! A public subroutine can have private-type, dummy arguments
! in Fortran 2003 (but not in Fortran 95).
! See private_type_1.f90 for the F95 test.
!
module modboom
implicit none
private
public:: dummysub
type:: intwrapper
integer n
end type intwrapper
contains
subroutine dummysub(size, arg_array)
type(intwrapper) :: size
real, dimension(size%n) :: arg_array
real :: local_array(4)
end subroutine dummysub
end module modboom
! { dg-final { cleanup-modules "modboom" } }