From patchwork Fri Feb 1 13:10:21 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1034749 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-495080-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="QS6ptf+4"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="AWqKHgew"; dkim-atps=neutral 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 43rcsy65rNz9sDr for ; Sat, 2 Feb 2019 00:10:45 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:cc:content-type; q=dns; s=default; b=TkyGMRFyWnRCOO05aDgPCe0tkS53hX7PLWraGeBEl+M U5H3DBl660y3TEE4VwnuV9UQTaZ5rIs0QbPVtZno5jgxVk58AGMY7kIOKnbtQB46 zvmNuZBo4xBBRABPKYp7dleKKyU4MHTsiEIxCQYUHJe+Qiw1V5xQXJolYlMKJSq0 = 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 :mime-version:from:date:message-id:subject:to:cc:content-type; s=default; bh=NMrcbVykcxa29E68Xoslryxypm4=; b=QS6ptf+4W43QIAxXY 3Sx9kxJumBgX7dihvWl0IRdC3nII0+fqsJeGfW2zJvYzNjQiZ0DNaXeCFh3uY0wg 5yXf5rc5iDcBibXMFLjLq4zxelPDWxGmslAGjQaauJgzZVEdqMaAjkYbsdX0bFT7 RQDOwIFc12yJH3vlln4UJh+Ij0= Received: (qmail 59678 invoked by alias); 1 Feb 2019 13:10:38 -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 59290 invoked by uid 89); 1 Feb 2019 13:10:38 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-6.1 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Lewis, rank, H*Ad:D*info X-HELO: mail-lj1-f172.google.com Received: from mail-lj1-f172.google.com (HELO mail-lj1-f172.google.com) (209.85.208.172) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 01 Feb 2019 13:10:36 +0000 Received: by mail-lj1-f172.google.com with SMTP id s5-v6so5696019ljd.12; Fri, 01 Feb 2019 05:10:35 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:from:date:message-id:subject:to:cc; bh=Jr5BKeSuzFArwRX3wI6cdzLFe8JwIXJMpGAGBc1OqmA=; b=AWqKHgewYo6K5fABKR62/P7fE7HT5SblmX0w2FW6g5pW2UsvdqWGE72VZjx+MfVlQk XT1jrbxK1BQt8IHCZ23caB5l2Wrk1tI353hCkqpSMqyAIm1Wb73BGywpogyA9EwbC4TJ +u3bYJl5ozNurHFeVujiDtWqPnKTAHzcywfjE/fovfk0uMQo+8MUgwhQ9J1Ih1/LeRFF kV1iarQXr7AcAUfM53Nx6pYFQTl7d33tTA5oQ0ExCHofbtMKVhQho6kF2BAoFSDintzT XOgcjlcCIPXMm7DS3Ia9HeI33GNH0EExrhrrAQjZ5JMglurH7TR9kHAtccQMNiSwBsBs 9Yzg== MIME-Version: 1.0 From: Paul Richard Thomas Date: Fri, 1 Feb 2019 13:10:21 +0000 Message-ID: Subject: [Patch, fortran] PR88980 - [9 regression] segfault on allocatable string member assignment To: "fortran@gcc.gnu.org" , gcc-patches Cc: Antony Lewis This patch is rather simpler than it looks. The segfault was occurring because r264724 changed the array reference for cases like these to use pointer arithmetic to obtain the element. Unfortunately, in the case, the span field of the descriptor was not being set during the allocation of the component items. The ChangeLog adequately explains the fix and results in the span field being set unconditionally. Bootstrapped and regtested on FC28/x86_64 - OK for trunk? Paul 2019-02-01 Paul Thomas PR fortran/88980 * trans-array.c (gfc_array_init_size): Add element_size to the arguments. (gfc_array_allocate): Remove the recalculation of the size of the element and use element_size from the call to the above. Unconditionally set the span field of the descriptor. 2019-02-01 Paul Thomas PR fortran/88980 * gfortran.dg/realloc_on_assign_32.f90 : New test. Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 268231) --- gcc/fortran/trans-array.c (working copy) *************** gfc_array_init_size (tree descriptor, in *** 5370,5383 **** gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock, stmtblock_t * descriptor_block, tree * overflow, tree expr3_elem_size, tree *nelems, gfc_expr *expr3, ! tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr) { tree type; tree tmp; tree size; tree offset; tree stride; - tree element_size; tree or_expr; tree thencase; tree elsecase; --- 5370,5383 ---- gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock, stmtblock_t * descriptor_block, tree * overflow, tree expr3_elem_size, tree *nelems, gfc_expr *expr3, ! tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr, ! tree *element_size) { tree type; tree tmp; tree size; tree offset; tree stride; tree or_expr; tree thencase; tree elsecase; *************** gfc_array_init_size (tree descriptor, in *** 5628,5637 **** tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); /* Convert to size_t. */ ! element_size = fold_convert (size_type_node, tmp); if (rank == 0) ! return element_size; *nelems = gfc_evaluate_now (stride, pblock); stride = fold_convert (size_type_node, stride); --- 5628,5637 ---- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); /* Convert to size_t. */ ! *element_size = fold_convert (size_type_node, tmp); if (rank == 0) ! return *element_size; *nelems = gfc_evaluate_now (stride, pblock); stride = fold_convert (size_type_node, stride); *************** gfc_array_init_size (tree descriptor, in *** 5641,5654 **** dividing. */ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, ! TYPE_MAX_VALUE (size_type_node), element_size); cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, logical_type_node, tmp, stride), PRED_FORTRAN_OVERFLOW); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, integer_one_node, integer_zero_node); cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR, ! logical_type_node, element_size, build_int_cst (size_type_node, 0)), PRED_FORTRAN_SIZE_ZERO); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, --- 5641,5654 ---- dividing. */ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, ! TYPE_MAX_VALUE (size_type_node), *element_size); cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, logical_type_node, tmp, stride), PRED_FORTRAN_OVERFLOW); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, integer_one_node, integer_zero_node); cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR, ! logical_type_node, *element_size, build_int_cst (size_type_node, 0)), PRED_FORTRAN_SIZE_ZERO); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, *************** gfc_array_init_size (tree descriptor, in *** 5658,5664 **** *overflow = gfc_evaluate_now (tmp, pblock); size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, ! stride, element_size); if (poffset != NULL) { --- 5658,5664 ---- *overflow = gfc_evaluate_now (tmp, pblock); size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, ! stride, *element_size); if (poffset != NULL) { *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 5736,5741 **** --- 5736,5742 ---- tree var_overflow = NULL_TREE; tree cond; tree set_descriptor; + tree element_size = NULL_TREE; stmtblock_t set_descriptor_block; stmtblock_t elseblock; gfc_expr **lower; *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 5852,5858 **** &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, expr3_elem_size, nelems, expr3, e3_arr_desc, ! e3_has_nodescriptor, expr); if (dimension) { --- 5853,5859 ---- &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, expr3_elem_size, nelems, expr3, e3_arr_desc, ! e3_has_nodescriptor, expr, &element_size); if (dimension) { *************** gfc_array_allocate (gfc_se * se, gfc_exp *** 5924,5961 **** gfc_add_expr_to_block (&se->pre, tmp); ! /* Update the array descriptors. */ if (dimension) ! gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset); ! ! /* Set the span field for pointer and deferred length character arrays. */ ! if ((is_pointer_array (se->expr) ! || (expr->ts.type == BT_CLASS && CLASS_DATA (expr)->attr.class_pointer) ! || (expr->ts.type == BT_CHARACTER && TREE_CODE (se->string_length) ! == COMPONENT_REF)) ! || (expr->ts.type == BT_CHARACTER ! && (expr->ts.deferred || VAR_P (expr->ts.u.cl->backend_decl)))) ! { ! if (expr3 && expr3_elem_size != NULL_TREE) ! tmp = expr3_elem_size; ! else if (se->string_length ! && (TREE_CODE (se->string_length) == COMPONENT_REF ! || (expr->ts.type == BT_CHARACTER && expr->ts.deferred))) ! { ! if (expr->ts.kind != 1) ! { ! tmp = build_int_cst (gfc_array_index_type, expr->ts.kind); ! tmp = fold_build2_loc (input_location, MULT_EXPR, ! gfc_array_index_type, tmp, ! fold_convert (gfc_array_index_type, ! se->string_length)); ! } ! else ! tmp = se->string_length; ! } ! else ! tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (se->expr))); ! tmp = fold_convert (gfc_array_index_type, tmp); gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp); } --- 5925,5935 ---- gfc_add_expr_to_block (&se->pre, tmp); ! /* Update the array descriptor with the offset and the span. */ if (dimension) ! { ! gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset); ! tmp = fold_convert (gfc_array_index_type, element_size); gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp); } Index: gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90 =================================================================== *** gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90 (working copy) *************** *** 0 **** --- 1,31 ---- + ! { dg-do run } + ! + ! Test the fix for PR88980 in which the 'span' field if the descriptor + ! for 'Items' was not set, causing the assignment to segfault. + ! + ! Contributed by Antony Lewis + ! + program tester + call gbug + contains + subroutine gbug + type TNameValue + character(LEN=:), allocatable :: Name + end type TNameValue + + type TNameValue_pointer + Type(TNameValue), allocatable :: P + end type TNameValue_pointer + + Type TType + type(TNameValue_pointer), dimension(:), allocatable :: Items + end type TType + Type(TType) T + + allocate(T%Items(2)) + allocate(T%Items(2)%P) + T%Items(2)%P%Name = 'test' + if (T%Items(2)%P%Name .ne. 'test') stop 1 + + end subroutine gbug + end program tester