resolve.c (resolve_symbol): Fix coarray result-var check.
2011-08-15 Tobias Burnus <burnus@net-b.de> * resolve.c (resolve_symbol): Fix coarray result-var check. 2011-08-15 Tobias Burnus <burnus@net-b.de> * gfortran.dg/coarray_26.f90: New. From-SVN: r177767
This commit is contained in:
parent
efec771ab9
commit
e535f1b229
|
@ -1,3 +1,7 @@
|
||||||
|
2011-08-15 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
|
* resolve.c (resolve_symbol): Fix coarray result-var check.
|
||||||
|
|
||||||
2011-08-14 Steven G. Kargl <kargl@gcc.gnu.org>
|
2011-08-14 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||||
|
|
||||||
* module.c (use_iso_fortran_env_module): Spell 'referrenced' correctly.
|
* module.c (use_iso_fortran_env_module): Spell 'referrenced' correctly.
|
||||||
|
|
|
@ -12246,29 +12246,41 @@ resolve_symbol (gfc_symbol *sym)
|
||||||
/* F2008, C542. */
|
/* F2008, C542. */
|
||||||
if (sym->ts.type == BT_DERIVED && sym->attr.dummy
|
if (sym->ts.type == BT_DERIVED && sym->attr.dummy
|
||||||
&& sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
|
&& sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
|
||||||
|
{
|
||||||
gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be "
|
gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be "
|
||||||
"INTENT(OUT)", sym->name, &sym->declared_at);
|
"INTENT(OUT)", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
/* F2008, C526. */
|
/* F2008, C525. */
|
||||||
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|
||||||
|| sym->attr.codimension)
|
|| sym->attr.codimension)
|
||||||
&& sym->attr.result)
|
&& (sym->attr.result || sym->result == sym))
|
||||||
gfc_error ("Function result '%s' at %L shall not be a coarray or have "
|
{
|
||||||
|
gfc_error ("Function result '%s' at %L shallolvnot be a coarray or have "
|
||||||
"a coarray component", sym->name, &sym->declared_at);
|
"a coarray component", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
/* F2008, C524. */
|
/* F2008, C524. */
|
||||||
if (sym->attr.codimension && sym->ts.type == BT_DERIVED
|
if (sym->attr.codimension && sym->ts.type == BT_DERIVED
|
||||||
&& sym->ts.u.derived->ts.is_iso_c)
|
&& sym->ts.u.derived->ts.is_iso_c)
|
||||||
|
{
|
||||||
gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
|
gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
|
||||||
"shall not be a coarray", sym->name, &sym->declared_at);
|
"shall not be a coarray", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
/* F2008, C525. */
|
/* F2008, C525. */
|
||||||
if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp
|
if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp
|
||||||
&& (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension
|
&& (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension
|
||||||
|| sym->attr.allocatable))
|
|| sym->attr.allocatable))
|
||||||
|
{
|
||||||
gfc_error ("Variable '%s' at %L with coarray component "
|
gfc_error ("Variable '%s' at %L with coarray component "
|
||||||
"shall be a nonpointer, nonallocatable scalar",
|
"shall be a nonpointer, nonallocatable scalar",
|
||||||
sym->name, &sym->declared_at);
|
sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
/* F2008, C526. The function-result case was handled above. */
|
/* F2008, C526. The function-result case was handled above. */
|
||||||
if (sym->attr.codimension
|
if (sym->attr.codimension
|
||||||
|
@ -12277,32 +12289,46 @@ resolve_symbol (gfc_symbol *sym)
|
||||||
|| sym->ns->proc_name->attr.flavor == FL_MODULE
|
|| sym->ns->proc_name->attr.flavor == FL_MODULE
|
||||||
|| sym->ns->proc_name->attr.is_main_program
|
|| sym->ns->proc_name->attr.is_main_program
|
||||||
|| sym->attr.function || sym->attr.result || sym->attr.use_assoc))
|
|| sym->attr.function || sym->attr.result || sym->attr.use_assoc))
|
||||||
|
{
|
||||||
gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE "
|
gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE "
|
||||||
"nor a dummy argument", sym->name, &sym->declared_at);
|
"nor a dummy argument", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
/* F2008, C528. */ /* FIXME: sym->as check due to PR 43412. */
|
/* F2008, C528. */ /* FIXME: sym->as check due to PR 43412. */
|
||||||
else if (sym->attr.codimension && !sym->attr.allocatable
|
else if (sym->attr.codimension && !sym->attr.allocatable
|
||||||
&& sym->as && sym->as->cotype == AS_DEFERRED)
|
&& sym->as && sym->as->cotype == AS_DEFERRED)
|
||||||
|
{
|
||||||
gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
|
gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
|
||||||
"deferred shape", sym->name, &sym->declared_at);
|
"deferred shape", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
else if (sym->attr.codimension && sym->attr.allocatable
|
else if (sym->attr.codimension && sym->attr.allocatable
|
||||||
&& (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
|
&& (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
|
||||||
|
{
|
||||||
gfc_error ("Allocatable coarray variable '%s' at %L must have "
|
gfc_error ("Allocatable coarray variable '%s' at %L must have "
|
||||||
"deferred shape", sym->name, &sym->declared_at);
|
"deferred shape", sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
/* F2008, C541. */
|
/* F2008, C541. */
|
||||||
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|
||||||
|| (sym->attr.codimension && sym->attr.allocatable))
|
|| (sym->attr.codimension && sym->attr.allocatable))
|
||||||
&& sym->attr.dummy && sym->attr.intent == INTENT_OUT)
|
&& sym->attr.dummy && sym->attr.intent == INTENT_OUT)
|
||||||
|
{
|
||||||
gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
|
gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
|
||||||
"allocatable coarray or have coarray components",
|
"allocatable coarray or have coarray components",
|
||||||
sym->name, &sym->declared_at);
|
sym->name, &sym->declared_at);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
if (sym->attr.codimension && sym->attr.dummy
|
if (sym->attr.codimension && sym->attr.dummy
|
||||||
&& sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
|
&& sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
|
||||||
|
{
|
||||||
gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
|
gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
|
||||||
"procedure '%s'", sym->name, &sym->declared_at,
|
"procedure '%s'", sym->name, &sym->declared_at,
|
||||||
sym->ns->proc_name->name);
|
sym->ns->proc_name->name);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
switch (sym->attr.flavor)
|
switch (sym->attr.flavor)
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,3 +1,7 @@
|
||||||
|
2011-08-15 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
|
* gfortran.dg/coarray_26.f90: New.
|
||||||
|
|
||||||
2011-08-15 Hans-Peter Nilsson <hp@axis.com>
|
2011-08-15 Hans-Peter Nilsson <hp@axis.com>
|
||||||
|
|
||||||
* gcc.dg/tree-ssa/vrp61.c: Use -fdump-tree-vrp1-nouid instead of
|
* gcc.dg/tree-ssa/vrp61.c: Use -fdump-tree-vrp1-nouid instead of
|
||||||
|
|
|
@ -0,0 +1,53 @@
|
||||||
|
! { dg-do compile }
|
||||||
|
! { dg-options "-fcoarray=single" }
|
||||||
|
!
|
||||||
|
! Coarray declaration constraint checks
|
||||||
|
!
|
||||||
|
|
||||||
|
function foo3a() result(res)
|
||||||
|
implicit none
|
||||||
|
integer :: res
|
||||||
|
codimension :: res[*] ! { dg-error "CODIMENSION attribute conflicts with RESULT" }
|
||||||
|
end
|
||||||
|
|
||||||
|
function foo2a() result(res)
|
||||||
|
integer :: res[*] ! { dg-error "CODIMENSION attribute conflicts with RESULT" }
|
||||||
|
end
|
||||||
|
|
||||||
|
function fooa() result(res) ! { dg-error "shall not be a coarray or have a coarray component" }
|
||||||
|
implicit none
|
||||||
|
type t
|
||||||
|
integer, allocatable :: A[:]
|
||||||
|
end type t
|
||||||
|
type(t):: res
|
||||||
|
end
|
||||||
|
|
||||||
|
function foo3() ! { dg-error "shall not be a coarray or have a coarray component" }
|
||||||
|
implicit none
|
||||||
|
integer :: foo3
|
||||||
|
codimension :: foo3[*]
|
||||||
|
end
|
||||||
|
|
||||||
|
function foo2() ! { dg-error "shall not be a coarray or have a coarray component" }
|
||||||
|
implicit none
|
||||||
|
integer :: foo2[*]
|
||||||
|
end
|
||||||
|
|
||||||
|
function foo() ! { dg-error "shall not be a coarray or have a coarray component" }
|
||||||
|
type t
|
||||||
|
integer, allocatable :: A[:]
|
||||||
|
end type t
|
||||||
|
type(t):: foo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine test()
|
||||||
|
use iso_c_binding
|
||||||
|
implicit none
|
||||||
|
type(c_ptr), save :: caf[*] ! { dg-error "shall not be a coarray" }
|
||||||
|
end subroutine test
|
||||||
|
|
||||||
|
subroutine test2()
|
||||||
|
use iso_c_binding
|
||||||
|
implicit none
|
||||||
|
type(c_funptr), save :: caf[*] ! { dg-error "shall not be a coarray" }
|
||||||
|
end subroutine test2
|
Loading…
Reference in New Issue