From patchwork Tue Jan 25 12:30:06 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 80351 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 DFE3D1007D2 for ; Tue, 25 Jan 2011 23:30:22 +1100 (EST) Received: (qmail 2956 invoked by alias); 25 Jan 2011 12:30:19 -0000 Received: (qmail 2895 invoked by uid 22791); 25 Jan 2011 12:30:16 -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, 25 Jan 2011 12:30:11 +0000 Received: from [192.168.178.22] (port-92-204-33-159.dynamic.qsc.de [92.204.33.159]) by mx01.qsc.de (Postfix) with ESMTP id ECD483D4E8; Tue, 25 Jan 2011 13:30:07 +0100 (CET) Message-ID: <4D3EC24E.9090907@net-b.de> Date: Tue, 25 Jan 2011 13:30:06 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.13) Gecko/20101206 SUSE/3.1.7 Thunderbird/3.1.7 MIME-Version: 1.0 To: gfortran , gcc patches Subject: [Patch, Fortran] PR 47448 - fix defined assignment 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 Defined assignment ("interface assignment(=)") is not allowed to override intrinsic assignments. In particular, it is invalid to override array = scalar array = array ! for the same rank while it is valid to use scalar = array array = array ! for different ranks. Seemingly before 2009-08-10 (cf. PR 37425) all those where rejected. However, with that patch accidentally "array = scalar" and not "scalar = array" became accepted. Thus, the patch below fixes a regression in the sense that no error message is printed with 4.5/4.6 for the invalid test case. However, the valid case was never allowed. Build and regtested on x86-64-linux OK for the trunk? Does anyone want to see this backported to a branch? Tobias 2011-01-25 Tobias Burnus PR fortran/47448 * interface.c (gfc_check_operator_interface): Fix defined-assignment check. 2011-01-25 Tobias Burnus PR fortran/47448 * gfortran.dg/redefined_intrinsic_assignment_2.f90: New. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 1febb5d..c5b690e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -654,11 +654,12 @@ gfc_check_operator_interface (gfc_symbol *sym, gfc_intrinsic_op op, /* Allowed are (per F2003, 12.3.2.1.2 Defined assignments): - First argument an array with different rank than second, - - Types and kinds do not conform, and + - First argument is a scalar and second an array, + - Types and kinds do not conform, or - First argument is of derived type. */ if (sym->formal->sym->ts.type != BT_DERIVED && sym->formal->sym->ts.type != BT_CLASS - && (r1 == 0 || r1 == r2) + && (r2 == 0 || r1 == r2) && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type || (gfc_numeric_ts (&sym->formal->sym->ts) && gfc_numeric_ts (&sym->formal->next->sym->ts)))) --- /dev/null 2011-01-14 07:32:07.372000004 +0100 +++ gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90 2011-01-25 11:06:52.000000000 +0100 @@ -0,0 +1,68 @@ +! { dg-do compile } +! +! PR fortran/47448 +! +! ASSIGNMENT(=) checks. Defined assignment is allowed if and only if +! it does not override an intrinsic assignment. +! + +module test1 + interface assignment(=) + module procedure valid, valid2 + end interface +contains + ! Valid: scalar = array + subroutine valid (lhs,rhs) + integer, intent(out) :: lhs + integer, intent(in) :: rhs(:) + lhs = rhs(1) + end subroutine valid + + ! Valid: array of different ranks + subroutine valid2 (lhs,rhs) + integer, intent(out) :: lhs(:) + integer, intent(in) :: rhs(:,:) + lhs(:) = rhs(:,1) + end subroutine valid2 +end module test1 + +module test2 + interface assignment(=) + module procedure invalid + end interface +contains + ! Invalid: scalar = scalar + subroutine invalid (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" } + integer, intent(out) :: lhs + integer, intent(in) :: rhs + lhs = rhs + end subroutine invalid +end module test2 + +module test3 + interface assignment(=) + module procedure invalid2 + end interface +contains + ! Invalid: array = scalar + subroutine invalid2 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" } + integer, intent(out) :: lhs(:) + integer, intent(in) :: rhs + lhs(:) = rhs + end subroutine invalid2 +end module test3 + +module test4 + interface assignment(=) + module procedure invalid3 + end interface +contains + ! Invalid: array = array for same rank + subroutine invalid3 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" } + integer, intent(out) :: lhs(:) + integer, intent(in) :: rhs(:) + lhs(:) = rhs(:) + end subroutine invalid3 +end module test4 + +! { dg-final { cleanup-modules "test1" } }