From patchwork Wed Sep 7 21:14:50 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 113838 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 615B6B6F93 for ; Thu, 8 Sep 2011 07:15:20 +1000 (EST) Received: (qmail 8818 invoked by alias); 7 Sep 2011 21:15:10 -0000 Received: (qmail 8781 invoked by uid 22791); 7 Sep 2011 21:15:07 -0000 X-SWARE-Spam-Status: No, hits=-2.0 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-yx0-f175.google.com (HELO mail-yx0-f175.google.com) (209.85.213.175) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 07 Sep 2011 21:14:51 +0000 Received: by yxj17 with SMTP id 17so85895yxj.20 for ; Wed, 07 Sep 2011 14:14:50 -0700 (PDT) MIME-Version: 1.0 Received: by 10.236.9.36 with SMTP id 24mr35957192yhs.17.1315430090778; Wed, 07 Sep 2011 14:14:50 -0700 (PDT) Received: by 10.147.83.10 with HTTP; Wed, 7 Sep 2011 14:14:50 -0700 (PDT) In-Reply-To: <4E67D8DD.5090902@net-b.de> References: <4E67D8DD.5090902@net-b.de> Date: Wed, 7 Sep 2011 23:14:50 +0200 Message-ID: Subject: Re: [Patch, Fortran, OOP] PR 48095: Invalid assignment to procedure pointer component not rejected From: Janus Weil To: Tobias Burnus Cc: gfortran , gcc-patches 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 Hi Tobias, >> +         if (s2&&  !gfc_compare_interfaces (comp->ts.interface, s2, name, >> 0, 1, >> +                                            err, sizeof(err))) > > Space after sizeof. Fixed. >> +             gfc_error ("In derived type constructor at %L: Interface >> mismatch" >> +                        " in procedure pointer component '%s': %s", >> +                       &cons->expr->where, comp->name, err); > > Somehow, I find the words clumsy with too many colons. "derived type > constructor" - I'd use a hyphen ("derived-type") and I want to note that the > standard calls it "structure constructor"; I also would use "for ... > component" and not "in ... component" and add a hyphen to "procedure > pointer". You are right about the hyphens, and I also agree that it makes more sense to stick to the standard language. Note: My wording was partly copied over from other error messages in resolve_structure_cons, all of which use "derived type constructor". I'm changing all of them in the attached update of the patch. > How about a simpler: "Interface mismatch for procedure-pointer component > '%s' at %L: %s"? I think it should be clear from the context that it is > about a structure constructor. Or for the long version, how about: > "Interface mismatch for procedure-pointer component '%s' in structure > constructor at %L: %s"? I prefer the second variant. I'll do another regtest with the updated patch (the changed error messages might need testsuite adaptions?) and then go ahead and commit it. Thanks for the review. Cheers, Janus Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 178659) +++ gcc/fortran/resolve.c (working copy) @@ -1013,7 +1013,7 @@ resolve_structure_cons (gfc_expr *expr, int init) if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank && (comp->attr.allocatable || cons->expr->rank)) { - gfc_error ("The rank of the element in the derived type " + gfc_error ("The rank of the element in the structure " "constructor at %L does not match that of the " "component (%d/%d)", &cons->expr->where, cons->expr->rank, rank); @@ -1035,7 +1035,7 @@ resolve_structure_cons (gfc_expr *expr, int init) t = SUCCESS; } else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN) - gfc_error ("The element in the derived type constructor at %L, " + gfc_error ("The element in the structure constructor at %L, " "for pointer component '%s', is %s but should be %s", &cons->expr->where, comp->name, gfc_basic_typename (cons->expr->ts.type), @@ -1113,12 +1113,46 @@ resolve_structure_cons (gfc_expr *expr, int init) || CLASS_DATA (comp)->attr.allocatable)))) { t = FAILURE; - gfc_error ("The NULL in the derived type constructor at %L is " + gfc_error ("The NULL in the structure constructor at %L is " "being applied to component '%s', which is neither " "a POINTER nor ALLOCATABLE", &cons->expr->where, comp->name); } + if (comp->attr.proc_pointer && comp->ts.interface) + { + /* Check procedure pointer interface. */ + gfc_symbol *s2 = NULL; + gfc_component *c2; + const char *name; + char err[200]; + + if (gfc_is_proc_ptr_comp (cons->expr, &c2)) + { + s2 = c2->ts.interface; + name = c2->name; + } + else if (cons->expr->expr_type == EXPR_FUNCTION) + { + s2 = cons->expr->symtree->n.sym->result; + name = cons->expr->symtree->n.sym->result->name; + } + else if (cons->expr->expr_type != EXPR_NULL) + { + s2 = cons->expr->symtree->n.sym; + name = cons->expr->symtree->n.sym->name; + } + + if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, + err, sizeof (err))) + { + gfc_error ("Interface mismatch for procedure-pointer component " + "'%s' in structure constructor at %L: %s", + &cons->expr->where, comp->name, err); + return FAILURE; + } + } + if (!comp->attr.pointer || comp->attr.proc_pointer || cons->expr->expr_type == EXPR_NULL) continue; @@ -1128,7 +1162,7 @@ resolve_structure_cons (gfc_expr *expr, int init) if (!a.pointer && !a.target) { t = FAILURE; - gfc_error ("The element in the derived type constructor at %L, " + gfc_error ("The element in the structure constructor at %L, " "for pointer component '%s' should be a POINTER or " "a TARGET", &cons->expr->where, comp->name); } @@ -1156,7 +1190,7 @@ resolve_structure_cons (gfc_expr *expr, int init) || gfc_is_coindexed (cons->expr))) { t = FAILURE; - gfc_error ("Invalid expression in the derived type constructor for " + gfc_error ("Invalid expression in the structure constructor for " "pointer component '%s' at %L in PURE procedure", comp->name, &cons->expr->where); } Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 178659) +++ gcc/fortran/primary.c (working copy) @@ -2418,7 +2418,10 @@ gfc_match_structure_constructor (gfc_symbol *sym, } /* Match the current initializer expression. */ + if (this_comp->attr.proc_pointer) + gfc_matching_procptr_assignment = 1; m = gfc_match_expr (&comp_tail->val); + gfc_matching_procptr_assignment = 0; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR)