public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH, Fortran] Fixes for F2018 C838 (PR fortran/101334)
@ 2021-09-20  4:01 Sandra Loosemore
  2021-09-20  7:58 ` Tobias Burnus
  2021-09-20 11:34 ` [PATCH, Fortran] Fixes for F2018 C838 (PR fortran/101334) Thomas Koenig
  0 siblings, 2 replies; 5+ messages in thread
From: Sandra Loosemore @ 2021-09-20  4:01 UTC (permalink / raw)
  To: gcc-patches, fortran

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

This patch fixes some bugs in handling of assumed-rank arguments 
revealed by the TS29113 testsuite, allowing xfails to be removed from 
those testcases.  It was previously failing to diagnose an error when 
passing an assumed-rank argument to a procedure via a non-assumed-rank 
dummy, and giving a bogus error when passing one as the first argument 
to the ASSOCIATED intrinsic.  Both fixes turned out to be 1-liners.  OK 
to commit?

-Sandra

[-- Attachment #2: pr101334.patch --]
[-- Type: text/x-patch, Size: 5407 bytes --]

commit b967fe5f88a5245163f235cfa6a5808aa41e88f4
Author: Sandra Loosemore <sandra@codesourcery.com>
Date:   Sun Sep 19 17:32:03 2021 -0700

    Fortran: Fixes for F2018 C838 (PR fortran/101334)
    
    The compiler was failing to diagnose the error required by F2018 C838
    when passing an assumed-rank array argument to a non-assumed-rank dummy.
    It was also incorrectly giving an error for calls to the 2-argument form
    of the ASSOCIATED intrinsic, which is supposed to be permitted by C838.
    
    2021-09-19  Sandra Loosemore  <sandra@codesourcery.com>
    
    	PR fortran/101334
    
    gcc/fortran/
    	* check.c (gfc_check_associated): Allow an assumed-rank
    	array for the pointer argument.
    	* interface.c (compare_parameter): Also give rank mismatch
    	error on assumed-rank array.
    
    gcc/testsuite/
    	* testsuite/gfortran.dg/c-interop/c535b-2.f90: Remove xfails.
    	* testsuite/gfortran.dg/c-interop/c535b-3.f90: Likewise.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 851af1b..f31ad68 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1520,7 +1520,9 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
   t = true;
   if (!same_type_check (pointer, 0, target, 1, true))
     t = false;
-  if (!rank_check (target, 0, pointer->rank))
+  /* F2018 C838 explicitly allows an assumed-rank variable as the first
+     argument of intrinsic inquiry functions.  */
+  if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
     t = false;
   if (target->rank > 0)
     {
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa..f9a7c9c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2634,7 +2634,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 		   && formal->as->type == AS_ASSUMED_SHAPE))
 	  && actual->expr_type != EXPR_NULL)
       || (actual->rank == 0 && formal->attr.dimension
-	  && gfc_is_coindexed (actual)))
+	  && gfc_is_coindexed (actual))
+      /* Assumed-rank actual argument; F2018 C838.  */
+      || actual->rank == -1)
     {
       if (where
 	  && (!formal->attr.artificial || (!formal->maybe_array
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
index 7bff14f..2dafd44 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535b-2.f90
@@ -61,15 +61,14 @@ subroutine test_calls (x, y)
   ! assumed-rank dummies
   call g (x, y)  ! OK
   ! assumed-size dummies
-  call h (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" { xfail *-*-* } }
+  call h (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" }
           y)  ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
   ! assumed-shape dummies
   call i (x, &  ! { dg-error "(A|a)ssumed.rank" }
           y)  ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
  ! fixed-size array dummies
-  call j (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" { xfail *-*-* } }
+  call j (x, &  ! { dg-error "(A|a)ssumed.rank" "pr101334" }
           y)  ! { dg-error "(A|a)ssumed.rank" "pr101337, failure to diagnose both operands" { xfail *-*-*} }
- ! { dg-bogus "Actual argument contains too few elements" "pr101334" { xfail *-*-* } .-2 }
 end subroutine
 
 ! Check that you can't use an assumed-rank array variable in an array
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
index 6427bd6..23862e5 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535b-3.f90
@@ -29,7 +29,7 @@ function test_associated3 (a, b)
   integer, target :: b
   logical :: test_associated3
 
-  test_associated3 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" { xfail *-*-* } }
+  test_associated3 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" }
 end function
 
 function test_associated4 (a, b)
@@ -38,7 +38,7 @@ function test_associated4 (a, b)
   integer, target :: b(:)
   logical :: test_associated4
 
-  test_associated4 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" { xfail *-*-* } }
+  test_associated4 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" }
 end function
 
 function test_associated5 (a, b)
@@ -47,7 +47,7 @@ function test_associated5 (a, b)
   integer, target :: b(20)
   logical :: test_associated5
 
-  test_associated5 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" { xfail *-*-* } }
+  test_associated5 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" }
 end function
 
 function test_associated6 (a, b)
@@ -65,7 +65,7 @@ function test_associated7 (a, b)
   integer, pointer :: b
   logical :: test_associated7
 
-  test_associated7 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" { xfail *-*-* } }
+  test_associated7 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" }
 end function
 
 function test_associated8 (a, b)
@@ -74,6 +74,6 @@ function test_associated8 (a, b)
   integer, pointer :: b(:)
   logical :: test_associated8
 
-  test_associated8 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" { xfail *-*-* } }
+  test_associated8 = associated (a, b) ! { dg-bogus "must be of rank -1" "pr101334" }
 end function
 

^ permalink raw reply	[flat|nested] 5+ messages in thread
end of thread, other threads:[~2021-09-25 15:03 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-20  4:01 [PATCH, Fortran] Fixes for F2018 C838 (PR fortran/101334) Sandra Loosemore
2021-09-20  7:58 ` Tobias Burnus
2021-09-23 19:13   ` [Patch] Fortran: Fix associated intrinsic with assumed rank [PR101334] [was: [PATCH, Fortran] Fixes for F2018 C838 (PR fortran/101334)] Tobias Burnus
2021-09-25 15:03     ` Thomas Koenig
2021-09-20 11:34 ` [PATCH, Fortran] Fixes for F2018 C838 (PR fortran/101334) Thomas Koenig

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