From e535f1b22917730c13fc85f91360288d456f054f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 15 Aug 2011 22:10:51 +0200 Subject: [PATCH] resolve.c (resolve_symbol): Fix coarray result-var check. 2011-08-15 Tobias Burnus * resolve.c (resolve_symbol): Fix coarray result-var check. 2011-08-15 Tobias Burnus * gfortran.dg/coarray_26.f90: New. From-SVN: r177767 --- gcc/fortran/ChangeLog | 4 ++ gcc/fortran/resolve.c | 74 ++++++++++++++++-------- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gfortran.dg/coarray_26.f90 | 53 +++++++++++++++++ 4 files changed, 111 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_26.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 75b0cde58f0..8112ecc70ce 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-08-15 Tobias Burnus + + * resolve.c (resolve_symbol): Fix coarray result-var check. + 2011-08-14 Steven G. Kargl * module.c (use_iso_fortran_env_module): Spell 'referrenced' correctly. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6245666f620..a9bfbcf6f9c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12246,29 +12246,41 @@ resolve_symbol (gfc_symbol *sym) /* F2008, C542. */ if (sym->ts.type == BT_DERIVED && sym->attr.dummy && sym->attr.intent == INTENT_OUT && sym->attr.lock_comp) - gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be " - "INTENT(OUT)", sym->name, &sym->declared_at); + { + gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be " + "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) || sym->attr.codimension) - && sym->attr.result) - gfc_error ("Function result '%s' at %L shall not be a coarray or have " - "a coarray component", sym->name, &sym->declared_at); + && (sym->attr.result || sym->result == sym)) + { + gfc_error ("Function result '%s' at %L shallolvnot be a coarray or have " + "a coarray component", sym->name, &sym->declared_at); + return; + } /* F2008, C524. */ if (sym->attr.codimension && sym->ts.type == BT_DERIVED && sym->ts.u.derived->ts.is_iso_c) - gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) " - "shall not be a coarray", sym->name, &sym->declared_at); + { + gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) " + "shall not be a coarray", sym->name, &sym->declared_at); + return; + } /* F2008, C525. */ if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp && (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension || sym->attr.allocatable)) - gfc_error ("Variable '%s' at %L with coarray component " - "shall be a nonpointer, nonallocatable scalar", - sym->name, &sym->declared_at); + { + gfc_error ("Variable '%s' at %L with coarray component " + "shall be a nonpointer, nonallocatable scalar", + sym->name, &sym->declared_at); + return; + } /* F2008, C526. The function-result case was handled above. */ 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.is_main_program || sym->attr.function || sym->attr.result || sym->attr.use_assoc)) - gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE " - "nor a dummy argument", sym->name, &sym->declared_at); + { + gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE " + "nor a dummy argument", sym->name, &sym->declared_at); + return; + } /* F2008, C528. */ /* FIXME: sym->as check due to PR 43412. */ else if (sym->attr.codimension && !sym->attr.allocatable && sym->as && sym->as->cotype == AS_DEFERRED) - gfc_error ("Coarray variable '%s' at %L shall not have codimensions with " - "deferred shape", sym->name, &sym->declared_at); + { + gfc_error ("Coarray variable '%s' at %L shall not have codimensions with " + "deferred shape", sym->name, &sym->declared_at); + return; + } else if (sym->attr.codimension && sym->attr.allocatable && (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED)) - gfc_error ("Allocatable coarray variable '%s' at %L must have " - "deferred shape", sym->name, &sym->declared_at); - + { + gfc_error ("Allocatable coarray variable '%s' at %L must have " + "deferred shape", sym->name, &sym->declared_at); + return; + } /* F2008, C541. */ if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp) || (sym->attr.codimension && sym->attr.allocatable)) && sym->attr.dummy && sym->attr.intent == INTENT_OUT) - gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an " - "allocatable coarray or have coarray components", - sym->name, &sym->declared_at); + { + gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an " + "allocatable coarray or have coarray components", + sym->name, &sym->declared_at); + return; + } if (sym->attr.codimension && sym->attr.dummy && 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) " - "procedure '%s'", sym->name, &sym->declared_at, - sym->ns->proc_name->name); + { + gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) " + "procedure '%s'", sym->name, &sym->declared_at, + sym->ns->proc_name->name); + return; + } switch (sym->attr.flavor) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 921b196884f..ed36c9f284d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2011-08-15 Tobias Burnus + + * gfortran.dg/coarray_26.f90: New. + 2011-08-15 Hans-Peter Nilsson * gcc.dg/tree-ssa/vrp61.c: Use -fdump-tree-vrp1-nouid instead of diff --git a/gcc/testsuite/gfortran.dg/coarray_26.f90 b/gcc/testsuite/gfortran.dg/coarray_26.f90 new file mode 100644 index 00000000000..06ff4cf79f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_26.f90 @@ -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