Patchwork [fortran] PR44457 - add check for asynchronous dummys

login
register
mail settings
Submitter Daniel Franke
Date June 10, 2010, 5:52 p.m.
Message ID <201006101952.52197.franke.daniel@gmail.com>
Download mbox | patch
Permalink /patch/55241/
State New
Headers show

Comments

Daniel Franke - June 10, 2010, 5:52 p.m.
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
Steve Kargl - June 10, 2010, 6:04 p.m.
On Thu, Jun 10, 2010 at 07:52:52PM +0200, Daniel Franke wrote:
> 
> 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?
> 

OK.

Patch

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;
 	}