From patchwork Sun Mar 27 19:44:50 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1609915 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=og3idzDx; dkim-atps=neutral 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+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) 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 bilbo.ozlabs.org (Postfix) with ESMTPS id 4KRRBl2FXdz9sCq for ; Mon, 28 Mar 2022 06:45:33 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BC882385781D for ; Sun, 27 Mar 2022 19:45:29 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BC882385781D DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1648410329; bh=jzMcJPxnkI5cBNA9+QShpDun85rPMkuNN4cFqNVomXs=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=og3idzDxAyzaxp71qjR6YVxjZQ4DRIyA3yiOXvjgZW5uW5Di0qC8rdov7juPMT1L7 KP+VgB0Sg3MBYvqCV4YqHhiN5F6Gh/L58cseAOROfNaT0ODZVVI1dUVpf2dg+mKvt4 I+m5228uJ6aoeO3kIiTwfpEi0b+Ci7OzChzXHAqA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id 755503858C52; Sun, 27 Mar 2022 19:44:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 755503858C52 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.93.47] ([93.207.93.47]) by web-mail.gmx.net (3c-app-gmx-bap05.server.lan [172.19.172.75]) (via HTTP); Sun, 27 Mar 2022 21:44:50 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] PR fortran/50549 - should detect different type parameters in structure constructors Date: Sun, 27 Mar 2022 21:44:50 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:MMpuG6EqqL8QUFsZipWgqg1ygW9Xkx9R19d+REVeG5Yv3+Aw/hEtyY2UA+6HjeTxK56xo kTtusAE0YyBqmPtRnSYAc2k6tzcP2HhcXbecKsL3uNnnnbEUB8avJOidi5hw0Qtt1DYrGwRMOzd8 mQJty9nBsitfpXk1dmRN27OL9p4kkLo/96BuHRyDbhT4XEx43ig2Gc3x1yJ28d6cuvU9OShWCUly viu0Bz60X/8Kzq7+gNcD5v/PMN2YZPCyN9HXV4NlpNf/zvNrULFdCuWZp6m+Bx6bdTB7L9joUcxk Pg= X-UI-Out-Filterresults: notjunk:1;V03:K0:XZkzEWbG0+Q=:W3d954YhMX6yDjN+i3VknE OP6eqg/+SwTAcPCcgoUmDp+bsivxlNsEPyeckPEa3gUkHJX/05dSg1yMqIg9/MRCS33pydb5/ p2kLu6tmY9jR+PJr2q46uLzADr/ZNngWsP+yOmdkse17QbKtdLG2rgHS7xqt/bOdWpnk/7qqw NM3gU1X2cgtFQzBS31lBwSJFnhEnUX4uSbKiNXGMM5Uff+VDGrGsgw/Gnu90FTW9Rdeu0ppJm MA6ck21GfJ5i/i61scUgBnA7mvcJkRpNOg/ZV92XAZopJ0+jilPhYxvGE0/hpGAT7ERu8fVzF OGagf0t193WIyU8jJZ+1pM3rXRHUnbYOPaZ/eHebpzfHHsnN4a6mrrT8rSI2k/GdnMQY7jkiw WyOTC6rEllKffQSF3ss78ukKqSnhf5+wtU6h91OdSsrQ16P5WQmnnNd4cqaC1DcBTKVqjYpht MDTQxJTa9zyAacMX5Rkj67bAsS9ARbzb9OYetx4uWYsg1Qc4FClQlKaEz1uxOkmkO7UB/gOki GR1zXsrW0S20vz+Zn1w853A1cv20f0hnSmqvr49+gpbPAxIbDlLbj3k0zEz4hE73RR6t7LkoM bcwuoK3bHRdks53lC22HgtFLyMZswrxGnBldRoSdPUN9D/QzpyvlxSfQmTgApxO4E4o/lyB81 1HMLXRgfgeRVcCu/Lgb9eZTYcucQOxOUwJvaUgK5G2J0l1/RxwH3oGOCYmsub4jeX2NtOBz01 10ZZzwiG5amtQ9ZQWOmXoB8mIqv755oVX1VnBbVgtNznxRqvV+old+GOyxVOUxeov5szRKc81 W5hGZUH X-Spam-Status: No, score=-10.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" Dear all, when assigning character pointers, we have a check for same length, which however does not trigger for character pointers within a structure constructor. The attached patch extends the character checks slightly to fix this loophole. I've verified that NAG and Crayftn behave similarly, while Intel does not detect the length difference. Regtested on x86_64-pc-linux-gnu. OK for mainline? Would it be still ok for 12, or rather wait until branching for 13? Thanks, Harald From 3b88c941619bc4996ef7d4ba247086f04deb8683 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 27 Mar 2022 21:35:15 +0200 Subject: [PATCH] Fortran: character length of pointer assignments in structure constructors gcc/fortran/ChangeLog: PR fortran/50549 * resolve.cc (resolve_structure_cons): Reject pointer assignments of character with different lengths in structure constructor. gcc/testsuite/ChangeLog: PR fortran/50549 * gfortran.dg/char_pointer_assign_7.f90: New test. --- gcc/fortran/resolve.cc | 13 ++++++- .../gfortran.dg/char_pointer_assign_7.f90 | 38 +++++++++++++++++++ 2 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 5522be75199..b4400a7ab8d 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init) && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT - && cons->expr->rank != 0 && mpz_cmp (cons->expr->ts.u.cl->length->value.integer, comp->ts.u.cl->length->value.integer) != 0) { + if (comp->attr.pointer) + { + long len_a, len_b; + len_a = mpz_get_si (comp->ts.u.cl->length->value.integer); + len_b = mpz_get_si (cons->expr->ts.u.cl->length->value.integer); + gfc_error ("Unequal character lengths (%ld/%ld) for pointer " + "component %qs in constructor at %L", + len_a, len_b, comp->name, &cons->expr->where); + t = false; + } + if (cons->expr->expr_type == EXPR_VARIABLE + && cons->expr->rank != 0 && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER) { /* Wrap the parameter in an array constructor (EXPR_ARRAY) diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 new file mode 100644 index 00000000000..08bdf176d8b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! PR fortran/50549 - should reject pointer assignments of different lengths +! in structure constructors + +program test + implicit none + type t + character(2), pointer :: p2 + end type t + type t2 + character(2), pointer :: p(:) + end type t2 + type td + character(:), pointer :: pd + end type td + interface + function f1 () + character(1), pointer :: f1 + end function f1 + function f2 () + character(2), pointer :: f2 + end function f2 + end interface + + character(1), target :: p1 + character(1), pointer :: q1(:) + character(2), pointer :: q2(:) + type(t) :: u + type(t2) :: u2 + type(td) :: v + u = t(p1) ! { dg-error "Unequal character lengths" } + u = t(f1()) ! { dg-error "Unequal character lengths" } + u = t(f2()) ! OK + u2 = t2(q1) ! { dg-error "Unequal character lengths" } + u2 = t2(q2) ! OK + v = td(p1) ! OK + v = td(f1()) ! OK +end -- 2.34.1