[Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Daniel Kraft]

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

Hi all,

this patch is some take in the direction of PR 41177.  It adds checks 
that the passed-object dummy argument of a type-bound procedure must be 
scalar, non-POINTER and non-ALLOCATABLE which is at the moment simply 
overlooked (thus there's some accepts-invalid here which gets fixed).

On the other hand, the actual base-objects in calls were checked to be 
scalar which is wrong.  This is only required when calling NOPASS 
procedures; I did correct this.  However, there turned unfortunatly an 
ICE up when translating such calls for non-scalar base object, thus PR 
41177 is not fully fixed and I added an additional check with a "not 
implemented" message to catch up in that case until the ICE gets fixed, too.

Still I would like to commit this patch as it is right now and think 
this will be already some step in the right direction.

Unfortunatly, the POINTER attribute on CLASS dummies gets always set in 
decl.c:encapsulate_class_symbol; I thus had to introduce a new flag 
storing the original value in this case for my check -- this is what 
Janus also suggested.  But if someone else can come up with a nicer 
solution, I'd be happy to implement it.

I'm still building the patch after a SVN update and will then regression 
test on GNU/Linux-x86-32.  Ok for trunk if no failures?

Yours,
Daniel

-- 
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

[-- Attachment #2: patch.changelog --]
[-- Type: text/plain, Size: 706 bytes --]

2008-11-29  Daniel Kraft  <d@domob.eu>

	PR fortran/41177
	* gfortran.dg/typebound_proc_4.f03: Remove check for wrong error.
	* gfortran.dg/typebound_proc_13.f03: New test.

2008-11-29  Daniel Kraft  <d@domob.eu>

	PR fortran/41177
	* gfortran.h (struct symbol_attribute): New flag `class_pointer'.
	* decl.c (encapsulate_class_symbol): Set the new flag.
	* resolve.c (update_compcall_arglist): Remove wrong check for
	non-scalar base-object.
	(check_typebound_baseobject): Add the correct version here as well
	as some 'not implemented' message check in the old case.
	(resolve_typebound_procedure): Check that the passed-object dummy
	argument is scalar, non-pointer and non-allocatable as it should be.

[-- Attachment #3: patch.diff --]
[-- Type: text/plain, Size: 5870 bytes --]

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 154741)
+++ gcc/fortran/decl.c	(working copy)
@@ -1075,6 +1075,7 @@ encapsulate_class_symbol (gfc_typespec *
       c->ts.type = BT_DERIVED;
       c->attr.access = ACCESS_PRIVATE;
       c->ts.u.derived = ts->u.derived;
+      c->attr.class_pointer = attr->pointer;
       c->attr.pointer = attr->pointer || attr->dummy;
       c->attr.allocatable = attr->allocatable;
       c->attr.dimension = attr->dimension;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 154741)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -654,6 +654,11 @@ typedef struct
     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
     implied_index:1, subref_array_pointer:1, proc_pointer:1;
 
+  /* For CLASS containers, the pointer attribute is sometimes set internally
+     even though it was not directly specified.  In this case, keep the
+     "real" (original) value here.  */
+  unsigned class_pointer:1;
+
   ENUM_BITFIELD (save_state) save:2;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 154741)
+++ gcc/fortran/resolve.c	(working copy)
@@ -4781,12 +4781,6 @@ update_compcall_arglist (gfc_expr* e)
   if (!po)
     return FAILURE;
 
-  if (po->rank > 0)
-    {
-      gfc_error ("Passed-object at %L must be scalar", &e->where);
-      return FAILURE;
-    }
-
   if (tbp->nopass || e->value.compcall.ignore_pass)
     {
       gfc_free_expr (po);
@@ -4889,6 +4883,22 @@ check_typebound_baseobject (gfc_expr* e)
       return FAILURE;
     }
 
+  /* If the procedure called is NOPASS, the base object must be scalar.  */
+  if (e->value.compcall.tbp->nopass && base->rank > 0)
+    {
+      gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
+		 " be scalar", &e->where);
+      return FAILURE;
+    }
+
+  /* FIXME: Remove once PR 41177 (this problem) is fixed completely.  */
+  if (base->rank > 0)
+    {
+      gfc_error ("Non-scalar base object at %L currently not implemented",
+		 &e->where);
+      return FAILURE;
+    }
+
   return SUCCESS;
 }
 
@@ -9938,8 +9948,11 @@ resolve_typebound_procedure (gfc_symtree
 	  me_arg = proc->formal->sym;
 	}
 
-      /* Now check that the argument-type matches.  */
+      /* Now check that the argument-type matches and the passed-object
+	 dummy argument is generally fine.  */
+
       gcc_assert (me_arg);
+
       if (me_arg->ts.type != BT_CLASS)
 	{
 	  gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
@@ -9955,7 +9968,27 @@ resolve_typebound_procedure (gfc_symtree
 		     me_arg->name, &where, resolve_bindings_derived->name);
 	  goto error;
 	}
-
+  
+      gcc_assert (me_arg->ts.type == BT_CLASS);
+      if (me_arg->ts.u.derived->components->as
+	  && me_arg->ts.u.derived->components->as->rank > 0)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
+		     " scalar", proc->name, &where);
+	  goto error;
+	}
+      if (me_arg->ts.u.derived->components->attr.allocatable)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be ALLOCATABLE", proc->name, &where);
+	  goto error;
+	}
+      if (me_arg->ts.u.derived->components->attr.class_pointer)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be POINTER", proc->name, &where);
+	  goto error;
+	}
     }
 
   /* If we are extending some type, check that we don't override a procedure
Index: gcc/testsuite/gfortran.dg/typebound_proc_13.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_13.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_proc_13.f03	(revision 0)
@@ -0,0 +1,48 @@
+! { dg-do compile }
+
+! PR fortran/41177
+! Test for additional errors with type-bound procedure bindings.
+! Namely that non-scalar base objects are rejected for TBP calls which are
+! NOPASS, and that passed-object dummy arguments must be scalar, non-POINTER
+! and non-ALLOCATABLE.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS :: myproc
+  END TYPE t
+
+  TYPE t2
+  CONTAINS
+    PROCEDURE, PASS :: nonscalar ! { dg-error "must be scalar" }
+    PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
+    PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
+  END TYPE t2
+
+CONTAINS
+
+  SUBROUTINE myproc ()
+  END SUBROUTINE myproc
+
+  SUBROUTINE nonscalar (me)
+    CLASS(t2), INTENT(IN) :: me(:)
+  END SUBROUTINE nonscalar
+
+  SUBROUTINE is_pointer (me)
+    CLASS(t2), POINTER, INTENT(IN) :: me
+  END SUBROUTINE is_pointer
+
+  SUBROUTINE is_allocatable (me)
+    CLASS(t2), ALLOCATABLE, INTENT(IN) :: me
+  END SUBROUTINE is_allocatable
+
+  SUBROUTINE test ()
+    TYPE(t) :: arr(2)
+    CALL arr%myproc () ! { dg-error "must be scalar" }
+  END SUBROUTINE test
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/typebound_call_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_call_4.f03	(revision 154741)
+++ gcc/testsuite/gfortran.dg/typebound_call_4.f03	(working copy)
@@ -37,10 +37,6 @@ CONTAINS
     CALL arr(1)%myobj%proc ()
     WRITE (*,*) arr(2)%myobj%func ()
 
-    ! Base-object must be scalar.
-    CALL arr(:)%myobj%proc () ! { dg-error "scalar" }
-    WRITE (*,*) arr(:)%myobj%func () ! { dg-error "scalar" }
-
     ! Can't CALL a function or take the result of a SUBROUTINE.
     CALL arr(1)%myobj%func () ! { dg-error "SUBROUTINE" }
     WRITE (*,*) arr(2)%myobj%proc () ! { dg-error "FUNCTION" }

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Daniel Kraft]

Daniel Kraft wrote:
> Hi all,
> 
> this patch is some take in the direction of PR 41177.  It adds checks 
> that the passed-object dummy argument of a type-bound procedure must be 
> scalar, non-POINTER and non-ALLOCATABLE which is at the moment simply 
> overlooked (thus there's some accepts-invalid here which gets fixed).
> 
> On the other hand, the actual base-objects in calls were checked to be 
> scalar which is wrong.  This is only required when calling NOPASS 
> procedures; I did correct this.  However, there turned unfortunatly an 
> ICE up when translating such calls for non-scalar base object, thus PR 
> 41177 is not fully fixed and I added an additional check with a "not 
> implemented" message to catch up in that case until the ICE gets fixed, 
> too.
> 
> Still I would like to commit this patch as it is right now and think 
> this will be already some step in the right direction.
> 
> Unfortunatly, the POINTER attribute on CLASS dummies gets always set in 
> decl.c:encapsulate_class_symbol; I thus had to introduce a new flag 
> storing the original value in this case for my check -- this is what 
> Janus also suggested.  But if someone else can come up with a nicer 
> solution, I'd be happy to implement it.
> 
> I'm still building the patch after a SVN update and will then regression 
> test on GNU/Linux-x86-32.  Ok for trunk if no failures?

Build and regtest was successful.


-- 
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Paul Richard Thomas]

Daniel,

Since this improves the firewall between OOP and f95, I think that
this patch should be applied to trunk.  The fact that it fixes a bug
as well is a bonus!

Paul

On Mon, Nov 30, 2009 at 3:05 PM, Daniel Kraft <d@domob.eu> wrote:
> Daniel Kraft wrote:
>>
>> Hi all,
>>
>> this patch is some take in the direction of PR 41177.  It adds checks that
>> the passed-object dummy argument of a type-bound procedure must be scalar,
>> non-POINTER and non-ALLOCATABLE which is at the moment simply overlooked
>> (thus there's some accepts-invalid here which gets fixed).
>>
>> On the other hand, the actual base-objects in calls were checked to be
>> scalar which is wrong.  This is only required when calling NOPASS
>> procedures; I did correct this.  However, there turned unfortunatly an ICE
>> up when translating such calls for non-scalar base object, thus PR 41177 is
>> not fully fixed and I added an additional check with a "not implemented"
>> message to catch up in that case until the ICE gets fixed, too.
>>
>> Still I would like to commit this patch as it is right now and think this
>> will be already some step in the right direction.
>>
>> Unfortunatly, the POINTER attribute on CLASS dummies gets always set in
>> decl.c:encapsulate_class_symbol; I thus had to introduce a new flag storing
>> the original value in this case for my check -- this is what Janus also
>> suggested.  But if someone else can come up with a nicer solution, I'd be
>> happy to implement it.
>>
>> I'm still building the patch after a SVN update and will then regression
>> test on GNU/Linux-x86-32.  Ok for trunk if no failures?
>
> Build and regtest was successful.
>
>
> --
> Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
> To go: Hea-Kni-Mon-Pri
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Daniel Kraft]

Paul Richard Thomas wrote:
> Since this improves the firewall between OOP and f95, I think that
> this patch should be applied to trunk.  The fact that it fixes a bug
> as well is a bonus!

So is this an ok?

BTW, Dominique told me my patch does not apply on top of yours because 
you apparently moved the encapsulate_class_symbol block somewhere or the 
like...  But I hope this will be easy to fix for you.

Yours,
Daniel

-- 
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Paul Richard Thomas]

Daniel,

> So is this an ok?

It's an OK from me, I am just aware that at this stage, you should
seek a "green" from the release manager(s).

Cheers

Paul

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Richard Guenther]

On Tue, Dec 1, 2009 at 12:40 PM, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Daniel,
>
>> So is this an ok?
>
> It's an OK from me, I am just aware that at this stage, you should
> seek a "green" from the release manager(s).

Fortran is not release critical, so we defer to fortran maintainers.

Richard.

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Paul Richard Thomas]

Dear Richard,

Thanks for clarifying that yet again.  We are trying to abide by the
rules but this is made very difficult by gfortran being maintained
entirely by volunteers; ie. we cannot easily depend on deadlines being
met because the effort cannot be guaranteed.  If it's OK with you, we
will keep touching base to make sure that our input is not untimely.

Cheers

Paul

On Tue, Dec 1, 2009 at 12:41 PM, Richard Guenther
<richard.guenther@gmail.com> wrote:
> On Tue, Dec 1, 2009 at 12:40 PM, Paul Richard Thomas
> <paul.richard.thomas@gmail.com> wrote:
>> Daniel,
>>
>>> So is this an ok?
>>
>> It's an OK from me, I am just aware that at this stage, you should
>> seek a "green" from the release manager(s).
>
> Fortran is not release critical, so we defer to fortran maintainers.
>
> Richard.
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Daniel Kraft]

Paul Richard Thomas wrote:
> Daniel,
> 
>> So is this an ok?
> 
> It's an OK from me, I am just aware that at this stage, you should
> seek a "green" from the release manager(s).

Committed as revision 155086 with this ok and the other positive 
reactions (after yet another svn up and bootstrap / test).

Daniel

-- 
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

Re: [Patch, Fortran] PR 41177: Some corrections on base-object checks with type-bound procedures.

[Daniel Kraft]

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

Daniel Kraft wrote:
> Hi all,
> 
> this patch is some take in the direction of PR 41177.  It adds checks 
> that the passed-object dummy argument of a type-bound procedure must be 
> scalar, non-POINTER and non-ALLOCATABLE which is at the moment simply 
> overlooked (thus there's some accepts-invalid here which gets fixed).
> 
> On the other hand, the actual base-objects in calls were checked to be 
> scalar which is wrong.  This is only required when calling NOPASS 
> procedures; I did correct this.  However, there turned unfortunatly an 
> ICE up when translating such calls for non-scalar base object, thus PR 
> 41177 is not fully fixed and I added an additional check with a "not 
> implemented" message to catch up in that case until the ICE gets fixed, 
> too.
> 
> Still I would like to commit this patch as it is right now and think 
> this will be already some step in the right direction.
> 
> Unfortunatly, the POINTER attribute on CLASS dummies gets always set in 
> decl.c:encapsulate_class_symbol; I thus had to introduce a new flag 
> storing the original value in this case for my check -- this is what 
> Janus also suggested.  But if someone else can come up with a nicer 
> solution, I'd be happy to implement it.
> 
> I'm still building the patch after a SVN update and will then regression 
> test on GNU/Linux-x86-32.  Ok for trunk if no failures?

here's an updated patch that fixes the conflict introduced by Janus' 
merge with my patch.  It just did bootstrap fine and is regtesting at 
the moment again.

With the positive feedback I already got, I'm planning to commit this 
tomorrow if no failures pop up; but feel free to give any comments about 
it until then!

Yours,
Daniel

-- 
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

[-- Attachment #2: patch.changelog --]
[-- Type: text/plain, Size: 706 bytes --]

2008-12-03  Daniel Kraft  <d@domob.eu>

	PR fortran/41177
	* gfortran.dg/typebound_proc_4.f03: Remove check for wrong error.
	* gfortran.dg/typebound_proc_13.f03: New test.

2008-12-03  Daniel Kraft  <d@domob.eu>

	PR fortran/41177
	* gfortran.h (struct symbol_attribute): New flag `class_pointer'.
	* symbol.c (gfc_build_class_symbol): Set the new flag.
	* resolve.c (update_compcall_arglist): Remove wrong check for
	non-scalar base-object.
	(check_typebound_baseobject): Add the correct version here as well
	as some 'not implemented' message check in the old case.
	(resolve_typebound_procedure): Check that the passed-object dummy
	argument is scalar, non-pointer and non-allocatable as it should be.

[-- Attachment #3: patch.diff --]
[-- Type: text/plain, Size: 6224 bytes --]

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 154941)
+++ gcc/fortran/symbol.c	(working copy)
@@ -4681,6 +4681,7 @@ gfc_build_class_symbol (gfc_typespec *ts
       c->ts.type = BT_DERIVED;
       c->attr.access = ACCESS_PRIVATE;
       c->ts.u.derived = ts->u.derived;
+      c->attr.class_pointer = attr->pointer;
       c->attr.pointer = attr->pointer || attr->dummy;
       c->attr.allocatable = attr->allocatable;
       c->attr.dimension = attr->dimension;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 154941)
+++ gcc/fortran/decl.c	(working copy)
@@ -1025,7 +1025,6 @@ verify_c_interop_param (gfc_symbol *sym)
 }
 
 
-
 /* Function called by variable_decl() that adds a name to the symbol table.  */
 
 static gfc_try
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 154941)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -654,6 +654,11 @@ typedef struct
     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
     implied_index:1, subref_array_pointer:1, proc_pointer:1;
 
+  /* For CLASS containers, the pointer attribute is sometimes set internally
+     even though it was not directly specified.  In this case, keep the
+     "real" (original) value here.  */
+  unsigned class_pointer:1;
+
   ENUM_BITFIELD (save_state) save:2;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 154941)
+++ gcc/fortran/resolve.c	(working copy)
@@ -4781,12 +4781,6 @@ update_compcall_arglist (gfc_expr* e)
   if (!po)
     return FAILURE;
 
-  if (po->rank > 0)
-    {
-      gfc_error ("Passed-object at %L must be scalar", &e->where);
-      return FAILURE;
-    }
-
   if (tbp->nopass || e->value.compcall.ignore_pass)
     {
       gfc_free_expr (po);
@@ -4889,6 +4883,22 @@ check_typebound_baseobject (gfc_expr* e)
       return FAILURE;
     }
 
+  /* If the procedure called is NOPASS, the base object must be scalar.  */
+  if (e->value.compcall.tbp->nopass && base->rank > 0)
+    {
+      gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
+		 " be scalar", &e->where);
+      return FAILURE;
+    }
+
+  /* FIXME: Remove once PR 41177 (this problem) is fixed completely.  */
+  if (base->rank > 0)
+    {
+      gfc_error ("Non-scalar base object at %L currently not implemented",
+		 &e->where);
+      return FAILURE;
+    }
+
   return SUCCESS;
 }
 
@@ -10048,8 +10058,11 @@ resolve_typebound_procedure (gfc_symtree
 	  me_arg = proc->formal->sym;
 	}
 
-      /* Now check that the argument-type matches.  */
+      /* Now check that the argument-type matches and the passed-object
+	 dummy argument is generally fine.  */
+
       gcc_assert (me_arg);
+
       if (me_arg->ts.type != BT_CLASS)
 	{
 	  gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
@@ -10065,7 +10078,27 @@ resolve_typebound_procedure (gfc_symtree
 		     me_arg->name, &where, resolve_bindings_derived->name);
 	  goto error;
 	}
-
+  
+      gcc_assert (me_arg->ts.type == BT_CLASS);
+      if (me_arg->ts.u.derived->components->as
+	  && me_arg->ts.u.derived->components->as->rank > 0)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
+		     " scalar", proc->name, &where);
+	  goto error;
+	}
+      if (me_arg->ts.u.derived->components->attr.allocatable)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be ALLOCATABLE", proc->name, &where);
+	  goto error;
+	}
+      if (me_arg->ts.u.derived->components->attr.class_pointer)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be POINTER", proc->name, &where);
+	  goto error;
+	}
     }
 
   /* If we are extending some type, check that we don't override a procedure
Index: gcc/testsuite/gfortran.dg/typebound_proc_13.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_13.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_proc_13.f03	(revision 0)
@@ -0,0 +1,48 @@
+! { dg-do compile }
+
+! PR fortran/41177
+! Test for additional errors with type-bound procedure bindings.
+! Namely that non-scalar base objects are rejected for TBP calls which are
+! NOPASS, and that passed-object dummy arguments must be scalar, non-POINTER
+! and non-ALLOCATABLE.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS :: myproc
+  END TYPE t
+
+  TYPE t2
+  CONTAINS
+    PROCEDURE, PASS :: nonscalar ! { dg-error "must be scalar" }
+    PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
+    PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
+  END TYPE t2
+
+CONTAINS
+
+  SUBROUTINE myproc ()
+  END SUBROUTINE myproc
+
+  SUBROUTINE nonscalar (me)
+    CLASS(t2), INTENT(IN) :: me(:)
+  END SUBROUTINE nonscalar
+
+  SUBROUTINE is_pointer (me)
+    CLASS(t2), POINTER, INTENT(IN) :: me
+  END SUBROUTINE is_pointer
+
+  SUBROUTINE is_allocatable (me)
+    CLASS(t2), ALLOCATABLE, INTENT(IN) :: me
+  END SUBROUTINE is_allocatable
+
+  SUBROUTINE test ()
+    TYPE(t) :: arr(2)
+    CALL arr%myproc () ! { dg-error "must be scalar" }
+  END SUBROUTINE test
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/typebound_call_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_call_4.f03	(revision 154941)
+++ gcc/testsuite/gfortran.dg/typebound_call_4.f03	(working copy)
@@ -37,10 +37,6 @@ CONTAINS
     CALL arr(1)%myobj%proc ()
     WRITE (*,*) arr(2)%myobj%func ()
 
-    ! Base-object must be scalar.
-    CALL arr(:)%myobj%proc () ! { dg-error "scalar" }
-    WRITE (*,*) arr(:)%myobj%func () ! { dg-error "scalar" }
-
     ! Can't CALL a function or take the result of a SUBROUTINE.
     CALL arr(1)%myobj%func () ! { dg-error "SUBROUTINE" }
     WRITE (*,*) arr(2)%myobj%proc () ! { dg-error "FUNCTION" }