From patchwork Fri Oct 8 16:58:22 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 46015 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D7E9D3858012 for ; Fri, 8 Oct 2021 16:58:57 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 566793858D39; Fri, 8 Oct 2021 16:58:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 566793858D39 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: GdV7ikY4oao6E0r401U4siCP4ZXozmEBEy7bPUm3NCciTYHQRVGUMi6C5jwVNXE5J8VKeQoYA3 zwYRLb7c5kZQit7Zi47/hod9LN+0mNo3fMPxGuaSqINuFwRICH3hcqDwpF1AhiwRkirsN3iBfF 3/KeGkktp/3ARGogsT5/9nz7YLgLj+fbx+QcrO3IBGsxxC+yJjpfnPDlsc7FAfSaiiLdgxvn8K BlRQkumT8taaCMSvOKpKIZwIsPf1v8PHwW6BMMwt1v/MY70VH25Be7rYaqthBtaUt7jMsTloem hyQ0ccR/Gs9jP3ORNAsTuKai X-IronPort-AV: E=Sophos;i="5.85,358,1624348800"; d="scan'208";a="66915330" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 08 Oct 2021 08:58:30 -0800 IronPort-SDR: dlrXJqDeNcu3lABiizJ/1I2Hf1AWOj18KJHttxxN+m+DaybXIN4e9gLT0/CKZSj6ox64lxAOqn 56gkOkCT7a1cE2p/ugPzjHABuoEtPtwGoCa3GDQVdhTn9xjQ/v+hmQJcADxRnAQVFzBe4qos+S vXxuKHMffePJRzap71gQSIyLvexugtH28Kv+WkJoaOTHP2fL7tH2F6Bm0FF+AutC9CyJn/LWA/ WtC1r2JwQ6cMS7InP4a2P8ST0sLZMzu47Aatpma0t4d8MOczQ3gixalTmnoZrg/zY4YZ2UByix 7XY= Subject: [PATCH v2, Fortran] Add diagnostic for F2018:C839 (TS29113:C535c) To: Tobias Burnus , "fortran@gcc.gnu.org" , "gcc-patches@gcc.gnu.org" References: <93def131-42e3-e90f-3f9b-aebe6db3dcc3@codesourcery.com> <6573e9f9-5a04-6917-4f2a-b9a2dfb278e2@codesourcery.com> From: Sandra Loosemore Message-ID: <0488bc3e-4af9-de24-d902-02169489e6fd@codesourcery.com> Date: Fri, 8 Oct 2021 10:58:22 -0600 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.13.0 MIME-Version: 1.0 In-Reply-To: <6573e9f9-5a04-6917-4f2a-b9a2dfb278e2@codesourcery.com> Content-Language: en-US X-ClientProxiedBy: SVR-ORW-MBX-09.mgc.mentorg.com (147.34.90.209) To svr-orw-mbx-04.mgc.mentorg.com (147.34.90.204) X-Spam-Status: No, score=-8.3 required=5.0 tests=BAYES_00, BODY_8BITS, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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 commit 1beb8cc863225a5f2ba4a52fc3ff1d3320edbfef Author: Sandra Loosemore Date: Mon Sep 27 07:05:32 2021 -0700 Fortran: Add diagnostic for F2018:C839 (TS29113:C535c) 2021-10-08 Sandra Loosemore 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