From patchwork Sun Oct 16 19:38:03 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 120058 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 EBD63B71A4 for ; Mon, 17 Oct 2011 06:38:22 +1100 (EST) Received: (qmail 14693 invoked by alias); 16 Oct 2011 19:38:19 -0000 Received: (qmail 14676 invoked by uid 22791); 16 Oct 2011 19:38:18 -0000 X-SWARE-Spam-Status: No, hits=-2.2 required=5.0 tests=AWL, BAYES_00, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 16 Oct 2011 19:38:04 +0000 Received: from troutmask.apl.washington.edu (localhost.apl.washington.edu [127.0.0.1]) by troutmask.apl.washington.edu (8.14.5/8.14.5) with ESMTP id p9GJc32O022280; Sun, 16 Oct 2011 12:38:03 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.14.5/8.14.5/Submit) id p9GJc3l5022279; Sun, 16 Oct 2011 12:38:03 -0700 (PDT) (envelope-from sgk) Date: Sun, 16 Oct 2011 12:38:03 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] fortran/50407 -- Format strings from user-defined operator or kind type string Message-ID: <20111016193803.GA22258@troutmask.apl.washington.edu> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.4.2.3i 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 The attach patch fixes the construction of a format string from a user-defined operator or from a string with a kind type prefix. In short, the patch allows print 2.ip.8 ! .ip. is a user-defined operator print 1_'(A)' ! 1_ designates a default character type Prior to this patch gfortran would try to match a statement label. 2011-10-16 Steven G. Kargl * io.c (match_dt_format): Match a user-defined operator or a kind type prefixed string. 2011-10-16 Steven G. Kargl * gfortran.dg/format_string.f: New test. Index: fortran/io.c =================================================================== --- fortran/io.c (revision 179940) +++ fortran/io.c (working copy) @@ -2548,17 +2554,31 @@ match_dt_format (gfc_dt *dt) if ((m = gfc_match_st_label (&label)) == MATCH_YES) { - if (dt->format_expr != NULL || dt->format_label != NULL) + char c; + + /* Need to check if the format label is actually either an operand + to a user-defined operator or is a kind type parameter. That is, + print 2.ip.8 ! .ip. is a user-defined operator return CHARACTER. + print 1_'(I0)', i ! 1_'(I0)' is a default character string. */ + + gfc_gobble_whitespace (); + c = gfc_peek_ascii_char (); + if (c == '.' || c == '_') + gfc_current_locus = where; + else { - gfc_free_st_label (label); - goto conflict; - } + if (dt->format_expr != NULL || dt->format_label != NULL) + { + gfc_free_st_label (label); + goto conflict; + } - if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE) - return MATCH_ERROR; + if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE) + return MATCH_ERROR; - dt->format_label = label; - return MATCH_YES; + dt->format_label = label; + return MATCH_YES; + } } else if (m == MATCH_ERROR) /* The label was zero or too large. Emit the correct diagnosis. */ Index: testsuite/gfortran.dg/format_string.f =================================================================== --- testsuite/gfortran.dg/format_string.f (revision 0) +++ testsuite/gfortran.dg/format_string.f (revision 0) @@ -0,0 +1,31 @@ +c { dg-do compile } +c PR fortran/50407 +c + program bar + + interface operator (.ip.) + function mul (i1, i2) + character(20) mul + intent(in) :: i1,i2 + end function + end interface + + character(20) foo + i=3 + j=4 + print 2.ip.8 ! compiles fine + print i.ip.2 ! compiles fine + print i.ip.j ! compiles fine + foo = 1_'(I0,I4.4)' + print foo, i,j + print 1_'(I0,1X,I4.4)', i, j + end + + function mul (i1, i2) + character(20) mul + intent(in) :: i1,i2 + integer prod + prod=i1*i2 + write(mul,100) prod +100 format("('ok ",i2,"')") + end function