From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 120930 invoked by alias); 13 Mar 2015 10:33:48 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 120854 invoked by uid 89); 13 Mar 2015 10:33:47 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 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.19) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 13 Mar 2015 10:33:45 +0000 Received: from vepi2 ([88.75.104.20]) by mail.gmx.com (mrgmx003) with ESMTPSA (Nemesis) id 0MFMEG-1Ykc0F48we-00ELcD; Fri, 13 Mar 2015 11:33:40 +0100 Date: Fri, 13 Mar 2015 10:33:00 -0000 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Patch, Fortran] Prevent segfault with dump-*-original for implicit class expressions. Message-ID: <20150313113339.32440f8c@vepi2> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/Lsl+NM/GZQqTIS9pQmPBf1l" X-UI-Out-Filterresults: notjunk:1; X-SW-Source: 2015-03/txt/msg00729.txt.bz2 --MP_/Lsl+NM/GZQqTIS9pQmPBf1l Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 1044 Hi all, this is another patch preventing a segfault. This time the segfault occurred, when -fdump-(fortran|tree)-original was given with the program having an implicit class set. The issue is that the _data component is assumed to be present in a BT_CLASS w/o checking and trying to access the unlimited polymorphic flag there. The patch fixes this by redirecting the access to the flag to the correct position whether the _data component is present or not. Building a testcase for this is difficult for me. May be I am just blocked in the head there. The issue occurred when trying to dump the (fortran|tree)-original of the testcase gfortran.dg/implicit_class_1.f90. So one could argue to add the flag to that testcase, but does it pay in contrast to the additional effort each time the testsuite is executed? I have added the test now, not being happy with it, but having no clue how to do it better. Bootstraps and regtests ok on x86_64-linux-gnu/F20. Ok, for trunk? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/Lsl+NM/GZQqTIS9pQmPBf1l Content-Type: application/octet-stream; name=crashfix2_v1.clog Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename=crashfix2_v1.clog Content-length: 655 Z2NjL2ZvcnRyYW4vQ2hhbmdlTG9nOgoKMjAxNS0wMy0xMyAgQW5kcmUgVmVo cmVzY2hpbGQgIDx2ZWhyZUBnbXguZGU+CgoJKiBpbnRlcmZhY2UuYyAoZ2Zj X2NvbXBhcmVfdHlwZXMpOiBDaGVjayBmb3IgdW5saW1pdGVkCglwb2x5bW9y cGhpc20gZmxhZyBpbiB0aGUgY29ycmVjdCBwb3NpdGlvbiBpbmRlcGVudCBv ZiB0aGUgX2RhdGEKCWNvbXBvbmVudCBiZWluZyBwcmVzZW50IG9yIG5vdC4g IFRoaXMgcHJldmVudHMgYSBzZWdmYXVsdCwgd2hlbgoJdGhlIF9kYXRhIGNv bXBvbmVudCBpcyBub3QgcHJlc2VudC4KCSogc3ltYm9sLmMgKGdmY190eXBl X2NvbXBhdGlibGUpOiBTYW1lLgoKZ2NjL3Rlc3RzdWl0ZS9DaGFuZ2VMb2c6 CgoyMDE1LTAzLTEzICB2ZWhyZSAgPHZlaHJlQGdteC5kZT4KCgkqIGdmb3J0 cmFuLmRnL2ltcGxpY2l0X2NsYXNzXzEuZjkwOiBBZGRpbmcgZmxhZyB0byBj aGVjaywgaWYKCXNlZ2ZhdWx0IGlzIGZpeGVkLgoKCg== --MP_/Lsl+NM/GZQqTIS9pQmPBf1l Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=crashfix2_v1.patch Content-length: 3671 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 320eb01..71721dd 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -484,13 +484,24 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) if (ts1->type == BT_VOID || ts2->type == BT_VOID) return 1; - if (ts1->type == BT_CLASS - && ts1->u.derived->components->ts.u.derived->attr.unlimited_polymorphic) + /* The _data component is not always present, therefore check for its + presence before assuming, that its derived->attr is available. + When the _data component is not present, then nevertheless the + unlimited_polymorphic flag may be set in the derived type's attr. */ + if (ts1->type == BT_CLASS && ts1->u.derived->components + && ((strcmp (ts1->u.derived->components->name, "_data") == 0 + && ts1->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts1->u.derived->attr.unlimited_polymorphic)) return 1; /* F2003: C717 */ if (ts2->type == BT_CLASS && ts1->type == BT_DERIVED - && ts2->u.derived->components->ts.u.derived->attr.unlimited_polymorphic + && ts2->u.derived->components + && ((strcmp (ts2->u.derived->components->name, "_data") == 0 + && ts2->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts2->u.derived->attr.unlimited_polymorphic) && (ts1->u.derived->attr.sequence || ts1->u.derived->attr.is_bind_c)) return 1; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 32eea21..3379f47 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4567,7 +4567,10 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_class1 && ts1->u.derived->components - && ts1->u.derived->components->ts.u.derived->attr.unlimited_polymorphic) + && ((strcmp (ts1->u.derived->components->name, "_data") == 0 + && ts1->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts1->u.derived->attr.unlimited_polymorphic)) return 1; if (!is_derived1 && !is_derived2 && !is_class1 && !is_class2) @@ -4576,13 +4579,14 @@ 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) + if (is_derived1 && is_class2 && ts2->u.derived->components) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived->components->ts.u.derived); - if (is_class1 && is_derived2) + if (is_class1 && is_derived2 && ts1->u.derived->components) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived); - else if (is_class1 && is_class2) + else if (is_class1 && is_class2 && ts1->u.derived->components + && ts2->u.derived->components) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived->components->ts.u.derived); else diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 index 329f57a..fff1f2b 100644 --- a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 +++ b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 @@ -4,6 +4,10 @@ ! ! Contributed by Reinhold Bader +! Add dump-tree-original to check, if the patch preventing a gfortran +! segfault is working correctly. +! { dg-options "-fdump-tree-original" } + program upimp implicit class(foo) (a-b) implicit class(*) (c) @@ -33,3 +37,5 @@ contains implicit class(*) (a-z) end end program + +! { dg-final { cleanup-tree-dump "original" } } --MP_/Lsl+NM/GZQqTIS9pQmPBf1l--