public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, Fortran] PR 84273: Reject allocatable passed-object dummy argument (proc_ptr_47.f90)
@ 2018-02-09 17:13 Janus Weil
  2018-02-09 23:21 ` Steve Kargl
  0 siblings, 1 reply; 7+ messages in thread
From: Janus Weil @ 2018-02-09 17:13 UTC (permalink / raw)
  To: gfortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 886 bytes --]

Hi all,

the attached patch fixes some checking code for PASS arguments in
procedure-pointer components, which does not properly account for the
fact that the PASS argument needs to be polymorphic.

[The reason for this issue is probably that PPCs were mostly
implemented before polymorphism was available. The corresponding
pass-arg checks for TBPs are ok.]

The patch also fixes an invalid test case (which was detected thanks
to Neil Carlson). It regtests cleanly on x86_64-linux-gnu. Ok for
trunk?

Cheers,
Janus



2018-02-09  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/84273
    * resolve.c (resolve_component): Fix checks of passed argument in
    procedure-pointer components.


2018-02-09  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/84273
    * gfortran.dg/proc_ptr_47.f90: Fix invalid test case.
    * gfortran.dg/proc_ptr_comp_pass_4.f90: Fix and extend test case.

[-- Attachment #2: pr84273.diff --]
[-- Type: text/plain, Size: 2820 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 257498)
+++ gcc/fortran/resolve.c	(working copy)
@@ -13703,8 +13703,8 @@ resolve_component (gfc_component *c, gfc_symbol *s
           return false;
         }
 
-      /* Check for C453.  */
-      if (me_arg->attr.dimension)
+      /* Check for F03:C453.  */
+      if (CLASS_DATA (me_arg)->attr.dimension)
         {
           gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
                      "must be scalar", me_arg->name, c->name, me_arg->name,
@@ -13713,7 +13713,7 @@ resolve_component (gfc_component *c, gfc_symbol *s
           return false;
         }
 
-      if (me_arg->attr.pointer)
+      if (CLASS_DATA (me_arg)->attr.class_pointer)
         {
           gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
                      "may not have the POINTER attribute", me_arg->name,
@@ -13722,7 +13722,7 @@ resolve_component (gfc_component *c, gfc_symbol *s
           return false;
         }
 
-      if (me_arg->attr.allocatable)
+      if (CLASS_DATA (me_arg)->attr.allocatable)
         {
           gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
                      "may not be ALLOCATABLE", me_arg->name, c->name,
Index: gcc/testsuite/gfortran.dg/proc_ptr_47.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_47.f90	(revision 257498)
+++ gcc/testsuite/gfortran.dg/proc_ptr_47.f90	(working copy)
@@ -21,13 +21,9 @@
 
 contains
   function foo(A)
-    class(AA), allocatable :: A
+    class(AA) :: A
     type(AA) foo
 
-    if (.not.allocated (A)) then
-      allocate (A, source = AA (2, foo))
-    endif
-
     select type (A)
       type is (AA)
         foo = AA (3, foo)
Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90	(revision 257498)
+++ gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90	(working copy)
@@ -37,22 +37,23 @@ module m
 
  type :: t8
    procedure(foo8), pass, pointer :: f8  ! { dg-error "must be of the derived type" }
+   procedure(foo9), pass, pointer :: f9  ! { dg-error "Non-polymorphic passed-object dummy argument" }
  end type
 
 contains
 
  subroutine foo1 (x1,y1)
-  type(t1) :: x1(:)
+  class(t1) :: x1(:)
   type(t1) :: y1
  end subroutine
 
  subroutine foo2 (x2,y2)
-  type(t2),pointer :: x2
+  class(t2),pointer :: x2
   type(t2) :: y2
  end subroutine
 
  subroutine foo3 (x3,y3)
-  type(t3),allocatable :: x3
+  class(t3),allocatable :: x3
   type(t3) :: y3
  end subroutine
 
@@ -69,4 +70,8 @@ contains
    integer :: i
  end function
 
+ subroutine foo9(x)
+   type(t8) :: x
+ end subroutine
+
 end module m

^ permalink raw reply	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2018-02-12 17:14 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-02-09 17:13 [Patch, Fortran] PR 84273: Reject allocatable passed-object dummy argument (proc_ptr_47.f90) Janus Weil
2018-02-09 23:21 ` Steve Kargl
2018-02-10 11:46   ` Paul Richard Thomas
2018-02-11 13:42     ` Janus Weil
2018-02-11 21:44   ` Janus Weil
2018-02-12  7:22     ` Richard Biener
2018-02-12 17:14       ` Janus Weil

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).