re PR fortran/30880 (Derived types with default value -- function with ENTRY: rejected at compile time)
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:
parent
4c6b3ec750
commit
145bdc2cbc
|
@ -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>
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/30872
|
PR fortran/30872
|
||||||
|
|
|
@ -5648,7 +5648,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|
||||||
|| sym->as->upper[i] == NULL
|
|| sym->as->upper[i] == NULL
|
||||||
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
|
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
flag = 1;
|
flag = 2;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -5670,7 +5670,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|
||||||
else if (sym->attr.external)
|
else if (sym->attr.external)
|
||||||
gfc_error ("External '%s' at %L cannot have an initializer",
|
gfc_error ("External '%s' at %L cannot have an initializer",
|
||||||
sym->name, &sym->declared_at);
|
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",
|
gfc_error ("Dummy '%s' at %L cannot have an initializer",
|
||||||
sym->name, &sym->declared_at);
|
sym->name, &sym->declared_at);
|
||||||
else if (sym->attr.intrinsic)
|
else if (sym->attr.intrinsic)
|
||||||
|
@ -5679,12 +5680,15 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|
||||||
else if (sym->attr.result)
|
else if (sym->attr.result)
|
||||||
gfc_error ("Function result '%s' at %L cannot have an initializer",
|
gfc_error ("Function result '%s' at %L cannot have an initializer",
|
||||||
sym->name, &sym->declared_at);
|
sym->name, &sym->declared_at);
|
||||||
else
|
else if (flag == 2)
|
||||||
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
|
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
|
||||||
sym->name, &sym->declared_at);
|
sym->name, &sym->declared_at);
|
||||||
|
else
|
||||||
|
goto no_init_error;
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
no_init_error:
|
||||||
/* Check to see if a derived type is blocked from being host associated
|
/* 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.
|
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. */
|
14.6.1.3 of the standard and the discussion on comp.lang.fortran. */
|
||||||
|
|
|
@ -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>
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/30872
|
PR fortran/30872
|
||||||
|
|
|
@ -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" } }
|
Loading…
Reference in New Issue