From patchwork Wed Aug 3 22:21:50 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 108328 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id A69F2B71E0 for ; Thu, 4 Aug 2011 08:22:15 +1000 (EST) Received: (qmail 357 invoked by alias); 3 Aug 2011 22:22:11 -0000 Received: (qmail 328 invoked by uid 22791); 3 Aug 2011 22:22:08 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 03 Aug 2011 22:21:52 +0000 Received: from [192.168.178.22] (port-92-204-52-84.dynamic.qsc.de [92.204.52.84]) by mx02.qsc.de (Postfix) with ESMTP id 1CFEC1E363; Thu, 4 Aug 2011 00:21:50 +0200 (CEST) Message-ID: <4E39C9FE.2000405@net-b.de> Date: Thu, 04 Aug 2011 00:21:50 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:6.0) Gecko/20110729 Thunderbird/6.0 MIME-Version: 1.0 To: Mikael Morin CC: gcc patches , gfortran Subject: Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE References: <4E3820E5.5090702@net-b.de> <201108031343.35405.mikael.morin@sfr.fr> <4E396F54.6070809@net-b.de> In-Reply-To: <4E396F54.6070809@net-b.de> Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Tobias Burnus wrote: > Mikael, first, thanks for carefully reading the patch! Updated patch attached. Changes: - parse.c: Cleaned up a bit, use suggested wording, add missing diagnostic (cf. my previous mail) - resolve.c: use suggested wording - coarray_lock_5.f90: Remove. - coarray_lock_6.f90: Move to coarray_lock_5.f90, add additional test case for the newly found issue. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2011-08-04 Tobias Burnus PR fortran/18918 * parse.c (parse_derived): Add lock_type checks, improve coarray_comp handling. * resolve.c (resolve_allocate_expr, resolve_lock_unlock, resolve_symbol): Fix lock_type constraint checks. 2011-08-04 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray_lock_1.f90: Update dg-error. * gfortran.dg/coarray_lock_3.f90: Fix test. * gfortran.dg/coarray_lock_4.f90: New. * gfortran.dg/coarray_lock_5.f90: New. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 2910ab5..9f732e5 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2018,7 +2018,7 @@ parse_derived (void) gfc_statement st; gfc_state_data s; gfc_symbol *sym; - gfc_component *c; + gfc_component *c, *lock_comp = NULL; accept_statement (ST_DERIVED_DECL); push_state (&s, COMP_DERIVED, gfc_new_block); @@ -2126,19 +2126,28 @@ endType: sym = gfc_current_block (); for (c = sym->components; c; c = c->next) { + bool coarray, lock_type, allocatable, pointer; + coarray = lock_type = allocatable = pointer = false; + /* Look for allocatable components. */ if (c->attr.allocatable || (c->ts.type == BT_CLASS && c->attr.class_ok && CLASS_DATA (c)->attr.allocatable) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) - sym->attr.alloc_comp = 1; + { + allocatable = true; + sym->attr.alloc_comp = 1; + } /* Look for pointer components. */ if (c->attr.pointer || (c->ts.type == BT_CLASS && c->attr.class_ok && CLASS_DATA (c)->attr.class_pointer) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) - sym->attr.pointer_comp = 1; + { + pointer = true; + sym->attr.pointer_comp = 1; + } /* Look for procedure pointer components. */ if (c->attr.proc_pointer @@ -2148,15 +2157,61 @@ endType: /* Looking for coarray components. */ if (c->attr.codimension - || (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable)) - sym->attr.coarray_comp = 1; + || (c->ts.type == BT_CLASS && c->attr.class_ok + && CLASS_DATA (c)->attr.codimension)) + { + coarray = true; + sym->attr.coarray_comp = 1; + } + + if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.codimension) + { + coarray = true; + if (!pointer && !allocatable) + sym->attr.coarray_comp = 1; + } /* Looking for lock_type components. */ - if (c->attr.lock_comp - || (sym->ts.type == BT_DERIVED + if ((c->ts.type == BT_DERIVED && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV - && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)) - sym->attr.lock_comp = 1; + && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE) + || (c->ts.type == BT_CLASS && c->attr.class_ok + && CLASS_DATA (c)->ts.u.derived->from_intmod + == INTMOD_ISO_FORTRAN_ENV + && CLASS_DATA (c)->ts.u.derived->intmod_sym_id + == ISOFORTRAN_LOCK_TYPE) + || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp + && !allocatable && !pointer)) + { + lock_type = 1; + lock_comp = c; + sym->attr.lock_comp = 1; + } + + /* F2008, C1302. */ + + if (pointer && !coarray && (lock_type + || (c->ts.type == BT_DERIVED + && c->ts.u.derived->attr.lock_comp))) + gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent " + "of type LOCK_TYPE is a pointer but not a coarray", + c->name, &c->loc); + + if (lock_type && allocatable && !coarray) + gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent " + "of type LOCK_TYPE is allocatable but not a " + "coarray", c->name, &c->loc); + + if (sym->attr.coarray_comp && !coarray && lock_type) + gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent " + "of type LOCK_TYPE is not a coarray, but other coarray " + "components exist", c->name, &c->loc); + + if (sym->attr.lock_comp && coarray && !lock_type) + gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent " + "of type LOCK_TYPE has to be a coarray as %s at %L has a " + "codimension", lock_comp->name, &lock_comp->loc, c->name, + &c->loc); /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b8a8ebb..f801750 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) /* Check F2008, C642. */ if (code->expr3->ts.type == BT_DERIVED - && ((codimension && gfc_expr_attr (code->expr3).lock_comp) + && ((codimension && gfc_expr_attr (code->expr3).lock_comp) || (code->expr3->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV && code->expr3->ts.u.derived->intmod_sym_id @@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code) || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE || code->expr1->rank != 0 - || !(gfc_expr_attr (code->expr1).codimension - || gfc_is_coindexed (code->expr1))) - gfc_error ("Lock variable at %L must be a scalar coarray of type " - "LOCK_TYPE", &code->expr1->where); + || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1))) + gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE", + &code->expr1->where); /* Check STAT. */ if (code->expr2 @@ -12405,12 +12404,14 @@ resolve_symbol (gfc_symbol *sym) /* F2008, C1302. */ if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV - && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE - && !sym->attr.codimension) + && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV + && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE) + || sym->ts.u.derived->attr.lock_comp) + && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp) { - gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray", - sym->name, &sym->declared_at); + gfc_error ("Variable %s at %L of type LOCK_TYPE or with subcomponent of " + "type LOCK_TYPE must be a coarray", sym->name, + &sym->declared_at); return; } diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 index f9ef581..419ba47 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 @@ -10,6 +10,6 @@ integer :: s character(len=3) :: c logical :: bool -LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" } -UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" } +LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" } +UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" } end diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 index b23d87e..60db32b 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 @@ -19,11 +19,21 @@ module m type t type(lock_type), allocatable :: x(:)[:] end type t +end module m +module m2 + use iso_fortran_env type t2 - type(lock_type), allocatable :: x + type(lock_type), allocatable :: x ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE is allocatable but not a coarray" } end type t2 -end module m +end module m2 + +module m3 + use iso_fortran_env + type t3 + type(lock_type) :: x ! OK + end type t3 +end module m3 subroutine sub(x) use iso_fortran_env @@ -46,15 +56,15 @@ subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, n end subroutine sub3 subroutine sub4(x) - use m - type(t2), intent(inout) :: x[*] ! OK + use m3 + type(t3), intent(inout) :: x[*] ! OK end subroutine sub4 subroutine lock_test use iso_fortran_env type t end type t - type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" } + type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" } end subroutine lock_test subroutine lock_test2 @@ -65,10 +75,10 @@ subroutine lock_test2 type(t) :: x type(lock_type), save :: lock[*],lock2(2)[*] lock(t) ! { dg-error "Syntax error in LOCK statement" } - lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" } + lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" } lock(lock) lock(lock2(1)) - lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" } + lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" } lock(lock[1]) ! OK end subroutine lock_test2 @@ -104,4 +114,4 @@ contains end subroutine test end subroutine argument_check -! { dg-final { cleanup-modules "m" } } +! { dg-final { cleanup-modules "m m2 m3" } } --- /dev/null 2011-08-03 07:40:52.435887713 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_4.f90 2011-08-03 23:24:30.000000000 +0200 @@ -0,0 +1,64 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! +! LOCK/LOCK_TYPE checks +! + +subroutine valid() + use iso_fortran_env + implicit none + type t + type(lock_type) :: lock + end type t + + type t2 + type(lock_type), allocatable :: lock(:)[:] + end type t2 + + type(t), save :: a[*] + type(t2), save :: b ! OK + + allocate(b%lock(1)[*]) + LOCK(a%lock) ! OK + LOCK(a[1]%lock) ! OK + + LOCK(b%lock(1)) ! OK + LOCK(b%lock(1)[1]) ! OK +end subroutine valid + +subroutine invalid() + use iso_fortran_env + implicit none + type t + type(lock_type) :: lock + end type t + type(t), save :: a ! { dg-error "type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" } +end subroutine invalid + +subroutine more_tests + use iso_fortran_env + implicit none + type t + type(lock_type) :: a ! OK + end type t + + type t1 + type(lock_type), allocatable :: c2(:)[:] ! OK + end type t1 + type(t1) :: x1 ! OK + + type t2 + type(lock_type), allocatable :: c1(:) ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE is allocatable but not a coarray" } + end type t2 + + type t3 + type(t) :: b + end type t3 + type(t3) :: x3 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" } + + type t4 + type(lock_type) :: c0(2) + end type t4 + type(t4) :: x4 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" } +end subroutine more_tests --- /dev/null 2011-08-03 07:40:52.435887713 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90 2011-08-03 23:21:59.000000000 +0200 @@ -0,0 +1,31 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! LOCK_TYPE checks +! +module m3 + use iso_fortran_env + type, extends(lock_type) :: lock + integer :: j = 7 + end type lock +end module m3 + +use m3 +type(lock_type) :: tl[*] = lock_type () +type(lock) :: t[*] +tl = lock_type () ! { dg-error "variable definition context" } +print *,t%j +end + +subroutine test() + use iso_fortran_env + type t + type(lock_type) :: lock + end type t + + type t2 + type(t), pointer :: x ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE" } + end type t2 +end subroutine test + +! { dg-final { cleanup-modules "m3" } }