mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-21 08:30:35 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/30880 (Derived types with default value -- function with ENTRY: rejected at compile time)

Browse Source 
2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30880
	* resolve.c (resolve_fl_variable): Set flag to 2 for automatic
	arrays.  Make condition for automatic array error explicit.
	If a dummy, no error on an INTENT(OUT) derived type.

2007-04-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30880
	* gfortran.dg/used_dummy_types_8.f90: New test.

From-SVN: r123645
This commit is contained in:
Paul Thomas 2007-04-07 20:25:43 +00:00
parent 4c6b3ec750
commit 145bdc2cbc
4 changed files with 54 additions and 3 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-04-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30880
* resolve.c (resolve_fl_variable): Set flag to 2 for automatic
arrays. Make condition for automatic array error explicit.
If a dummy, no error on an INTENT(OUT) derived type.
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30872

10
gcc/fortran/resolve.c
View File

@ -5648,7 +5648,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|| sym->as->upper[i] == NULL
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
{
flag = 1;
flag = 2;
break;
}
}
@ -5670,7 +5670,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
else if (sym->attr.external)
gfc_error ("External '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.dummy)
else if (sym->attr.dummy
&& !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
gfc_error ("Dummy '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.intrinsic)
@ -5679,12 +5680,15 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
else if (sym->attr.result)
gfc_error ("Function result '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else
else if (flag == 2)
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else
goto no_init_error;
return FAILURE;
}
no_init_error:
/* Check to see if a derived type is blocked from being host associated
by the presence of another class I symbol in the same namespace.
14.6.1.3 of the standard and the discussion on comp.lang.fortran. */

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30880
* gfortran.dg/used_dummy_types_8.f90: New test.
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30872

35
gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 Normal file
View File

@ -0,0 +1,35 @@
! { dg-do compile }
! Tests the fix for PR30880, in which the variable d1
! in module m1 would cause an error in the main program
! because it has an initializer and is a dummy. This
! came about because the function with multiple entries
! assigns the initializer earlier than for other cases.
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
MODULE M1
TYPE T1
INTEGER :: i=7
END TYPE T1
CONTAINS
FUNCTION F1(d1) RESULT(res)
INTEGER :: res
TYPE(T1), INTENT(OUT) :: d1
TYPE(T1), INTENT(INOUT) :: d2
res=d1%i
d1%i=0
RETURN
ENTRY E1(d2) RESULT(res)
res=d2%i
d2%i=0
END FUNCTION F1
END MODULE M1
USE M1
TYPE(T1) :: D1
D1=T1(3)
write(6,*) F1(D1)
D1=T1(3)
write(6,*) E1(D1)
END
! { dg-final { cleanup-modules "m1" } }