[gcc r17-3327] fortran: Make IS_CONTIGUOUS true for assumed-rank scalars [PR126895]

https://gcc.gnu.org/g:f566fd3c966da60a1cc7db15e0a17e926325949c

commit r17-3327-gf566fd3c966da60a1cc7db15e0a17e926325949c
Author: Mikael Morin <[email protected]>
Date:   Sat Aug 15 21:54:06 2026 +0200

    fortran: Make IS_CONTIGUOUS true for assumed-rank scalars [PR126895]
    
    If the argument to IS_CONTIGUOUS is an assumed-rank variable, add a
    condition making the intrinsic return true if the variable rank is zero at
    execution time.  With the testcase, the function returned false despite the
    rank, because the check of the span against the element size, that compared
    unequal, was not guarded by a rank check.
    
            PR fortran/126895
    
    gcc/fortran/ChangeLog:
    
            * trans-intrinsic.cc (gfc_conv_is_contiguous_expr): If the argument
            to IS_CONTIGUOUS is an assumed-rank variable, add a conditional
            making the value true if the runtime rank is zero.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/is_contiguous_7.f90: New test.

Diff:
---
 gcc/fortran/trans-intrinsic.cc                |  9 +++++++++
 gcc/testsuite/gfortran.dg/is_contiguous_7.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 35 insertions(+)

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 69a6034b3d38..31d81e517e72 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2400,6 +2400,15 @@ gfc_conv_is_contiguous_expr (gfc_se *se, gfc_expr *arg)
 				  convert (boolean_type_node, se->expr));
     }
 
+  if (as && as->type == AS_ASSUMED_RANK)
+    {
+      tree rank = gfc_conv_descriptor_rank_get (desc);
+      tree scalar = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				     rank, gfc_rank_cst[0]);
+      se->expr = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+				  TREE_TYPE (se->expr), scalar, se->expr);
+    }
+
   gfc_free_ss_chain (ss);
 }
 
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_7.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_7.f90
new file mode 100644
index 000000000000..806f1f318744
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_7.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/126895
+! The IS_CONTIGUOUS intrinsic used to erroneously return FALSE for pointer
+! assumed-rank dummies associated with a scalar value.
+
+program prog
+  implicit none
+  type :: t
+    integer :: c1
+  end type
+  type, extends(t) :: u
+    integer :: c2
+  end type
+  type(t), target :: x
+  type(u), target :: y
+  call s1(x, 1)
+  call s1(y, 2)
+contains
+  subroutine s1(a, e)
+    class(t), pointer, intent(in) :: a(..)
+    integer, value :: e
+    !print *, is_contiguous(a)
+    if (.not. is_contiguous(a)) error stop e
+  end subroutine
+end program