From patchwork Thu Jun 10 17:52:52 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [fortran] PR44457 - add check for asynchronous dummys
Date: Thu, 10 Jun 2010 07:52:52 -0000
From: Daniel Franke <franke.daniel@gmail.com>
X-Patchwork-Id: 55241
Message-Id: <201006101952.52197.franke.daniel@gmail.com>
To: fortran@gcc.gnu.org
Cc: gcc-patches@gcc.gnu.org

Patch says it all.


gcc/fortran/:
2010-06-10  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/44457
	* interface.c (compare_actual_formal): Reject actual arguments with
	array subscript passed to ASYNCHRONOUS dummys.

gcc/testsuite/:
2010-06-10  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/44457
	* gfortran.dg/asynchronous_3.f03


Regression tested on i686-pc-linux-gnu.
Ok for trunk?

	Daniel
! { dg-do "compile" }
!
! PR fortran/44457 - no array-subscript actual argument
!                    for an asynchronous dummy
!

  integer :: a(10), sect(3)
  sect = [1,2,3]
  call f(a(sect))    ! { dg-error "incompatible" }
  call f(a(::2))
contains
  subroutine f(x)
    integer, asynchronous :: x(:)
  end subroutine f
end


Index: interface.c
===================================================================
--- interface.c	(revision 160504)
+++ interface.c	(working copy)
@@ -2133,13 +2133,15 @@ compare_actual_formal (gfc_actual_arglis
 
       if ((f->sym->attr.intent == INTENT_OUT
 	   || f->sym->attr.intent == INTENT_INOUT
-	   || f->sym->attr.volatile_)
+	   || f->sym->attr.volatile_
+	   || f->sym->attr.asynchronous)
           && has_vector_subscript (a->expr))
 	{
 	  if (where)
-	    gfc_error ("Array-section actual argument with vector subscripts "
-		       "at %L is incompatible with INTENT(OUT), INTENT(INOUT) "
-		       "or VOLATILE attribute of the dummy argument '%s'",
+	    gfc_error ("Array-section actual argument with vector "
+		       "subscripts at %L is incompatible with INTENT(OUT), "
+		       "INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
+		       "of the dummy argument '%s'",
 		       &a->expr->where, f->sym->name);
 	  return 0;
 	}