From patchwork Tue Jun 23 21:41:32 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1315601 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 49s09J5G5Vz9sQx for ; Wed, 24 Jun 2020 07:41:55 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id ED5883973122; Tue, 23 Jun 2020 21:41:53 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 6AAB7394442B; Tue, 23 Jun 2020 21:41:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 6AAB7394442B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: yAEaw+i8HjF4U0MIX+9TUqKCI0+3VZlKZSRM7GaLNDnCUoebon2cJR02CMVbA7EIqbfVnl2LJo dVqLOw3505kj2ws7W1boTBxJlzvIg9qIknqBBUMVw2nANOvaw4HaDTSDIY3GXHkeAA1rpFyNCU cCd8ufCHtC54tuKLqlKC6EMq2ZsPGUDQNGBj5gV4rrKAoJ/VsZ9D5rzljgChROaZr91RVgE4a8 yT4OYIze7mk8U81/QaxsmJTdOE2yKzxKQNeK4p6I5ayNX4kaTxpwbDrBeIqrZynC4ZPz97jmVS 6Jg= X-IronPort-AV: E=Sophos;i="5.75,272,1589270400"; d="diff'?scan'208";a="50127254" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 23 Jun 2020 13:41:49 -0800 IronPort-SDR: hBTRhVEnRbeaLqb3n17E1a1ZXOF9pY0nLKx1o8BqNILWvORvfOTMYiXFlpUVpf8X64zDA4+Krq A8bBMgWuWexOedpiqDxY57MXI0NXVEk6TcpDVe8gDWbBIyqpRrbTWsADBxIfi0XRNSfXpnHCRS eOVK/D0ZaBE1JcAihrobU7x3HLuKPn6+zL2IVfX1XaK3dDhyRu6SOC6j7YPa52/PLBy2YAqxam cUQ8//fxsxEAQrws5o/Ueymp8tf50jdM1TY5XUqMDkR9E7URWt/aSq1WskNV5ruQQMEpSnVPqf r14= To: gcc-patches , fortran From: Tobias Burnus Subject: Fortran: Fix character-kind=4 substring resolution (PR95837) Message-ID: <40382b56-b0e7-a0e6-8911-081a38f58a7a@codesourcery.com> Date: Tue, 23 Jun 2020 23:41:32 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.9.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-04.mgc.mentorg.com (139.181.222.4) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-14.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Found when looking at another issue … OK for the trunk? Tobias PS: Without the patch, it fails to compile with: Error: Character ‘\U0001F600’ in string at (1) cannot be converted into character kind 1 Error: Operands of comparison operator ‘/=’ at (1) are CHARACTER(3)/CHARACTER(3,4) ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter Fortran: Fix character-kind=4 substring resolution (PR95837) gcc/fortran/ChangeLog: PR fortran/95837 * resolve.c (gfc_resolve_substring_charlen): Fix char-kind setting. gcc/testsuite/ChangeLog: PR fortran/95837 * gfortran.dg/char4-subscript.f90: New test. gcc/fortran/resolve.c | 7 ++++++- gcc/testsuite/gfortran.dg/char4-subscript.f90 | 30 +++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c53b312f7ed..6d844dd2310 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5141,7 +5141,12 @@ gfc_resolve_substring_charlen (gfc_expr *e) } e->ts.type = BT_CHARACTER; - e->ts.kind = gfc_default_character_kind; + if (ts) + e->kind = ts->kind; + else if (e->symtree->n.sym->ts.type == BT_CHARACTER) + e->kind = ts->kind; + else + e->kind = gfc_default_character_kind; if (!e->ts.u.cl) e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); diff --git a/gcc/testsuite/gfortran.dg/char4-subscript.f90 b/gcc/testsuite/gfortran.dg/char4-subscript.f90 new file mode 100644 index 00000000000..f1f915c7af9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char4-subscript.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! { dg-additional-options "-fdump-tree-original" } +! +! PR fortran/95837 +! +type t + character(len=:, kind=4), pointer :: str2 +end type t +type(t) :: var + +allocate(character(len=5, kind=4) :: var%str2) + +var%str2(1:1) = 4_"d" +var%str2(2:3) = 4_"ef" +var%str2(4:4) = achar(int(Z'1F600'), kind=4) +var%str2(5:5) = achar(int(Z'1F608'), kind=4) + +if (var%str2(1:3) /= 4_"def") stop 1 +if (ichar(var%str2(4:4)) /= int(Z'1F600')) stop 2 +if (ichar(var%str2(5:5)) /= int(Z'1F608')) stop 2 + +deallocate(var%str2) +end + +! Note: the last '\x00' is regarded as string terminator, hence, the tailing \0 byte is not in the dump + +! { dg-final { scan-tree-dump " \\(\\*var\\.str2\\)\\\[1\\\]{lb: 1 sz: 4} = .d\\\\x00\\\\x00.\\\[1\\\]{lb: 1 sz: 4};" "original" } } +! { dg-final { scan-tree-dump " __builtin_memmove \\(\\(void \\*\\) &\\(\\*var.str2\\)\\\[2\\\]{lb: 1 sz: 4}, \\(void \\*\\) &.e\\\\x00\\\\x00\\\\x00f\\\\x00\\\\x00.\\\[1\\\]{lb: 1 sz: 4}, 8\\);" "original" } } +! { dg-final { scan-tree-dump " \\(\\*var.str2\\)\\\[4\\\]{lb: 1 sz: 4} = .\\\\x00\\\\xf6\\\\x01.\\\[1\\\]{lb: 1 sz: 4};" "original" } } +! { dg-final { scan-tree-dump " \\(\\*var.str2\\)\\\[5\\\]{lb: 1 sz: 4} = .\\\\b\\\\xf6\\\\x01.\\\[1\\\]{lb: 1 sz: 4};" "original" } }