From patchwork Mon May 20 09:06:52 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 90474 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 727BF3858C32 for ; Mon, 20 May 2024 09:07:46 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pj1-x102b.google.com (mail-pj1-x102b.google.com [IPv6:2607:f8b0:4864:20::102b]) by sourceware.org (Postfix) with ESMTPS id 39BCD3858D1E; Mon, 20 May 2024 09:07:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 39BCD3858D1E Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 39BCD3858D1E Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::102b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716196027; cv=none; b=WMIBMPBw90EwuOCcN0wwZixV9g5Bl90UtEGg5QX6Hknzq5n6c1yN/sI1lJexA3ZZOKz9ImZqa3FrVq3nLMJTq8YZalIoxNA5nBAclKOfPg6xDEjB4GbqcQUYc4TCj86HcMDsfukVm2biV5yx66rHyWCSSMJwqoy35TDmdJyVA8s= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1716196027; c=relaxed/simple; bh=JC6CwblLfPChaRsP5iSPr02bA9DcZk7Gyg7HfLbfgNM=; h=DKIM-Signature:MIME-Version:From:Date:Message-ID:Subject:To; b=D/R5yZfwJHPSaP0UR0imjPVWhrcQmEXan30ak6kqGvWym554cQLrml3eB9G9rGHYXXt3vChpduK31y3ab4sFv4ALgfLHXDoULZpvnKYDAwQksqPBZrNujoCt/QqEu6lsVDSQTpRgw8v4jOTtpg1BPWN2QEOSuMflNTjxCkWzJbc= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-pj1-x102b.google.com with SMTP id 98e67ed59e1d1-2b433dd2566so1031678a91.2; Mon, 20 May 2024 02:07:05 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1716196024; x=1716800824; darn=gcc.gnu.org; h=to:subject:message-id:date:from:mime-version:from:to:cc:subject :date:message-id:reply-to; bh=JC6CwblLfPChaRsP5iSPr02bA9DcZk7Gyg7HfLbfgNM=; b=hZKgVEY58P1Ha4MnLbh38bKsbXjKzjVv/2dp8bvXpGO/GgoLgEqRS5FLlx09vFo6yv lgUjSC3xkX1b/WH6qLTrlRq/RNDw/ESvu3e5YSs81TjF/+fNnJjCD0PsdLN8dWfDpO+5 0EfAGhT9Aq0zD0vP24B9I6aVezB3/D7hv0MKEIwviBtae1wcz9nOqodDQnungk6uEqHY VGekIPh05crNNH/XfLXn8q9gqm7Im1YhL+ZXPVl89JKQFM2YtCsTCu3Wvww4qmubdYVo gDo23w+hggfJ7AYGXNA6XNnRTjQpk9Tn5MxWu+670MJhZ+l+4EmvedupakJ07r44pmU9 PXUg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1716196024; x=1716800824; h=to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=JC6CwblLfPChaRsP5iSPr02bA9DcZk7Gyg7HfLbfgNM=; b=F5lXZrhfZlC0Jdz53Y3Qud8wFy/2QSUA+OZ216kIKeW1v9gYOZmyygfvw9RRwBuMbJ Qd0T3QHfMhMS0oFfXPuDfSFqIYhKZH1jBRITtt4V6g9V+PTBl28/8NWfhAYLR5YgSzIY x0q/h5ToiJBzTHlP7Fl9TYrtxAibpsavf0e0aD/WS2WD7GGtX3byD9dwhTI+TCfJfs52 m+urKRow5Swrc5owvDsGd+Spoq3oGq1iWleJkHhwIxjVk1rjIHQLyIO+Nfxj1Df8Btbv N8SmHriyCUlKjLO1FOLawmkbQLRxokZYUMCcJ0co8PVe51sUNyvze5MD9xINx1ET202N oAhQ== X-Forwarded-Encrypted: i=1; AJvYcCXaSH+bGnpyQyRB6G1GSnb8bbK+2bPKUpfn5pYzwJy+2mJqIofUwzS2/vpHGlZgvSC3X+lVpYGdxzz0vwIvdmb9wurDnW7eKQ== X-Gm-Message-State: AOJu0Yx6pwFgSoSt6iYHgrdRx4IRu5sKlULslFsTHx5Zr1ySC1n8r8Gh n/EBTNFtUB0SO3Ho8bBU7x9x9x/hM/kS9pVWDdF5/hpVu+8v9O27WDPiynG5Y6HWYJ6uVcnw3bx itpQwROJ6DOFP36jG+kVKBUXsTJo4mA== X-Google-Smtp-Source: AGHT+IEE/9Kc2tl5hbNLDi+Za4x3ntgO8rsA95RMG7V+3RgSc9p83Jy5cVZ1ulhqAend24YsI5O2tY8KjKbe1rgzYTU= X-Received: by 2002:a17:90a:f697:b0:2bd:4054:d322 with SMTP id 98e67ed59e1d1-2bd4054d4ecmr9674458a91.9.1716196023561; Mon, 20 May 2024 02:07:03 -0700 (PDT) MIME-Version: 1.0 From: Paul Richard Thomas Date: Mon, 20 May 2024 10:06:52 +0100 Message-ID: Subject: [Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e To: "fortran@gcc.gnu.org" , gcc-patches X-Spam-Status: No, score=-7.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, HTML_MESSAGE, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Hi All, I don't think that this PR is really a regression although the fact that it is marked as such brought it to my attention :-) The fix turned out to be remarkably simple. It was found after going down a silly number of rabbit holes, though! The chunk in dependency.cc is probably more elaborate than it needs to be. Returning -2 is sufficient for the testcase to work. Otherwise, the comments in the patch say it all. OK for mainline? I will delay for a month before backporting. Regards Paul diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc index fb4d94de641..bafe8cbc5bc 100644 --- a/gcc/fortran/dependency.cc +++ b/gcc/fortran/dependency.cc @@ -440,6 +440,38 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) return mpz_sgn (e2->value.op.op2->value.integer); } + + if (e1->expr_type == EXPR_COMPCALL) + { + /* This will have emerged from interface.cc(gfc_check_typebound_override) + via gfc_check_result_characteristics. It is possible that other + variants exist that are 'equal' but play it safe for now by setting + the relationship as 'indeterminate'. */ + if (e2->expr_type == EXPR_FUNCTION && e2->ref) + { + gfc_ref *ref = e2->ref; + gfc_symbol *s = NULL; + + if (e1->value.compcall.tbp->u.specific) + s = e1->value.compcall.tbp->u.specific->n.sym; + + /* Check if the proc ptr points to an interface declaration and the + names are the same; ie. the overriden proc. of an abstract type. + The checking of the arguments will already have been done. */ + for (; ref && s; ref = ref->next) + if (!ref->next && ref->type == REF_COMPONENT + && ref->u.c.component->attr.proc_pointer + && ref->u.c.component->ts.interface + && ref->u.c.component->ts.interface->attr.if_source + == IFSRC_IFBODY + && !strcmp (s->name, ref->u.c.component->name)) + return 0; + } + + /* Assume as default that TKR checking is sufficient. */ + return -2; + } + if (e1->expr_type != e2->expr_type) return -3; diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index c883966646c..4ee2ad55915 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -3210,6 +3210,11 @@ gfc_reduce_init_expr (gfc_expr *expr) { bool t; + /* It is far too early to resolve a class compcall. Punt to resolution. */ + if (expr && expr->expr_type == EXPR_COMPCALL + && expr->symtree->n.sym->ts.type == BT_CLASS) + return true; + gfc_init_expr_flag = true; t = gfc_resolve_expr (expr); if (t) diff --git a/gcc/testsuite/gfortran.dg/pr103312.f90 b/gcc/testsuite/gfortran.dg/pr103312.f90 new file mode 100644 index 00000000000..deacc70bf5d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103312.f90 @@ -0,0 +1,87 @@ +! { dg-do run } +! +! Test the fix for pr103312, in which the use of a component call in +! initialization expressions, eg. character(this%size()), caused ICEs. +! +! Contributed by Arseny Solokha +! +module example + + type, abstract :: foo + integer :: i + contains + procedure(foo_size), deferred :: size + procedure(foo_func), deferred :: func + end type + + interface + function foo_func (this) result (string) + import :: foo + class(foo) :: this + character(this%size()) :: string + end function + pure integer function foo_size (this) + import foo + class(foo), intent(in) :: this + end function + end interface + +end module + +module extension + use example + implicit none + type, extends(foo) :: bar + contains + procedure :: size + procedure :: func + end type + +contains + pure integer function size (this) + class(bar), intent(in) :: this + size = this%i + end function + function func (this) result (string) + class(bar) :: this + character(this%size()) :: string + string = repeat ("x", len (string)) + end function + +end module + +module unextended + implicit none + type :: foobar + integer :: i + contains + procedure :: size + procedure :: func + end type + +contains + pure integer function size (this) + class(foobar), intent(in) :: this + size = this%i + end function + function func (this) result (string) + class(foobar) :: this + character(this%size()) :: string + character(:), allocatable :: chr + string = repeat ("y", len (string)) + allocate (character(this%size()) :: chr) + if (len (string) .ne. len (chr)) stop 1 + end function + +end module + + use example + use extension + use unextended + type(bar) :: a + type(foobar) :: b + a%i = 5 + if (a%func() .ne. 'xxxxx') stop 2 + b%i = 7 + if (b%func() .ne. 'yyyyyyy') stop 3 +end