From patchwork Sun Jan 24 18:54:20 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 572341 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 9315C14090A for ; Mon, 25 Jan 2016 05:54:44 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=sO9tk14Q; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=qavrSOx68I98ieNmZT/P9aYnSAu82QNVOJ2odtcXIdIvgaG6Cq DXRLJRx0CyadfThMowedTR7QWchY6E5ktRtKYx9GMQ1bOfLC8AlBTSLQK/+8i0eJ VhRuLt0pUNtdIEMEkha9zMIDCBeOnTO9BGJsB18of7Ou7lKc1TohmkXyA= 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:to:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=LqH+ZZqNs01ibjxvR8kEoybGQNE=; b=sO9tk14QLfP0I/mrg3FY yfpPWTiNAgQGm+NexWtoRxdGzq9VW85RsQp19YqVv783w5tmy8oe1N6fW3jpKmRK WcpoAGNdBAfQhU6lZMirNf8u6Y0prpK+QuYgw6qxPbbswEHbAASBxDxoKlY1fNnD 1tZcL1uzHzJbPBy/sUH0ZjE= Received: (qmail 83504 invoked by alias); 24 Jan 2016 18:54:25 -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 83443 invoked by uid 89); 24 Jan 2016 18:54:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.6 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=updating, resolving, Compiler, 1, 16 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout004-public.msg.strl.va.charter.net Received: from mtaout004-public.msg.strl.va.charter.net (HELO mtaout004-public.msg.strl.va.charter.net) (68.114.190.29) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 24 Jan 2016 18:54:23 +0000 Received: from impout004 ([68.114.189.19]) by mtaout004.msg.strl.va.charter.net (InterMail vM.9.00.021.00 201-2473-182) with ESMTP id <20160124185421.EJYL26977.mtaout004.msg.strl.va.charter.net@impout004>; Sun, 24 Jan 2016 12:54:21 -0600 Received: from quattro.localdomain ([96.41.215.23]) by impout004 with charter.net id 9uuM1s0020Wrkg001uuMQu; Sun, 24 Jan 2016 12:54:21 -0600 X-Authority-Analysis: v=2.1 cv=Fd65xfO6 c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=hOpmn2quAAAA:8 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=f3N6mSxpAaR5jrUVCOMA:9 a=QEXdDO2ut3YA:10 a=eR0vJPmYQ4fT-35EndsA:9 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: gfortran Cc: gcc patches From: Jerry DeLisle Subject: [Patch, Fortran] PR69397 and PR6844 Internal Compiler Errors2 X-Enigmail-Draft-Status: N1110 Message-ID: <56A51DDC.1050508@charter.net> Date: Sun, 24 Jan 2016 10:54:20 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.5.0 MIME-Version: 1.0 Ha all, The attached patch with new test cases fixes these by replacing gcc_assert and updating the error message depending on whether resolving an initialization expression or not. Regression tested on x86-64. OK for trunk? Jerry 2016-01-23 Jerry DeLisle PR fortran/69397 PR fortran/68442 * interface.c (gfc_arglist_matches_symbol): Replace assert with a return false if not a procedure. * resolve.c (resolve_generic_f): Test if we are resolving an initialization expression and adjust error message accordingly. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f5e8d0d..5c66c6e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3506,7 +3506,8 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) gfc_formal_arglist *dummy_args; bool r; - gcc_assert (sym->attr.flavor == FL_PROCEDURE); + if (sym->attr.flavor != FL_PROCEDURE) + return false; dummy_args = gfc_sym_get_dummy_args (sym); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 64d59ce..f197ca0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2565,8 +2565,13 @@ generic: that possesses a matching interface. 14.1.2.4 */ if (sym && !intr && !gfc_is_intrinsic (sym, 0, expr->where)) { - gfc_error ("There is no specific function for the generic %qs " - "at %L", expr->symtree->n.sym->name, &expr->where); + if (gfc_init_expr_flag) + gfc_error ("Function %qs in initialization expression at %L " + "must be an intrinsic function", + expr->symtree->n.sym->name, &expr->where); + else + gfc_error ("There is no specific function for the generic %qs " + "at %L", expr->symtree->n.sym->name, &expr->where); return false; } diff --git a/gcc/testsuite/gfortran.dg/interface_38.f90 b/gcc/testsuite/gfortran.dg/interface_38.f90 new file mode 100644 index 0000000..d8f42ee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_38.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! PR69397 +program p + interface f + procedure f1 ! { dg-error "neither function nor subroutine" } + !... more + end interface + integer, allocatable :: z + print *, f(z) ! { dg-error "no specific function" } +contains + integer function f2 (x) + integer, allocatable :: x + f2 = 1 + end +end + diff --git a/gcc/testsuite/gfortran.dg/interface_39.f90 b/gcc/testsuite/gfortran.dg/interface_39.f90 new file mode 100644 index 0000000..0d6a38e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_39.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! PR68442 +module m + interface gkind + procedure g + end interface +contains + subroutine f(x) + character(kind=gkind()) :: x ! { dg-error "must be an intrinsic" } + end + integer function g() + g = 1 + end +end