re PR fortran/45424 ([F08] Add IS_CONTIGUOUS intrinsic)

2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Harald Anlauf <anlauf@gmx.de>
	Tobias Burnus <burnus@gcc.gnu.org>

	PR fortran/45424
	* check.c (gfc_check_is_contiguous): New function.
	* expr.c (gfc_is_not_contiguous): New function.
	* gfortran.h (gfc_isym_id): Add GFC_ISYM_IS_CONTIGUOUS.
	Add prototype for gfc_is_not_contiguous.
	* intrinsic.c (do_ts29113_check): Add GFC_ISYM_IS_CONTIGUOUS.
	(add_function): Add is_contiguous.
	* intrinsic.h: Add prototypes for gfc_check_is_contiguous,
	gfc_simplify_is_contiguous and gfc_resolve_is_contiguous.
	* intrinsic.texi: Add IS_CONTIGUOUS.
	* iresolve.c (gfc_resolve_is_contiguous): New function.
	* simplify.c (gfc_simplify_is_contiguous): New function.
	* trans-decl.c (gfor_fncecl_is_contiguous0): New variable.
	(gfc_build_intrinsic_function_decl): Add it.
	* trans-intrinsic.c (gfc_conv_intrinsic_is_contiguous): New
	function.
	(gfc_conv_intrinsic_function): Handle GFC_ISYM_IS_CONTIGUOUS.

2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Harald Anlauf <anlauf@gmx.de>
	Tobias Burnus <burnus@gcc.gnu.org>

	PR fortran/45424
	* Makefile.am: Add intrinsics/is_contiguous.c.
	* Makefile.in: Regenerated.
	* gfortran.map: Add _gfortran_is_contiguous0.
	* intrinsics/is_contiguous.c: New file.
	* libgfortran.h: Add prototype for is_contiguous0.

2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Harald Anlauf <anlauf@gmx.de>
	Tobias Burnus <burnus@gcc.gnu.org>

	* gfortran.dg/is_contiguous_1.f90: New test.
	* gfortran.dg/is_contiguous_2.f90: New test.
	* gfortran.dg/is_contiguous_3.f90: New test.


Co-Authored-By: Harald Anlauf <anlauf@gmx.de>
Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org>

From-SVN: r267657

22 files changed, 461 insertions, 2 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cf869f8..ba95a26 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	Harald Anlauf <anlauf@gmx.de>
+	Tobias Burnus <burnus@gcc.gnu.org>
+
+	PR fortran/45424
+	* check.c (gfc_check_is_contiguous): New function.
+	* expr.c (gfc_is_not_contiguous): New function.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_IS_CONTIGUOUS.
+	Add prototype for gfc_is_not_contiguous.
+	* intrinsic.c (do_ts29113_check): Add GFC_ISYM_IS_CONTIGUOUS.
+	(add_function): Add is_contiguous.
+	* intrinsic.h: Add prototypes for gfc_check_is_contiguous,
+	gfc_simplify_is_contiguous and gfc_resolve_is_contiguous.
+	* intrinsic.texi: Add IS_CONTIGUOUS.
+	* iresolve.c (gfc_resolve_is_contiguous): New function.
+	* simplify.c (gfc_simplify_is_contiguous): New function.
+	* trans-decl.c (gfor_fncecl_is_contiguous0): New variable.
+	(gfc_build_intrinsic_function_decl): Add it.
+	* trans-intrinsic.c (gfc_conv_intrinsic_is_contiguous): New
+	function.
+	(gfc_conv_intrinsic_function): Handle GFC_ISYM_IS_CONTIGUOUS.
+
 2019-01-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/88658
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 10f4f25..c60de6b 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -6500,6 +6500,17 @@ gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name)
 
 
 bool
+gfc_check_is_contiguous (gfc_expr *array)
+{
+  if (!array_check (array, 0))
+    return false;
+
+  return true;
+}
+
+
+
+bool
 gfc_check_isatty (gfc_expr *unit)
 {
   if (unit == NULL)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7d1c65d..cd8d4dd 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -5695,6 +5695,75 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
   return true;
 }
 
+/* Return true if the expression is guaranteed to be non-contiguous,
+   false if we cannot prove anything.  It is probably best to call
+   this after gfc_is_simply_contiguous.  If neither of them returns
+   true, we cannot say (at compile-time).  */
+
+bool
+gfc_is_not_contiguous (gfc_expr *array)
+{
+  int i;
+  gfc_array_ref *ar = NULL;
+  gfc_ref *ref;
+  bool previous_incomplete;
+
+  for (ref = array->ref; ref; ref = ref->next)
+    {
+      /* Array-ref shall be last ref.  */
+
+      if (ar)
+	return true;
+
+      if (ref->type == REF_ARRAY)
+	ar = &ref->u.ar;
+    }
+
+  if (ar == NULL || ar->type != AR_SECTION)
+    return false;
+
+  previous_incomplete = false;
+
+  /* Check if we can prove that the array is not contiguous.  */
+
+  for (i = 0; i < ar->dimen; i++)
+    {
+      mpz_t arr_size, ref_size;
+
+      if (gfc_ref_dimen_size (ar, i, &ref_size, NULL))
+	{
+	  if (gfc_dep_difference (ar->as->lower[i], ar->as->upper[i], &arr_size))
+	    {
+	      /* a(2:4,2:) is known to be non-contiguous, but
+		 a(2:4,i:i) can be contiguous.  */
+	      if (previous_incomplete && mpz_cmp_si (ref_size, 1) != 0)
+		{
+		  mpz_clear (arr_size);
+		  mpz_clear (ref_size);
+		  return true;
+		}
+	      else if (mpz_cmp (arr_size, ref_size) != 0)
+		previous_incomplete = true;
+
+	      mpz_clear (arr_size);
+	    }
+
+	  /* Check for a(::2), i.e. where the stride is not unity.
+	     This is only done if there is more than one element in
+	     the reference along this dimension.  */
+
+	  if (mpz_cmp_ui (ref_size, 1) > 0 && ar->type == AR_SECTION
+	      && ar->dimen_type[i] == DIMEN_RANGE
+	      && ar->stride[i] && ar->stride[i]->expr_type == EXPR_CONSTANT
+	      && mpz_cmp_si (ar->stride[i]->value.integer, 1) != 0)
+	    return true;
+
+	  mpz_clear (ref_size);
+	}
+    }
+  /* We didn't find anything definitive.  */
+  return false;
+}
 
 /* Build call to an intrinsic procedure.  The number of arguments has to be
    passed (rather than ending the list with a NULL value) because we may
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0b28110..e7a9b6f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -487,6 +487,7 @@ enum gfc_isym_id
   GFC_ISYM_IPARITY,
   GFC_ISYM_IRAND,
   GFC_ISYM_ISATTY,
+  GFC_ISYM_IS_CONTIGUOUS,
   GFC_ISYM_IS_IOSTAT_END,
   GFC_ISYM_IS_IOSTAT_EOR,
   GFC_ISYM_ISNAN,
@@ -3205,6 +3206,7 @@ bool gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *, int = 0);
 
 bool is_subref_array (gfc_expr *);
 bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
+bool gfc_is_not_contiguous (gfc_expr *);
 bool gfc_check_init_expr (gfc_expr *);
 
 gfc_expr *gfc_build_conversion (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 2cb7084..8d80869 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -211,6 +211,7 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 	       && specific->id != GFC_ISYM_SIZE
 	       && specific->id != GFC_ISYM_SIZEOF
 	       && specific->id != GFC_ISYM_UBOUND
+	       && specific->id != GFC_ISYM_IS_CONTIGUOUS
 	       && specific->id != GFC_ISYM_C_LOC)
 	{
 	  gfc_error ("Assumed-type argument at %L is not permitted as actual"
@@ -2235,6 +2236,14 @@ add_functions (void)
 
   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
 
+  add_sym_1 ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_is_contiguous, gfc_simplify_is_contiguous,
+	     gfc_resolve_is_contiguous,
+	     ar, BT_REAL, dr, REQUIRED);
+
+  make_generic ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, GFC_STD_F2008);
+
   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
 	     CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
 	     gfc_check_i, gfc_simplify_is_iostat_end, NULL,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 027f16b..0c60dab 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -99,6 +99,7 @@ bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_int (gfc_expr *, gfc_expr *);
 bool gfc_check_intconv (gfc_expr *);
 bool gfc_check_irand (gfc_expr *);
+bool gfc_check_is_contiguous (gfc_expr *);
 bool gfc_check_isatty (gfc_expr *);
 bool gfc_check_isnan (gfc_expr *);
 bool gfc_check_ishft (gfc_expr *, gfc_expr *);
@@ -327,6 +328,7 @@ gfc_expr *gfc_simplify_ifix (gfc_expr *);
 gfc_expr *gfc_simplify_idint (gfc_expr *);
 gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_iparity (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_is_contiguous (gfc_expr *);
 gfc_expr *gfc_simplify_is_iostat_end (gfc_expr *);
 gfc_expr *gfc_simplify_is_iostat_eor (gfc_expr *);
 gfc_expr *gfc_simplify_isnan (gfc_expr *);
@@ -531,6 +533,7 @@ void gfc_resolve_long (gfc_expr *, gfc_expr *);
 void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_iparity (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
+void gfc_resolve_is_contiguous (gfc_expr *, gfc_expr *);
 void gfc_resolve_rank (gfc_expr *, gfc_expr *);
 void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index ae24dc6..e47ee1e 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -195,6 +195,7 @@ Some basic guidelines for editing this document:
 * @code{IOR}:           IOR,       Bitwise logical or
 * @code{IPARITY}:       IPARITY,   Bitwise XOR of array elements
 * @code{IRAND}:         IRAND,     Integer pseudo-random number
+* @code{IS_CONTIGUOUS}:  IS_CONTIGUOUS, Test whether an array is contiguous
 * @code{IS_IOSTAT_END}:  IS_IOSTAT_END, Test for end-of-file value
 * @code{IS_IOSTAT_EOR}:  IS_IOSTAT_EOR, Test for end-of-record value
 * @code{ISATTY}:        ISATTY,    Whether a unit is a terminal device
@@ -8438,6 +8439,55 @@ end program test_irand
 
 
 
+@node IS_CONTIGUOUS
+@section @code{IS_CONTIGUOUS} --- Test whether an array is contiguous
+@fnindex IS_IOSTAT_EOR
+@cindex array, contiguity
+
+@table @asis
+@item @emph{Description}:
+@code{IS_CONTIGUOUS} tests whether an array is contiguous.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = IS_CONTIGUOUS(ARRAY)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of any type.
+@end multitable
+
+@item @emph{Return value}:
+Returns a @code{LOGICAL} of the default kind, which @code{.TRUE.} if
+@var{ARRAY} is contiguous and false otherwise.
+
+@item @emph{Example}:
+@smallexample
+program test
+  integer :: a(10)
+  a = [1,2,3,4,5,6,7,8,9,10]
+  call sub (a)      ! every element, is contiguous
+  call sub (a(::2)) ! every other element, is noncontiguous
+contains
+  subroutine sub (x)
+    integer :: x(:)
+    if (is_contiguous (x)) then
+      write (*,*) 'X is contiguous'
+    else
+      write (*,*) 'X is not contiguous'
+    end if
+  end subroutine sub
+end program test
+@end smallexample
+@end table
+
+
+
 @node IS_IOSTAT_END
 @section @code{IS_IOSTAT_END} --- Test for end-of-file value
 @fnindex IS_IOSTAT_END
@@ -8527,7 +8577,6 @@ END PROGRAM
 @end table
 
 
-
 @node ISATTY
 @section @code{ISATTY} --- Whether a unit is a terminal device.
 @fnindex ISATTY
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index d132f56..135e6bc 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1452,6 +1452,15 @@ gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
 
 
 void
+gfc_resolve_is_contiguous (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = gfc_default_logical_kind;
+  f->value.function.name = gfc_get_string ("__is_contiguous");
+}
+
+
+void
 gfc_resolve_ishft (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
 {
   f->ts = i->ts;
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index fdaf3cb..90477e5 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -6289,6 +6289,18 @@ do_xor (gfc_expr *result, gfc_expr *e)
 }
 
 
+gfc_expr *
+gfc_simplify_is_contiguous (gfc_expr *array)
+{
+  if (gfc_is_simply_contiguous (array, false, true))
+    return gfc_get_logical_expr (gfc_default_logical_kind, &array->where, 1);
+
+  if (gfc_is_not_contiguous (array))
+    return gfc_get_logical_expr (gfc_default_logical_kind, &array->where, 0);
+    
+  return NULL;
+}
+
 
 gfc_expr *
 gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a51f6a6..c92d891 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -213,6 +213,7 @@ tree gfor_fndecl_size1;
 tree gfor_fndecl_iargc;
 tree gfor_fndecl_kill;
 tree gfor_fndecl_kill_sub;
+tree gfor_fndecl_is_contiguous0;
 
 
 /* Intrinsic functions implemented in Fortran.  */
@@ -3498,6 +3499,12 @@ gfc_build_intrinsic_function_decls (void)
   gfor_fndecl_kill = gfc_build_library_function_decl (
 	get_identifier (PREFIX ("kill")), gfc_int4_type_node,
 	2, gfc_int4_type_node, gfc_int4_type_node);
+
+  gfor_fndecl_is_contiguous0 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("is_contiguous0")), ".R",
+	gfc_int4_type_node, 1, pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_is_contiguous0) = 1;
+  TREE_NOTHROW (gfor_fndecl_is_contiguous0) = 1;
 }
 
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 96a749e..b997ae5 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2828,6 +2828,79 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
 }
 
 
+static void
+gfc_conv_intrinsic_is_contiguous (gfc_se * se, gfc_expr * expr)
+{
+  gfc_expr *arg;
+  gfc_ss *ss;
+  gfc_se argse;
+  tree desc, tmp, stride, extent, cond;
+  int i;
+  tree fncall0;
+  gfc_array_spec *as;
+
+  arg = expr->value.function.actual->expr;
+
+  if (arg->ts.type == BT_CLASS)
+    gfc_add_class_array_ref (arg);
+
+  ss = gfc_walk_expr (arg);
+  gcc_assert (ss != gfc_ss_terminator);
+  gfc_init_se (&argse, NULL);
+  argse.data_not_needed = 1;
+  gfc_conv_expr_descriptor (&argse, arg);
+
+  as = gfc_get_full_arrayspec_from_expr (arg);
+
+  /* Create:  stride[0] == 1 && stride[1] == extend[0]*stride[0] && ...
+     Note in addition that zero-sized arrays don't count as contiguous.  */
+
+  if (as && as->type == AS_ASSUMED_RANK)
+    {
+      /* Build the call to is_contiguous0.  */
+      argse.want_pointer = 1;
+      gfc_conv_expr_descriptor (&argse, arg);
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      desc = gfc_evaluate_now (argse.expr, &se->pre);
+      fncall0 = build_call_expr_loc (input_location,
+				     gfor_fndecl_is_contiguous0, 1, desc);
+      se->expr = fncall0;
+      se->expr = convert (logical_type_node, se->expr);
+    }
+  else
+    {
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      desc = gfc_evaluate_now (argse.expr, &se->pre);
+  
+      stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[0]);
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      stride, build_int_cst (TREE_TYPE (stride), 1));
+
+      for (i = 0; i < expr->value.function.actual->expr->rank - 1; i++)
+	{
+	  tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
+	  extent = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
+	  extent = fold_build2_loc (input_location, MINUS_EXPR,
+				    gfc_array_index_type, extent, tmp);
+	  extent = fold_build2_loc (input_location, PLUS_EXPR,
+				    gfc_array_index_type, extent,
+				    gfc_index_one_node);
+	  tmp = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[i]);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
+				 tmp, extent);
+	  stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[i+1]);
+	  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 stride, tmp);
+	  cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				  boolean_type_node, cond, tmp);
+	}
+      se->expr = convert (gfc_typenode_for_spec (&expr->ts), cond);
+    }
+}
+
+
 /* Evaluate a single upper or lower bound.  */
 /* TODO: bound intrinsic generates way too much unnecessary code.  */
 
@@ -9731,6 +9804,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_has_intvalue (se, expr, LIBERROR_EOR);
       break;
 
+    case GFC_ISYM_IS_CONTIGUOUS:
+      gfc_conv_intrinsic_is_contiguous (se, expr);
+      break;
+
     case GFC_ISYM_ISNAN:
       gfc_conv_intrinsic_isnan (se, expr);
       break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 409c6ab..e42160b 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -907,6 +907,7 @@ extern GTY(()) tree gfor_fndecl_size1;
 extern GTY(()) tree gfor_fndecl_iargc;
 extern GTY(()) tree gfor_fndecl_kill;
 extern GTY(()) tree gfor_fndecl_kill_sub;
+extern GTY(()) tree gfor_fndecl_is_contiguous0;
 
 /* Implemented in Fortran.  */
 extern GTY(()) tree gfor_fndecl_sc_kind;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c79593d..f512ed1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	Harald Anlauf <anlauf@gmx.de>
+	Tobias Burnus <burnus@gcc.gnu.org>
+
+	* gfortran.dg/is_contiguous_1.f90: New test.
+	* gfortran.dg/is_contiguous_2.f90: New test.
+	* gfortran.dg/is_contiguous_3.f90: New test.
+
 2019-01-07  Marek Polacek  <polacek@redhat.com>
 
 	PR c++/88741 - wrong error with initializer-string.
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_1.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_1.f90
new file mode 100644
index 0000000..ee592f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/45424
+! PR fortran/48820
+!
+! Run-time checks for IS_CONTIGUOUS
+
+implicit none
+integer, pointer :: a(:), b(:,:)
+integer :: i, j, k, s
+
+allocate(a(5), b(10,10))
+
+s = 1
+if (.true. .neqv. is_contiguous (a(::s))) stop 1
+s = 2
+if (.false. .neqv. is_contiguous (a(::s))) stop 2
+i=5; j=7
+if (.true. .neqv. is_contiguous (b(1:i*2,1:j))) stop 3
+if (.false. .neqv. is_contiguous (b(1:i,1:j))) stop 4
+i=5; j=5; s=1
+if (.false. .neqv. is_contiguous (b(i:5:s,i:j*2))) stop 5
+
+! The following test zero-sized arrays. For the standard, they
+! are regarded as noncontiguous. However, gfortran in line with
+! other compilers only checks for the strides and thus prints
+! .true. or .false. depending on this setting.
+
+s = 4
+if (.false. .neqv. is_contiguous (a(2:1:s))) stop 6
+s = 1
+if (.true. .neqv. is_contiguous (a(2:1:s))) stop 7
+end
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_2.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_2.f90
new file mode 100644
index 0000000..210c191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_2.f90
@@ -0,0 +1,47 @@
+! { dg-do  run }
+!
+! PR fortran/45424
+! PR fortran/48820
+!
+! Additional run-time checks for IS_CONTIGUOUS with assumed type/rank
+program is_contiguous_2
+  implicit none
+  real, allocatable :: b(:,:)
+  real, pointer     :: c(:,:)
+  integer, volatile :: k
+  target :: b
+  allocate(b(10,10))
+  k = 2
+  if (fail_ar (b,          .true.) ) stop 1
+  if (fail_ar (b(::1,::1), .true.) ) stop 2
+  if (fail_ar (b(::2,::1), .false.)) stop 3
+  if (fail_ar (b(::1,::2), .false.)) stop 4
+  if (fail_ar (b(:10,:10), .true. )) stop 5
+  if (fail_ar (b(: 9,:10), .false.)) stop 6
+  if (fail_ar (b(2: ,:  ), .false.)) stop 7
+  if (fail_ar (b(:  ,2: ), .true. )) stop 8
+  if (fail_ar (b(k: ,:  ), .false.)) stop 9
+  if (fail_ar (b(:  ,k: ), .true. )) stop 10
+  if (fail_at (b(::1,k: ), .true. )) stop 11
+  if (fail_at (b(::k,k: ), .false.)) stop 12
+  if (fail_at (b(10,k)   , .true. )) stop 13
+  c => b(::1,:)
+  if (fail_ar (c,          .true.) ) stop 14
+  c => b(::2,:)
+  if (fail_ar (c,          .false.)) stop 15
+  associate (d => b(:,2:), e => b(::k,:))
+    if (fail_ar (d,        .true.) ) stop 16
+    if (fail_ar (e,        .false.)) stop 17
+  end associate
+contains
+  pure logical function fail_ar (x, expect) result (fail)
+    real,    dimension(..), intent(in) :: x  ! Assumed rank
+    logical,                intent(in) :: expect
+    fail = is_contiguous (x) .neqv. expect
+  end function fail_ar
+  pure logical function fail_at (x, expect) result (fail)
+    type(*), dimension(..), intent(in) :: x  ! Assumed type/assumed rank
+    logical,                intent(in) :: expect
+    fail = is_contiguous (x) .neqv. expect
+  end function fail_at
+end program
diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_3.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_3.f90
new file mode 100644
index 0000000..e4d2060
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_contiguous_3.f90
@@ -0,0 +1,24 @@
+! { dg-do  run }
+! { dg-additional-options "-fdump-tree-original" }
+! PR 45424 - compile-time simplification of is_contiguous
+program main
+  real, dimension(10,5) :: a
+  character (len=1) :: line
+
+  write (unit=line,fmt='(L1)') is_contiguous(a(4:2,:))
+  if (line /= 'F') stop 1
+
+  write (unit=line,fmt='(L1)') is_contiguous(a(:,2:4))
+  if (line /= 'T') stop 1
+
+  write (unit=line,fmt='(L1)') is_contiguous(a(2:4,3:4))
+  if (line /= 'F') stop 3
+
+  write (unit=line,fmt='(L1)') is_contiguous(a(::2,:))
+  if (line /= 'F') stop 4
+
+  write (unit=line,fmt='(L1)') is_contiguous(a(:,::2))
+  if (line /= 'F') stop 5
+
+end program main
+! { dg-final { scan-tree-dump-not " _gfortran_is_contiguous" "original" } }
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 52d8d1e..eee978f 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,14 @@
+2019-01-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	Harald Anlauf <anlauf@gmx.de>
+	Tobias Burnus <burnus@gcc.gnu.org>
+
+	PR fortran/45424
+	* Makefile.am: Add intrinsics/is_contiguous.c.
+	* Makefile.in: Regenerated.
+	* gfortran.map: Add _gfortran_is_contiguous0.
+	* intrinsics/is_contiguous.c: New file.
+	* libgfortran.h: Add prototype for is_contiguous0.
+
 2019-01-07  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* gfortran.map (GFORTRAN_9): Make GFORTRAN_9 node depend on
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 87000c6..e1d757d9 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -124,6 +124,7 @@ intrinsics/extends_type_of.c \
 intrinsics/fnum.c \
 intrinsics/ierrno.c \
 intrinsics/ishftc.c \
+intrinsics/is_contiguous.c \
 intrinsics/mvbits.c \
 intrinsics/move_alloc.c \
 intrinsics/pack_generic.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 2424f7e..ed8cf4c 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -414,7 +414,7 @@ am__objects_54 = size_from_kind.lo $(am__objects_53)
 am__objects_57 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
 	eoshift2.lo erfc_scaled.lo extends_type_of.lo fnum.lo \
 	ierrno.lo ishftc.lo mvbits.lo move_alloc.lo pack_generic.lo \
-	selected_char_kind.lo size.lo spread_generic.lo \
+	selected_char_kind.lo size.lo is_contiguous.lo spread_generic.lo \
 	string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
 	reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
 	unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
@@ -760,6 +760,7 @@ gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \
 	intrinsics/ierrno.c intrinsics/ishftc.c intrinsics/mvbits.c \
 	intrinsics/move_alloc.c intrinsics/pack_generic.c \
 	intrinsics/selected_char_kind.c intrinsics/size.c \
+	intrinsics/is_contiguous.c \
 	intrinsics/spread_generic.c intrinsics/string_intrinsics.c \
 	intrinsics/rand.c intrinsics/random.c \
 	intrinsics/reshape_generic.c intrinsics/reshape_packed.c \
@@ -2198,6 +2199,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/single.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/size.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/size_from_kind.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/is_contiguous.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sleep.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c10.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c16.Plo@am__quote@
@@ -6318,6 +6320,13 @@ size.lo: intrinsics/size.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o size.lo `test -f 'intrinsics/size.c' || echo '$(srcdir)/'`intrinsics/size.c
 
+is_contiguous.lo: intrinsics/is_contiguous.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT is_contiguous.lo -MD -MP -MF $(DEPDIR)/is_contiguous.Tpo -c -o is_contiguous.lo `test -f 'intrinsics/is_contiguous.c' || echo '$(srcdir)/'`intrinsics/is_contiguous.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/is_contiguous.Tpo $(DEPDIR)/is_contiguous.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='intrinsics/is_contiguous.c' object='is_contiguous.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o is_contiguous.lo `test -f 'intrinsics/is_contiguous.c' || echo '$(srcdir)/'`intrinsics/is_contiguous.c
+
 spread_generic.lo: intrinsics/spread_generic.c
 @am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_generic.lo -MD -MP -MF $(DEPDIR)/spread_generic.Tpo -c -o spread_generic.lo `test -f 'intrinsics/spread_generic.c' || echo '$(srcdir)/'`intrinsics/spread_generic.c
 @am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/spread_generic.Tpo $(DEPDIR)/spread_generic.Plo
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 681f7dd..43b32de 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1518,6 +1518,7 @@ GFORTRAN_9 {
   _gfortran_findloc1_s4;
   _gfortran_findloc2_s1;
   _gfortran_findloc2_s4;
+  _gfortran_is_contiguous0;
   _gfortran_mfindloc0_c16;
   _gfortran_mfindloc0_c4;
   _gfortran_mfindloc0_c8;
diff --git a/libgfortran/intrinsics/is_contiguous.c b/libgfortran/intrinsics/is_contiguous.c
new file mode 100644
index 0000000..eea63a0
--- /dev/null
+++ b/libgfortran/intrinsics/is_contiguous.c
@@ -0,0 +1,49 @@
+/* Implementation of the is_contiguous intrinsic.
+   Copyright (C) 2019 Free Software Foundation, Inc.
+   Contributed by Thomas König <tkoenig@gcc.gnu.org>
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<https://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+
+GFC_LOGICAL_4
+is_contiguous0 (const array_t * const restrict array)
+{
+  index_type dim;
+  index_type n;
+  index_type extent, stride;
+
+  dim = GFC_DESCRIPTOR_RANK (array);
+
+  extent = 1;
+  for (n = 0; n < dim; n++)
+    {
+      stride = GFC_DESCRIPTOR_STRIDE (array, n);
+      if (stride != extent)
+	return 0;
+
+      extent *= GFC_DESCRIPTOR_EXTENT (array, n);
+    }
+
+  return 1;
+}
+iexport(is_contiguous0);
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 6b4775a..433b204 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -1375,6 +1375,11 @@ typedef GFC_ARRAY_DESCRIPTOR (void) array_t;
 extern index_type size0 (const array_t * array); 
 iexport_proto(size0);
 
+/* is_contiguous.c */
+
+extern GFC_LOGICAL_4 is_contiguous0 (const array_t * const restrict array); 
+iexport_proto(is_contiguous0);
+
 /* bounds.c */
 
 extern void bounds_equal_extents (array_t *, array_t *, const char *,