From patchwork Sat Jul 19 11:48:56 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 371796 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id E2E2D140085 for ; Sat, 19 Jul 2014 21:49:20 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=Dbep5t68LOgrX8Qx AdV/Jh+n9SThi5eICagtUrEaO9JVaCYUwVPPPv4600Jmna1/+OUuiCVmCiqrvHFL 1Nr5vwHDMo9CeadYnATR5H25P+pk0xNoI2gc0NLk7dD8ZByKCjzh8gNvnhdwfRWg pl0awSruEKR3y931kE8ccWsYkT4= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=pYaSEXj5SQPKCm8gpb7qNh HzArU=; b=PBSVXewcogUMamVnS1ZhTs6M1vGwE4Pz/Hi47jhNVxSLSIm4QPXM4q 9Fzd9MoEKWCPSWXxLjA3X67mFuJqZHNEQ5qWNcxL3QfUv7TaF8Z/XjIjB+rsDeCb 3HEQzO/1tk8mN3ZTbu8XqPrCLmnaJjStuz/hH93T0N113O4Q0WS34= Received: (qmail 20362 invoked by alias); 19 Jul 2014 11:49:07 -0000 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 Received: (qmail 20314 invoked by uid 89); 19 Jul 2014 11:49:04 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.2 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.18) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Sat, 19 Jul 2014 11:49:01 +0000 Received: from vepi2.private ([84.63.33.109]) by mail.gmx.com (mrgmx003) with ESMTPSA (Nemesis) id 0MBnSJ-1XI82I0mcp-00AqVH; Sat, 19 Jul 2014 13:48:57 +0200 Date: Sat, 19 Jul 2014 13:48:56 +0200 From: Andre Vehreschild To: FX Cc: gcc-patches , Fortran List Subject: Re: PR 60414: Patch proposal Message-ID: <20140719134856.2c26b51a@vepi2.private> In-Reply-To: References: MIME-Version: 1.0 Hi FX, thank you for your help: ad 1) I thought the fixes to small for all the trouble to go through with a copyright assignment. But if it is needed, I will happily give copyright to the FSF and negotiate with my client all formal requirements. Unfortunately my English is not well enough to understand the legal English on the site you pointed me to. May I ask you to help me there? Is there a form I have to sign? Where to I get it? What do you need from my client? ad 2) Patch bootstrapped and regtested on x86_64-unknown-linux-gnu on a standard PC running Fedora 19 (64 bit). I have to apologize for the incomplete patch: The testcase unlimited_polymorphism_18.f90 was missing. My fault. Please find the corrected patch attached. Regards, Andre On Sat, 19 Jul 2014 00:12:13 +0200 FX wrote: > Hi Andre, and welcome aboard! > > The explanation you give is nice, your patch submission looks clean. Two > things: > > 1. Do you have a copyright assignment on file with the FSF? See > https://gcc.gnu.org/contribute.html > > 2. Normally, all GCC patch submissions should be accompanied by a statement > saying how you tested the patch. The standard thing to do is to check that > the patched sources still bootstrap and that there is no regression in the > testsuite. This can be stated as “Patch bootstrapped and regtested on here your testing platform triplet, like x86_64-apple-darwin13>”. In that > particular case, it might also be nice to indicate that not only the testcase > doesn’t crash the compiler any more, but to confirm that it now generates the > correct code (i.e. that we don’t turn an ice-on-valid bug into a wrong-code > bug!). > > Cheers, > FX > diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c33936b..cb01a13 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2014-07-19 Andre Vehreschild + + PR fortran/60414 + * interface.c (compare_parameter): Fix compile bug: During resolution + of generic an array reference in the actual argument was not + respected. Fixed by checking, if the ref member is non-null. Testcase + unlimited_polymorphism_18.f90 add. + 2014-06-15 Tobias Burnus * symbol.c (check_conflict): Add codimension conflict with diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index b210d18..8658003 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2156,7 +2156,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1) return 1; + /* Only check ranks compatibility, if actual is not an array reference, + i.e., actual(i) indicated by actual->ref being set. */ if (actual->ts.type == BT_CLASS && CLASS_DATA (actual)->as + && !actual->ref && CLASS_DATA (actual)->as->rank == symbol_rank (formal)) return 1; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3202694..01d770f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-07-19 Andre Vehreschild + + * gfortran.dg/unlimited_polymorphism_18.f90: Check according to + PR 60414 + 2014-07-18 Uros Bizjak PR target/61794 diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90 new file mode 100644 index 0000000..661d0b7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! Tests fix for PR60414 +! +module m + implicit none + Type T + contains + procedure :: FWrite + procedure :: FWriteArr + generic :: Write => FWrite, FWriteArr + end Type + +contains + + subroutine FWrite(this,X) + class(T) this + class(*) X + real :: r + select type(X) + type is (real) + write (*, "(f3.1)", advance='no') X + class default + write (*, *) "???" + end select + end subroutine FWrite + + subroutine FWriteArr(this,X) + class(T) this + class(*) X(:) + integer i + do i = 1,6 + call this%fwrite(X(i)) + write (*, "(a)", advance="no") ", " + end do + end subroutine FWriteARr + + subroutine WriteTextVector(vec, n, scal) + integer, intent(in) :: n + class(*), intent(in) :: vec(n) + class(*), intent(in) :: scal + integer j + Type(T) :: Tester + + ! Write full vector + call Tester%Write(vec) + print *, "" + ! Write a scalar of the same class like the vector + call Tester%Write(scal) + print *, "" + ! Write an element of the vector, which is a scalar + j=3 + call Tester%Write(vec(j)) + + end subroutine WriteTextVector + +end module + +program test + use :: m + implicit none + + real :: vec(1:6) = (/ 0, 1, 2, 3, 4, 5 /) + call writetextvector(vec, 6, 5.0) +end program test +! { dg-final { cleanup-modules "m" } } +