From patchwork Wed Jun 5 12:49:10 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 249025 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 9FB192C0095 for ; Wed, 5 Jun 2013 22:49:26 +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 :message-id:date:from:mime-version:to:subject:references :in-reply-to:content-type; q=dns; s=default; b=rCPhGnKc7I/G/c/gz KNYnYWrwP4oV4Xo0yugGhejmiCCa2SecjR3jbuRk536vBT7GLp2eu4mVVnSId19A miRilWVMZhjvmyr6v37xGEvdX6gsXWYNjaMTMloVhNgf1gCKO5o5WMnEh8xsqNH7 SnuXpl1qM6UNrLf0OrrgKst9KU= 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 :message-id:date:from:mime-version:to:subject:references :in-reply-to:content-type; s=default; bh=FlpxCtRjRhyMi+YFm+ouRqS 4dbk=; b=ym5GdU+XKpHPGSfvkhdPXf5mvUqozW2Nyh4an6jX+Mff75qIMCr1gu9 DHTtAls4G2TOdkXvCsaFA6WiVbHBK2PIZYml3BooYln8X+/tFyD9+4vc3Dvrn8bj yUBd/raMF7tmWVp+dNt8PSmDm8ujuT9ONZNwCXXnNPY/cvtwrARI= Received: (qmail 16017 invoked by alias); 5 Jun 2013 12:49:14 -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 15996 invoked by uid 89); 5 Jun 2013 12:49:14 -0000 X-Spam-SWARE-Status: No, score=-2.9 required=5.0 tests=AWL, BAYES_00, KHOP_THREADED, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Wed, 05 Jun 2013 12:49:13 +0000 Received: from archimedes.net-b.de (port-92-195-31-211.dynamic.qsc.de [92.195.31.211]) by mx01.qsc.de (Postfix) with ESMTP id B4BD93CB97; Wed, 5 Jun 2013 14:49:10 +0200 (CEST) Message-ID: <51AF33C6.3080209@net-b.de> Date: Wed, 05 Jun 2013 14:49:10 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gfortran , gcc patches Subject: Re: [Patch, Fortran] PR57530 - fix rejects valid with gfc_type_compatible References: <51AF2896.1030800@net-b.de> <51AF3351.2080907@net-b.de> In-Reply-To: <51AF3351.2080907@net-b.de> X-Virus-Found: No Now with attached patch. Tobias Burnus wrote: > I accidentally attached a slightly out-dated patch. The old patch > permitted CLASS<->TYPE differences in cases where the characteristic > had to match (e.g. dummy arguments in a proc-pointer assignment). - > Sorry for the confusion. > > Build and regtested on x86-64-gnu-linux. > OK for the trunk? > > Tobias > > Tobias Burnus wrote: >> A TYPE is type compatible with a CLASS if both have the same declared >> type. >> >> Or in words of the standard (cf. PR): >> "A nonpolymorphic entity is type compatible only with entities of the >> same declared type. A polymorphic entity that is not an unlimited >> polymorphic entity is type compatible with entities of the same >> declared type or any of its extensions." (F2008, 4.3.1.3). >> >> Build and regtested on x86-64-gnu-linux. >> OK for the trunk? > > 2013-06-05 Tobias Burnus PR fortran/57530 * symbol.c (gfc_type_compatible): A type is type compatible with a class if both have the same declared type. * interface.c (compare_type): Reject CLASS/TYPE even if they are type compatible. 2013-06-05 Tobias Burnus PR fortran/57530 * gfortran.dg/pointer_assign_8.f90: New. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f06ecfe..17a47a2 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -514,6 +514,12 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2) if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) return 1; + /* TYPE and CLASS of the same declared type are type compatible, + but have different characteristics. */ + if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED) + || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS)) + return 0; + return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index c72974d..9d23e8b 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4489,6 +4489,9 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_derived1 && is_derived2) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived); + if (is_derived1 && is_class2) + return gfc_compare_derived_types (ts1->u.derived, + ts2->u.derived->components->ts.u.derived); if (is_class1 && is_derived2) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived); --- /dev/null 2013-06-05 09:13:09.179105369 +0200 +++ gcc/gcc/testsuite/gfortran.dg/pointer_assign_8.f90 2013-06-05 13:55:12.580621132 +0200 @@ -0,0 +1,14 @@ +! { dg-do compile } +! +! PR fortran/57530 +! +module m + type t + end type t +contains + subroutine sub (tgt) + class(t), target :: tgt + type(t), pointer :: ptr + ptr => tgt ! TYPE => CLASS of same declared type + end subroutine sub +end module m