From patchwork Sun Nov 13 22:12:55 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 694198 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 3tH7Fx5Fp0z9srZ for ; Mon, 14 Nov 2016 09:13:22 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="RLv44g/U"; 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:date :from:to:subject:message-id:mime-version:content-type; q=dns; s= default; b=ufFY3ix88IwzDmyWJP5YjjGlHa9pFeIGhvK4eDpylKSaa+0jmjKDo J8lQwxos/GMhZWk0Oe4fl35JTvSVNowxLACI6dgXNNXvFUSZ3muW1WoB72cDX20i SXn/D4+JDGrjiYJdrFpZitd3KwpHdhwpBhno0bVem76Q0TC/lfvYKw= 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:date :from:to:subject:message-id:mime-version:content-type; s= default; bh=S2HLLASsJZcfEMbvmErvrMdSThM=; b=RLv44g/Uo5P1hS9GkUkL FcPcTDaHLhM0y8NH4p1Ap3+RyG7Ybs+ucQd6CrVJeIETX/o07BWawq8ZOJwT7mvr lMHuUATkeNxCZ7Y87mzXS7lBnbdfLadZwaXaV3ZFEwpOMeIwaUAx5phTWjUV7G/M vRhJSwpSbwbjQu0XLtsnz/M= Received: (qmail 104093 invoked by alias); 13 Nov 2016 22:13:09 -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 104069 invoked by uid 89); 13 Nov 2016 22:13:08 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.8 required=5.0 tests=AWL, BAYES_00, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=20161114, 2016-11-14, intl, declared_at X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 13 Nov 2016 22:12:58 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id uADMCtYU016994 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Sun, 13 Nov 2016 14:12:55 -0800 (PST) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id uADMCtv0016993; Sun, 13 Nov 2016 14:12:55 -0800 (PST) (envelope-from sgk) Date: Sun, 13 Nov 2016 14:12:55 -0800 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/78300 -- class procedure as actual arg Message-ID: <20161113221255.GA16971@troutmask.apl.washington.edu> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.6.1 (2016-04-27) The attach patch allows a procedure with a class result to be an actual argument to subprogram where the dummy argument expected to be a class. OK to commit? 2016-11-14 Steven G. Kargl PR fortran/78300 * resolve.c (resolve_fl_var_and_proc): Allow class procedure an actual argument. 2016-11-14 Steven G. Kargl PR fortran/78300 * gfortran.dg/pr78300.f90: New test. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 242362) +++ gcc/fortran/resolve.c (working copy) @@ -11705,7 +11705,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym /* Assume that use associated symbols were checked in the module ns. Class-variables that are associate-names are also something special and excepted from the test. */ - if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc) + if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->attr.dummy + && !sym->assoc) { gfc_error ("CLASS variable %qs at %L must be dummy, allocatable " "or pointer", sym->name, &sym->declared_at); Index: gcc/testsuite/gfortran.dg/pr78300.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78300.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78300.f90 (working copy) @@ -0,0 +1,38 @@ +! { dg-do compile } +module gfc_base + + implicit none + + integer, parameter:: INTD=4 + integer, parameter:: INTL=8 + integer(INTD), parameter :: GFC_FALSE=0 + + type gfc_cont_elem_t + class(*), pointer, private:: value_p=>NULL() + integer(INTD), private:: alloc=GFC_FALSE + contains + procedure, public:: construct=>ContElemConstruct + end type gfc_cont_elem_t + + abstract interface + function gfc_copy_i(obj,ierr) result(clone) + import:: INTD + class(*), pointer:: clone + class(*), intent(in):: obj + integer(INTD), intent(out), optional:: ierr + end function gfc_copy_i + end interface + + private ContElemConstruct + + contains + + subroutine ContElemConstruct(this,obj,ierr,assoc_only,copy_constr_func) + class(gfc_cont_elem_t), intent(inout):: this + class(*), target, intent(in):: obj + integer(INTD), intent(out), optional:: ierr + logical, intent(in), optional:: assoc_only + procedure(gfc_copy_i), optional:: copy_constr_func + end subroutine ContElemConstruct + + end module gfc_base