diff mbox series

[v2,Fortran] Add diagnostic for F2018:C839 (TS29113:C535c)

Message ID 0488bc3e-4af9-de24-d902-02169489e6fd@codesourcery.com
State New
Headers
Series [v2,Fortran] Add diagnostic for F2018:C839 (TS29113:C535c) |

Commit Message

Sandra Loosemore Oct. 8, 2021, 4:58 p.m. UTC 
  On 10/7/21 9:25 AM, Tobias Burnus wrote:
> Hi Sandra,
> 
> On 06.10.21 23:37, Sandra Loosemore wrote:
>> This patch is for PR fortran/54753, to add a diagnostic for violations 
>> of this constraint in the 2018 standard:
>>
>>   C839 If an assumed-size or nonallocatable nonpointer assumed-rank
>>   array is an actual argument that corresponds to a dummy argument that
>>   is an INTENT (OUT) assumed-rank array, it shall not be polymorphic,
>>   finalizable, of a type with an allocatable ultimate component, or of a
>>   type for which default initialization is specified.
>>
>> (It now uses an interface instead of an actual subroutine definition, 
>> since Tobias recently committed a patch to fix interfaces in order to 
>> unblock my work on this one.)  That bug is independent of enforcing 
>> this constraint so I'm planning to open a new issue for it with its 
>> own test case, if there isn't already one in Bugzilla.
> I concur that that should be in a separate PR.

It's PR102641 now.

>> diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
>> ...
>> +  gfc_array_spec *fas, *aas;
>> +  bool pointer_arg, allocatable_arg;;
> Remove either ";" or ";".
>> @@ -3329,13 +3331,48 @@ gfc_compare_actual_formal (gfc_actual_arglist 
>> **ap, gfc_formal_arglist *formal,
>> +      if (a->expr->expr_type != EXPR_VARIABLE)
>> +    {
>> +      aas = NULL;
>> +      pointer_arg = false;
>> +      allocatable_arg = false;
> 
> This code is not generic but rather specific.
> But it is fine as used in the code.
> 
> The question is how to prevent "?" or wrong code for future
> code readers and writers.
>  
> Solution: I think the simplest would be to add a comment.

OK, done.

>> +      if (fas
>> +      && (fas->type == AS_ASSUMED_SHAPE
>> +          || fas->type == AS_DEFERRED
>> +          || (fas->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
>> +      && aas
>> +      && aas->type == AS_ASSUMED_SIZE
>>         && (a->expr->ref == NULL
>>             || (a->expr->ref->type == REF_ARRAY
>>             && a->expr->ref->u.ar.type == AR_FULL)))
> That's old code – but can you adapt it to handle BT_CLASS? I think
> only 'f->sym->attr.pointer' causes the issue as it does not check for
> CLASS_DATA()->attr.class_pointer – and the rest is fine, also because
> of now using 'aas->type' which already encapsulates the classness.

Done.

> Testcase:
> ----------------------
> type t
> end type t
> interface
>    subroutine fc2 (x)
>      import :: t
>      class(t), pointer, intent(in) :: x(..)
>    end
> end interface
> contains
>    subroutine sub1(y)
>      type(t), target :: y(*)
>      call fc2 (y)  ! silently accepted
>    end
> end
> --------------------------

OK, I incorporated that into the existing test case for that issue.

>> +  subroutine test_assumed_size_polymorphic (a1, a2)
>> +    class(t1) :: a1(*), a2(*)
>> +    call poly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
>> +    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
>> +  end subroutine
> Can you also add a call like involving something like:
> a1(5), a2(4:7), a1(:10) or a2(:-5) ? (Here, '(:-5)' is a
> rank-1, size-zero array.)
> 
> Calls with those are valid as those pass the array size alongside.
>  From the patch it looks as if they should just work, but it is
> still good to test this.
> 
>> +  subroutine test_assumed_size_unlimited_polymorphic (a1, a2)
>> +    class(*) :: a1(*), a2(*)
>> +    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
>> +  end subroutine
> Likewise.

This is done too.

> Otherwise, it looks good to me.

OK to commit v2 of the patch (attached)?

-Sandra

Comments

Tobias Burnus Oct. 8, 2021, 7:54 p.m. UTC | #1 
Hi Sandra

On 08.10.21 18:58, Sandra Loosemore wrote:
>> I concur that that should be in a separate PR.
> It's PR102641 now.
Thanks.
> OK to commit v2 of the patch (attached)?

OK – thanks for the patch!

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
diff mbox series

Patch

commit 1beb8cc863225a5f2ba4a52fc3ff1d3320edbfef
Author: Sandra Loosemore <sandra@codesourcery.com>
Date:   Mon Sep 27 07:05:32 2021 -0700

    Fortran: Add diagnostic for F2018:C839 (TS29113:C535c)
    
    2021-10-08 Sandra Loosemore  <sandra@codesourcery.com>
    
            PR fortran/54753
    
    gcc/fortran/
            * interface.c (gfc_compare_actual_formal): Add diagnostic
            for F2018:C839.  Refactor shared code and fix bugs with class
            array info lookup, and extend similar diagnostic from PR94110
            to also cover class types.
    
    gcc/testsuite/
            * gfortran.dg/c-interop/c535c-1.f90: Rewrite and expand.
            * gfortran.dg/c-interop/c535c-2.f90: Remove xfails.
            * gfortran.dg/c-interop/c535c-3.f90: Likewise.
            * gfortran.dg/c-interop/c535c-4.f90: Likewise.
            * gfortran.dg/PR94110.f90: Extend to cover class types.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a2fea0e97b8..2a71da75c72 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3061,6 +3061,8 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
   unsigned long actual_size, formal_size;
   bool full_array = false;
   gfc_array_ref *actual_arr_ref;
+  gfc_array_spec *fas, *aas;
+  bool pointer_dummy, pointer_arg, allocatable_arg;
 
   actual = *ap;
 
@@ -3329,13 +3331,60 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
-      if (f->sym->as
-	  && (f->sym->as->type == AS_ASSUMED_SHAPE
-	      || f->sym->as->type == AS_DEFERRED
-	      || (f->sym->as->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
-	  && a->expr->expr_type == EXPR_VARIABLE
-	  && a->expr->symtree->n.sym->as
-	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
+      /* Class array variables and expressions store array info in a
+	 different place from non-class objects; consolidate the logic
+	 to access it here instead of repeating it below.  Note that
+	 pointer_arg and allocatable_arg are not fully general and are
+	 only used in a specific situation below with an assumed-rank
+	 argument.  */
+      if (f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym))
+	{
+	  gfc_component *classdata = CLASS_DATA (f->sym);
+	  fas = classdata->as;
+	  pointer_dummy = classdata->attr.class_pointer;
+	}
+      else
+	{
+	  fas = f->sym->as;
+	  pointer_dummy = f->sym->attr.pointer;
+	}
+
+      if (a->expr->expr_type != EXPR_VARIABLE)
+	{
+	  aas = NULL;
+	  pointer_arg = false;
+	  allocatable_arg = false;
+	}
+      else if (a->expr->ts.type == BT_CLASS
+	       && a->expr->symtree->n.sym
+	       && CLASS_DATA (a->expr->symtree->n.sym))
+	{
+	  gfc_component *classdata = CLASS_DATA (a->expr->symtree->n.sym);
+	  aas = classdata->as;
+	  pointer_arg = classdata->attr.class_pointer;
+	  allocatable_arg = classdata->attr.allocatable;
+	}
+      else
+	{
+	  aas = a->expr->symtree->n.sym->as;
+	  pointer_arg = a->expr->symtree->n.sym->attr.pointer;
+	  allocatable_arg = a->expr->symtree->n.sym->attr.allocatable;
+	}
+
+      /* F2018:9.5.2(2) permits assumed-size whole array expressions as
+	 actual arguments only if the shape is not required; thus it
+	 cannot be passed to an assumed-shape array dummy.
+	 F2018:15.5.2.(2) permits passing a nonpointer actual to an
+	 intent(in) pointer dummy argument and this is accepted by
+	 the compare_pointer check below, but this also requires shape
+	 information.
+	 There's more discussion of this in PR94110.  */
+      if (fas
+	  && (fas->type == AS_ASSUMED_SHAPE
+	      || fas->type == AS_DEFERRED
+	      || (fas->type == AS_ASSUMED_RANK && pointer_dummy))
+	  && aas
+	  && aas->type == AS_ASSUMED_SIZE
 	  && (a->expr->ref == NULL
 	      || (a->expr->ref->type == REF_ARRAY
 		  && a->expr->ref->u.ar.type == AR_FULL)))
@@ -3346,6 +3395,35 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
+      /* Diagnose F2018 C839 (TS29113 C535c).  Here the problem is
+	 passing an assumed-size array to an INTENT(OUT) assumed-rank
+	 dummy when it doesn't have the size information needed to run
+	 initializers and finalizers.  */
+      if (f->sym->attr.intent == INTENT_OUT
+	  && fas
+	  && fas->type == AS_ASSUMED_RANK
+	  && aas
+	  && ((aas->type == AS_ASSUMED_SIZE
+	       && (a->expr->ref == NULL
+		   || (a->expr->ref->type == REF_ARRAY
+		       && a->expr->ref->u.ar.type == AR_FULL)))
+	      || (aas->type == AS_ASSUMED_RANK
+		  && !pointer_arg
+		  && !allocatable_arg))
+	  && (a->expr->ts.type == BT_CLASS
+	      || (a->expr->ts.type == BT_DERIVED
+		  && (gfc_is_finalizable (a->expr->ts.u.derived, NULL)
+		      || gfc_has_ultimate_allocatable (a->expr)
+		      || gfc_has_default_initializer
+			   (a->expr->ts.u.derived)))))
+	{
+	  if (where)
+	    gfc_error ("Actual argument to assumed-rank INTENT(OUT) "
+		       "dummy %qs at %L cannot be of unknown size",
+		       f->sym->name, where);
+	  return false;
+	}
+
       if (a->expr->expr_type != EXPR_NULL
 	  && compare_pointer (f->sym, a->expr) == 0)
 	{
@@ -3479,7 +3557,7 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && a->expr->expr_type == EXPR_VARIABLE
 	  && a->expr->symtree->n.sym->as
 	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
-	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	  && !(fas && fas->type == AS_ASSUMED_SHAPE))
 	{
 	  if (where)
 	    gfc_error ("Assumed-shape actual argument at %L is "
@@ -3496,7 +3574,7 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 
       if (f->sym->attr.volatile_
 	  && actual_arr_ref && actual_arr_ref->type == AR_SECTION
-	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	  && !(fas && fas->type == AS_ASSUMED_SHAPE))
 	{
 	  if (where)
 	    gfc_error ("Array-section actual argument at %L is "
@@ -3514,8 +3592,8 @@  gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && a->expr->expr_type == EXPR_VARIABLE
 	  && a->expr->symtree->n.sym->attr.pointer
 	  && a->expr->symtree->n.sym->as
-	  && !(f->sym->as
-	       && (f->sym->as->type == AS_ASSUMED_SHAPE
+	  && !(fas
+	       && (fas->type == AS_ASSUMED_SHAPE
 		   || f->sym->attr.pointer)))
 	{
 	  if (where)
diff --git a/gcc/testsuite/gfortran.dg/PR94110.f90 b/gcc/testsuite/gfortran.dg/PR94110.f90
index 9ec70ec857e..4e43332b64e 100644
--- a/gcc/testsuite/gfortran.dg/PR94110.f90
+++ b/gcc/testsuite/gfortran.dg/PR94110.f90
@@ -9,6 +9,16 @@  program asa_p
 
   integer, parameter :: n = 7
 
+  type t
+  end type t
+
+  interface
+    subroutine fc2 (x)
+      import :: t
+      class(t), pointer, intent(in) :: x(..)
+    end subroutine
+  end interface
+
   integer :: p(n)
   integer :: s
 
@@ -84,5 +94,10 @@  contains
     return
   end function sum_p_ar
 
+  subroutine sub1(y)
+    type(t), target :: y(*)
+    call fc2 (y) ! { dg-error "Actual argument for .x. cannot be an assumed-size array" } 
+  end subroutine sub1
+
 end program asa_p
 
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
index b4047139eaf..2158c35be82 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-1.f90
@@ -11,77 +11,154 @@ 
 ! This test file contains tests that are expected to issue diagnostics
 ! for invalid code.
 
-module m
-
+module t
   type :: t1
     integer :: id
     real :: xyz(3)
   end type
+end module  
 
-contains
+module m
+  use t
+
+  ! Assumed-type dummies are (unlimited) polymorphic too, but F2018:C709
+  ! already prohibits them from being declared intent(out).  So we only
+  ! test dummies of class type that are polymorphic or unlimited
+  ! polymorphic.
+  interface
+    subroutine poly (x, y)
+      use t
+      class(t1) :: x(..)
+      class(t1), intent (out) :: y(..)
+    end subroutine
+    subroutine upoly (x, y)
+      class(*) :: x(..)
+      class(*), intent (out) :: y(..)
+    end subroutine
+  end interface
 
-  subroutine s1_nonpolymorphic (x, y)
-    type(t1) :: x(..)
-    type(t1), intent(out) :: y(..)
-  end subroutine
+contains
 
-  subroutine s1_polymorphic (x, y)  ! { dg-bogus "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
-    class(t1) :: x(..)
-    class(t1), intent(out) :: y(..)
+  ! The known-size calls should all be OK as they do not involve
+  ! assumed-size or assumed-rank actual arguments.
+  subroutine test_known_size_nonpolymorphic (a1, a2, n)
+    integer :: n
+    type(t1) :: a1(n,n), a2(n)
+    call poly (a1, a2)
+    call upoly (a1, a2)
   end subroutine
-
-  subroutine s1_unlimited_polymorphic (x, y)  ! { dg-bogus "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
-    class(*) :: x(..)
-    class(*), intent(out) :: y(..)
+  subroutine test_known_size_polymorphic (a1, a2, n)
+    integer :: n
+    class(t1) :: a1(n,n), a2(n)
+    call poly (a1, a2)
+    call upoly (a1, a2)
   end subroutine
-
-  ! These calls should all be OK as they do not involve assumed-size or
-  ! assumed-rank actual arguments.
-  subroutine test_known_size (a1, a2, n)
+  subroutine test_known_size_unlimited_polymorphic (a1, a2, n)
     integer :: n
-    type(t1) :: a1(n,n), a2(n)
+    class(*) :: a1(n,n), a2(n)
+    call upoly (a1, a2)
+  end subroutine
 
-    call s1_nonpolymorphic (a1, a2)
-    call s1_polymorphic (a1, a2)
-    call s1_unlimited_polymorphic (a1, a2)
+  ! Likewise passing a scalar as the assumed-rank argument.
+  subroutine test_scalar_nonpolymorphic (a1, a2)
+    type(t1) :: a1, a2
+    call poly (a1, a2)
+    call upoly (a1, a2)
+  end subroutine
+  subroutine test_scalar_polymorphic (a1, a2)
+    class(t1) :: a1, a2
+    call poly (a1, a2)
+    call upoly (a1, a2)
+  end subroutine
+  subroutine test_scalar_unlimited_polymorphic (a1, a2)
+    class(*) :: a1, a2
+    call upoly (a1, a2)
+  end subroutine
+  
+  ! The polymorphic cases for assumed-size are bad.
+  subroutine test_assumed_size_nonpolymorphic (a1, a2)
+    type(t1) :: a1(*), a2(*)
+    call poly (a1, a2)  ! OK
+    call upoly (a1, a2)  ! OK
+  end subroutine
+  subroutine test_assumed_size_polymorphic (a1, a2)
+    class(t1) :: a1(*), a2(*)
+    call poly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+    call poly (a1(5), a2(4:7))
+  end subroutine
+  subroutine test_assumed_size_unlimited_polymorphic (a1, a2)
+    class(*) :: a1(*), a2(*)
+    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
-  ! The calls to the polymorphic functions should be rejected
-  ! with an assumed-size array argument.
-  subroutine test_assumed_size (a1, a2)
+  ! The arguments being passed to poly/upoly in this set are *not*
+  ! assumed size and should not error.
+  subroutine test_not_assumed_size_nonpolymorphic (a1, a2)
     type(t1) :: a1(*), a2(*)
+    call poly (a1(5), a2(4:7))
+    call upoly (a1(5), a2(4:7))
+    call poly (a1(:10), a2(:-5))
+    call upoly (a1(:10), a2(:-5))
+  end subroutine
+  subroutine test_not_assumed_size_polymorphic (a1, a2)
+    class(t1) :: a1(*), a2(*)
+    call poly (a1(5), a2(4:7))
+    call upoly (a1(5), a2(4:7))
+    call poly (a1(:10), a2(:-5))
+    call upoly (a1(:10), a2(:-5))
+  end subroutine
+  subroutine test_not_assumed_size_unlimited_polymorphic (a1, a2)
+    class(*) :: a1(*), a2(*)
+    call upoly (a1(5), a2(4:7))
+    call upoly (a1(:10), a2(:-5))
+  end subroutine
 
-    call s1_nonpolymorphic (a1, a2)
-    call s1_polymorphic (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
-    call s1_unlimited_polymorphic (a1, a2) ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+  ! Polymorphic assumed-rank without pointer/allocatable is also bad.
+  subroutine test_assumed_rank_nonpolymorphic (a1, a2)
+    type(t1) :: a1(..), a2(..)
+    call poly (a1, a2)  ! OK
+    call upoly (a1, a2)  ! OK
+  end subroutine
+  subroutine test_assumed_rank_polymorphic (a1, a2)
+    class(t1) :: a1(..), a2(..)
+    call poly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+  end subroutine
+  subroutine test_assumed_rank_unlimited_polymorphic (a1, a2)
+    class(*) :: a1(..), a2(..)
+    call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
-  ! These calls should be OK.
-  subroutine test_assumed_rank_pointer (a1, a2)
+  ! Pointer/allocatable assumed-rank should be OK.
+  subroutine test_pointer_nonpolymorphic (a1, a2)
     type(t1), pointer :: a1(..), a2(..)
-
-    call s1_nonpolymorphic (a1, a2)
-    call s1_polymorphic (a1, a2)
-    call s1_unlimited_polymorphic (a1, a2)
+    call poly (a1, a2)
+    call upoly (a1, a2)
+  end subroutine
+  subroutine test_pointer_polymorphic (a1, a2)
+    class(t1), pointer :: a1(..), a2(..)
+    call poly (a1, a2)
+    call upoly (a1, a2)
+  end subroutine
+  subroutine test_pointer_unlimited_polymorphic (a1, a2)
+    class(*), pointer :: a1(..), a2(..)
+    call upoly (a1, a2)
   end subroutine
 
-  ! These calls should be OK.
-  subroutine test_assumed_rank_allocatable (a1, a2)
+  subroutine test_allocatable_nonpolymorphic (a1, a2)
     type(t1), allocatable :: a1(..), a2(..)
-
-    call s1_nonpolymorphic (a1, a2)
-    call s1_polymorphic (a1, a2)
-    call s1_unlimited_polymorphic (a1, a2)
+    call poly (a1, a2)
+    call upoly (a1, a2)
   end subroutine
-  
-  ! The calls to the polymorphic functions should be rejected
-  ! with a nonallocatable nonpointer assumed-rank actual argument.
-  subroutine test_assumed_rank_plain (a1, a2)
-    type(t1) :: a1(..), a2(..)
-
-    call s1_nonpolymorphic (a1, a2)
-    call s1_polymorphic (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
-    call s1_unlimited_polymorphic (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+  subroutine test_allocatable_polymorphic (a1, a2)
+    class(t1), allocatable :: a1(..), a2(..)
+    call poly (a1, a2)
+    call upoly (a1, a2)
+  end subroutine
+  subroutine test_allocatable_unlimited_polymorphic (a1, a2)
+    class(*), allocatable :: a1(..), a2(..)
+    call upoly (a1, a2)
   end subroutine
 
 end module
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
index db15ece9809..f232efae9fc 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-2.f90
@@ -45,7 +45,7 @@  contains
   subroutine test_assumed_size (a1, a2)
     type(t1) :: a1(*), a2(*)
     
-    call s1 (a1, a2)  !  { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  !  { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
   ! This call should be OK.
@@ -67,7 +67,7 @@  contains
   subroutine test_assumed_rank_plain (a1, a2)
     type(t1) :: a1(..), a2(..)
 
-    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
 end module
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-3.f90
index 5c224b1f8bd..50840a1ba5f 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-3.f90
@@ -1,6 +1,5 @@ 
 ! PR 54753
 ! { dg-do compile }
-! { dg-ice "pr54753" }
 !
 ! TS 29113
 ! C535c If an assumed-size or nonallocatable nonpointer assumed-rank
@@ -45,7 +44,7 @@  contains
   subroutine test_assumed_size (a1, a2)
     type(t1) :: a1(*), a2(*)
     
-    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
   ! This call should be OK.
@@ -67,7 +66,7 @@  contains
   subroutine test_assumed_rank_plain (a1, a2)
     type(t1) :: a1(..), a2(..)
 
-    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
 end module
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535c-4.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535c-4.f90
index ecbb18187dd..dc380baf465 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535c-4.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535c-4.f90
@@ -1,6 +1,5 @@ 
 ! PR 54753
 ! { dg-do compile }
-! { dg-ice "pr54753" }
 !
 ! TS 29113
 ! C535c If an assumed-size or nonallocatable nonpointer assumed-rank
@@ -45,7 +44,7 @@  contains
   subroutine test_assumed_size (a1, a2)
     type(t1) :: a1(*), a2(*)
     
-    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
   ! This call should be OK.
@@ -67,7 +66,7 @@  contains
   subroutine test_assumed_rank_plain (a1, a2)
     type(t1) :: a1(..), a2(..)
 
-    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" "pr54753" { xfail *-*-* } }
+    call s1 (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
   end subroutine
 
 end module