re PR fortran/84273 ([F03] Reject allocatable passed-object dummy argument (proc_ptr_47.f90))

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

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


2018-02-12  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.

From-SVN: r257590

gcc/fortran/ChangeLog

+2018-02-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/84273
+	* resolve.c (resolve_component): Fix checks of passed argument in
+	procedure-pointer components.
+
 2018-02-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/35299

gcc/fortran/resolve.c

@@ -13706,8 +13706,8 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
           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,
@@ -13716,7 +13716,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
           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,
@@ -13725,7 +13725,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
           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,

gcc/testsuite/ChangeLog

+2018-02-12  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.
+
 2018-02-12  Tamar Christina  <tamar.christina@arm.com>
 
 	PR target/82641

gcc/testsuite/gfortran.dg/proc_ptr_47.f90

@@ -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)

gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90

@@ -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