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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 75b0cde58f007ee6834258efec61a40534670c38..8112ecc70ce5d287baa6d6552d233ee169f3f653 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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>
 
        * module.c (use_iso_fortran_env_module):  Spell 'referrenced' correctly.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6245666f620df64e3b999bfa5f295121b0e329a7..a9bfbcf6f9c262ec84ee7912a1e4d5a2ceae6c6d 100644 (file)
--- 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 921b196884fedf805c658cde04dc0091ae061dad..ed36c9f284df705653f22df9b67197c46f96f680 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 
        * 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 (file)
index 0000000..06ff4cf
--- /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