From patchwork Mon Apr 13 14:20:10 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1269833 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=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: 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=qveBGvBI; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (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 4919kZ3vRjz9sSY for ; Tue, 14 Apr 2020 00:20:22 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9FB2A3887017; Mon, 13 Apr 2020 14:20:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9FB2A3887017 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1586787618; bh=mibluRA5s2ZETBJrgJdRGp71Se9hICsD6h8XlMQ94hQ=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=qveBGvBINDsFzfeF/RWXiZ6aWKJp5IdwMne/2OHYm7FTu4tYVo3zYp2LPBn+GamjZ 7Mgrfzf83HATnfENVotjBAN03qbQT30vYTqirwkM6OVOzNwgqEcpOqLsuv6PCoim0O mpd7UvOfBTsrs3WQXatl3ybiQls+dr6G+Tg9Mznk= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:3]) by sourceware.org (Postfix) with ESMTPS id 05E0B3887003; Mon, 13 Apr 2020 14:20:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 05E0B3887003 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 02796129DD; Mon, 13 Apr 2020 16:20:12 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id E77B211EFD; Mon, 13 Apr 2020 16:20:11 +0200 (CEST) Received: from [2001:4dd7:4da9:0:8f7e:7854:b0d:2bec] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5e94751b-45d8-7f0000012729-7f000001ce28-1 for ; Mon, 13 Apr 2020 16:20:11 +0200 Received: from linux-p51k.fritz.box (2001-4dd7-4da9-0-8f7e-7854-b0d-2bec.ipv6dyn.netcologne.de [IPv6:2001:4dd7:4da9:0:8f7e:7854:b0d:2bec]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Mon, 13 Apr 2020 16:20:10 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] Fix ICE on invalid, PR 94090 Message-ID: <90bbf341-ac70-f7ca-500d-f38fae567cb1@netcologne.de> Date: Mon, 13 Apr 2020 16:20:10 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.6.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-17.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, 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: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hello world, the attached patch fixes an ICE on invalid: When the return type of a function was misdeclared with a wrong rank, we issued a warning, but not an error (unless with -pedantic); later on, an ICE ensued. Nothing good can come from wrongly declaring a function type (considering the ABI), so I changed that into a hard error. OK for trunk? Regards Thomas 2020-04-13 Thomas Koenig PR fortran/94090 * gfortran.dg (gfc_compare_interfaces): Add optional argument bad_result_characteristics. * interface.c (gfc_check_result_characteristics): Fix whitespace. (gfc_compare_interfaces): Handle new argument; return true if function return values are wrong. * resolve.c (resolve_global_procedure): Hard error if the return value of a function is wrong. 2020-04-13 Thomas Koenig PR fortran/94090 * gfortran.dg/interface_46.f90: New test. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0d77386ddae..4e1da8c88a0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3445,7 +3445,8 @@ bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *, bool gfc_check_result_characteristics (gfc_symbol *, gfc_symbol *, char *, int); bool gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int, - char *, int, const char *, const char *); + char *, int, const char *, const char *, + bool *bad_result_characteristics = NULL); void gfc_check_interfaces (gfc_namespace *); bool gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 75a50c999b7..5b375c65694 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1529,7 +1529,7 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, bool gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, - char *errmsg, int err_len) + char *errmsg, int err_len) { gfc_symbol *r1, *r2; @@ -1695,12 +1695,16 @@ bool gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, int generic_flag, int strict_flag, char *errmsg, int err_len, - const char *p1, const char *p2) + const char *p1, const char *p2, + bool *bad_result_characteristics) { gfc_formal_arglist *f1, *f2; gcc_assert (name2 != NULL); + if (bad_result_characteristics) + *bad_result_characteristics = false; + if (s1->attr.function && (s2->attr.subroutine || (!s2->attr.function && s2->ts.type == BT_UNKNOWN && gfc_get_default_type (name2, s2->ns)->type == BT_UNKNOWN))) @@ -1726,7 +1730,11 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2, /* If both are functions, check result characteristics. */ if (!gfc_check_result_characteristics (s1, s2, errmsg, err_len) || !gfc_check_result_characteristics (s2, s1, errmsg, err_len)) - return false; + { + if (bad_result_characteristics) + *bad_result_characteristics = true; + return false; + } } if (s1->attr.pure && !s2->attr.pure) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ccd2a5e3b7d..36659790ddf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2605,11 +2605,24 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) /* Turn erros into warnings with -std=gnu and -std=legacy. */ gfc_errors_to_warnings (true); + /* If a function returns a wrong type, this can lead to + all kinds of ICEs and wrong code; issue a hard error + in this case. */ + + bool bad_result_characteristics; if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, - reason, sizeof(reason), NULL, NULL)) + reason, sizeof(reason), NULL, NULL, + &bad_result_characteristics)) { - gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" + if (bad_result_characteristics) + { + gfc_errors_to_warnings (false); + gfc_error ("Interface mismatch in global procedure %qs at %L:" " %s", sym->name, &sym->declared_at, reason); + } + else + gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:" + " %s", sym->name, &sym->declared_at, reason); goto done; } } diff --git a/gcc/testsuite/gfortran.dg/interface_46.f90 b/gcc/testsuite/gfortran.dg/interface_46.f90 new file mode 100644 index 00000000000..c1d87638fbe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_46.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! PR 94090 - this used to cause an ICE. +! Test case by José Rui Faustino de Sousa. +function cntf(a) result(s) + implicit none + + integer, intent(in) :: a(:) + + integer :: s(3) + + s = [1, 2, 3] + return +end function cntf + +program ice_p + + implicit none + + interface + function cntf(a) result(s) ! { dg-error "Rank mismatch in function result" } + implicit none + integer, intent(in) :: a(:) + integer :: s ! (3) <- Ups! + end function cntf + end interface + + integer, parameter :: n = 9 + + integer :: arr(n) + + integer :: s(3) + + s = cntf(arr) + stop + +end program ice_p