From patchwork Tue Sep 13 22:12:36 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 114566 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]) by ozlabs.org (Postfix) with SMTP id 66619B71BF for ; Wed, 14 Sep 2011 08:13:21 +1000 (EST) Received: (qmail 317 invoked by alias); 13 Sep 2011 22:13:16 -0000 Received: (qmail 301 invoked by uid 22791); 13 Sep 2011 22:13:13 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 13 Sep 2011 22:12:38 +0000 Received: from archimedes.net-b.de (port-92-204-66-235.dynamic.qsc.de [92.204.66.235]) by mx01.qsc.de (Postfix) with ESMTP id 7C0A93DACB; Wed, 14 Sep 2011 00:12:36 +0200 (CEST) Message-ID: <4E6FD554.5040206@net-b.de> Date: Wed, 14 Sep 2011 00:12:36 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:6.0) Gecko/20110812 Thunderbird/6.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [PRs 34547/50375] Fixes to NULL with MOLD= check 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 NULL requires a MOLD argument if the mold cannot be determined from the context: a) print *, null() - was ICEing b) call foo(null()) - [implicit interface] was accepted but no dummy is available to get the type c) call generic(null()) - need to reject it, if it would match several specific functions d) null(allocatable) - now allowed (F2003), was rejected before. (c) is PR 50375, the rest is PR 34547; see PR for the quote from the standards. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2011-09-14 Tobias Burnus PR fortran/34547 PR fortran/50375 * check.c (gfc_check_null): Allow allocatables as MOLD to NULL. * resolve.c (resolve_transfer): Reject NULL without MOLD. * interface.c (gfc_procedure_use): Reject NULL without MOLD if no explicit interface is known. (gfc_search_interface): Reject NULL without MOLD if it would lead to ambiguity. 2011-09-14 Tobias Burnus PR fortran/34547 PR fortran/50375 * gfortran.dg/null_5.f90: New. * gfortran.dg/null_6.f90: New. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 3d4f4c8..1e9e719 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2732,14 +2732,19 @@ gfc_check_null (gfc_expr *mold) attr = gfc_variable_attr (mold, NULL); - if (!attr.pointer && !attr.proc_pointer) + if (!attr.pointer && !attr.proc_pointer && !attr.allocatable) { - gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER", - gfc_current_intrinsic_arg[0]->name, + gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER or " + "ALLOCATABLE", gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, &mold->where); return FAILURE; } + if (attr.allocatable + && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NULL intrinsic with " + "allocatable MOLD at %L", &mold->where) == FAILURE) + return FAILURE; + /* F2008, C1242. */ if (gfc_is_coindexed (mold)) { diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index a9b3d70..7962403 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2857,6 +2857,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) "procedure '%s'", &a->expr->where, sym->name); break; } + + if (a->expr && a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN) + { + gfc_error ("MOLD argument to NULL required at %L", &a->expr->where); + return; + } } return; @@ -2949,6 +2956,20 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, gfc_actual_arglist **ap) { gfc_symbol *elem_sym = NULL; + gfc_symbol *null_sym = NULL; + locus null_expr_loc; + gfc_actual_arglist *a; + bool has_null_arg = false; + + for (a = *ap; a; a = a->next) + if (a->expr && a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN) + { + has_null_arg = true; + null_expr_loc = a->expr->where; + break; + } + for (; intr; intr = intr->next) { if (sub_flag && intr->sym->attr.function) @@ -2958,6 +2979,19 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, if (gfc_arglist_matches_symbol (ap, intr->sym)) { + if (has_null_arg && null_sym) + { + gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity " + "between specific functions %s and %s", + &null_expr_loc, null_sym->name, intr->sym->name); + return NULL; + } + else if (has_null_arg) + { + null_sym = intr->sym; + continue; + } + /* Satisfy 12.4.4.1 such that an elemental match has lower weight than a non-elemental match. */ if (intr->sym->attr.elemental) @@ -2969,6 +3003,9 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, } } + if (null_sym) + return null_sym; + return elem_sym ? elem_sym : NULL; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b038402..9aab836 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8150,6 +8150,13 @@ resolve_transfer (gfc_code *code) && exp->value.op.op == INTRINSIC_PARENTHESES) exp = exp->value.op.op1; + if (exp && exp->expr_type == EXPR_NULL && exp->ts.type == BT_UNKNOWN) + { + gfc_error ("NULL intrinsic at %L in data transfer statement requires " + "MOLD=", &exp->where); + return; + } + if (exp == NULL || (exp->expr_type != EXPR_VARIABLE && exp->expr_type != EXPR_FUNCTION)) return; --- /dev/null 2011-09-13 08:06:22.075577943 +0200 +++ gcc/gcc/testsuite/gfortran.dg/null_5.f90 2011-09-13 23:58:13.000000000 +0200 @@ -0,0 +1,43 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! +! PR fortran/34547 +! PR fortran/50375 + +subroutine test_PR50375_1 () + ! Contributed by Vittorio Zecca + interface gen1 + subroutine s11 (pi) + integer, pointer :: pi + end subroutine + subroutine s12 (pr) + real, pointer :: pr + end subroutine + end interface + call gen1 (null ()) ! { dg-error "MOLD= required in NULL|There is no specific subroutine" } +end subroutine test_PR50375_1 + +subroutine test_PR50375_2 () + interface gen2 + subroutine s21 (pi) + integer, pointer :: pi + end subroutine + subroutine s22 (pr) + real, optional :: pr + end subroutine + end interface + call gen2 (null ()) ! OK in F95/F2003 (but not in F2008) +end subroutine test_PR50375_2 + +subroutine test_PR34547_1 () + call proc (null ()) ! { dg-error "MOLD argument to NULL required" } +end subroutine test_PR34547_1 + +subroutine test_PR34547_2 () + print *, null () ! { dg-error "in data transfer statement requires MOLD" } +end subroutine test_PR34547_2 + +subroutine test_PR34547_3 () + integer, allocatable :: i(:) + print *, NULL(i) ! { dg-error "Fortran 2003: NULL intrinsic with allocatable MOLD" } +end subroutine test_PR34547_3 --- /dev/null 2011-09-13 08:06:22.075577943 +0200 +++ gcc/gcc/testsuite/gfortran.dg/null_6.f90 2011-09-13 23:18:01.000000000 +0200 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } +! +! PR fortran/34547 +! PR fortran/50375 + +subroutine test_PR50375_3 () + interface gen3 + subroutine s31 (pi) + integer, pointer :: pi + end subroutine + subroutine s32 (pr) + real, allocatable :: pr(:) + end subroutine + end interface + call gen3 (null ()) ! OK +end subroutine test_PR50375_3 + +subroutine test_PR50375_2 () + interface gen2 + subroutine s21 (pi) + integer, pointer :: pi + end subroutine + subroutine s22 (pr) + real, optional :: pr + end subroutine + end interface + call gen2 (null ()) ! { dg-error "MOLD= required in NULL|There is no specific subroutine" } +end subroutine test_PR50375_2 + +subroutine test_PR34547_3 () + integer, allocatable :: i(:) + print *, NULL(i) +end subroutine test_PR34547_3