From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id A69FC39960F3; Thu, 20 May 2021 21:29:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org A69FC39960F3 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.13.38] ([79.251.13.38]) by web-mail.gmx.net (3c-app-gmx-bs41.server.lan [172.19.170.93]) (via HTTP); Thu, 20 May 2021 23:29:25 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] PR fortran/100551 - [11/12 Regression] Passing return value to class(*) dummy argument Content-Type: multipart/mixed; boundary=sgnirk-493d8ce9-f6fb-46c6-bc89-6194f6084a08 Date: Thu, 20 May 2021 23:29:25 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:TjTQPILHPe74hfOljVkMXCseuzfg1Y9j1KW5FlqpXn/rFa3PTNIC46uKZwbqdXAcUEzFC bxLbZZITqyOPAdu2C/gFWVOh+/vdPiLcT2hPZ5dR4mCZXrwTvxwwQB1O6mmBMGR/2yS8x1OK/bSQ CBbzV/I1OEz1FJvUo4oxL3Zf2itIlJ81mksQbXfq1LmHDrMLW1GsDOMJy8+bWz5GlCtXbNpMvb4j 9qrnMOqTzOaXO54yOLX+jSDelQ/XbPZvK30vEVIngX3UhCeYxCSF7oziA309FDt4SjvixX1SYHjY 2c= X-UI-Out-Filterresults: notjunk:1;V03:K0:nONzevMfoMU=:QF33Y/90ynAQ8ylsfCIDHi KFLv1ipDB6i68VF8m+kQlUjRyBeo7Zb6IN1Zz5/sgTCvAaiLArFA3vsDe5ZBxuochoJBkkOoc UdEitN/F8/crAp9eT28Jrn4k+zKnbUThTARyupRNFns2bDbm9KuiU4ml5NRDlyGMmzM3bYaPT fkmGPlKkzaEIqRajjC9GCauzrnfAYbIquOdmGrD244rvgnD+2dzYL5Mx5PGgOcl+938fVT9rL vAC1GfSG+t+w412T2CDRTD/rHxTTfE+Qn2TbHQ5axhnt+9WqrM8ZO/XEh1UoH99+8GlH5KxwW qzGUR/cv12lWjGQWxKJBqOY955QUoxtxDKZPjuWtrzw3Y+f3ROoDZaYh4nuU+IyWubBA/kpiJ X7L4IXcmduct8SH4g2nuY5a8S9B4OnwrhsIgzKcMe4olJEJpa3dO4qjvnIPowqrDPSAZ755JD Daha6+3Nn3Kyd4MWhxzGSUyB+7np1zj4p2KgIlYyWymhJbU0OmRKtwwfSQSz45zh7nroyEMt0 MAatuDhwqEbXRibKvsdeOV1JmeLcqVH95YqJ0h0wwqpqMv1NpJOghzDJKWNYZlRRnUU5zDsfS jAPOarKa2o6EI5TBBQuHt55imkB4lIOO4ViIWR2WX2h5Jyj5u0/pOlVUw17vc1uWuw139IG0s VNgso6dVryRpIriEUZ21y6McFpQ4z4NVTJe/gCYERk3rFRR+H09D19qELmZbFO3GB3Wo9fVwj jqYaqnFcFdG26vDvpKyCYYehiZWt+BEnzGGjeNgQF0UgVUbT1yNoLmbN8+1a+Y8vZ6vP+J5lr 4//t8670EikG1LxoapH0jZ3tbHVxOIf9PkvNlyR5GUABWxnwMgR0RtBUUlVy6iw8RR+7DrrnA H0eZwTuxxwQ4EQZ6gs5q5e8AzDcD6v7jVEl9NEagrnZ2J2NLttGqnq+itHYptf X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 20 May 2021 21:29:29 -0000 --sgnirk-493d8ce9-f6fb-46c6-bc89-6194f6084a08 Content-Type: text/plain; charset=UTF-8 The fix for PR93924/5 has caused a regression for code such as given in the present PR. This can be remedied by adjusting the check when to invoke the implicit conversion of actual argument to an unlimited polymorphic procedure argument. Regtested on x86_64-pc-linux-gnu. OK for mainline and backport to 11-branch? Thanks, Harald Fortran: fix passing return value to class(*) dummy argument gcc/fortran/ChangeLog: PR fortran/100551 * trans-expr.c (gfc_conv_procedure_call): Adjust check for implicit conversion of actual argument to an unlimited polymorphic procedure argument. gcc/testsuite/ChangeLog: PR fortran/100551 * gfortran.dg/pr100551.f90: New test. --sgnirk-493d8ce9-f6fb-46c6-bc89-6194f6084a08 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr100551.patch diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index cce18d094a6..3432cd4fdfd 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5826,7 +5826,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, &derived_array); } else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS - && gfc_expr_attr (e).flavor != FL_PROCEDURE) + && e->ts.type != BT_PROCEDURE + && (gfc_expr_attr (e).flavor != FL_PROCEDURE + || gfc_expr_attr (e).proc != PROC_UNKNOWN)) { /* The intrinsic type needs to be converted to a temporary CLASS object for the unlimited polymorphic formal. */ diff --git a/gcc/testsuite/gfortran.dg/pr100551.f90 b/gcc/testsuite/gfortran.dg/pr100551.f90 new file mode 100644 index 00000000000..f82f505e734 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100551.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! PR fortran/100551 - Passing return value to class(*) dummy argument + +program p + implicit none + integer :: result + result = 1 + result = test ( (result)) ! works + if (result /= 1) stop 1 + result = test (int (result)) ! issue 1 +! write(*,*) result + if (result /= 1) stop 2 + result = test (f (result)) ! issue 2 +! write(*,*) result + if (result /= 2) stop 3 +contains + integer function test(x) + class(*), intent(in) :: x + select type (x) + type is (integer) + test = x + class default + test = -1 + end select + end function test + integer function f(x) + integer, intent(in) :: x + f = 2*x + end function f +end program --sgnirk-493d8ce9-f6fb-46c6-bc89-6194f6084a08--