From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 13 Mar 2019 21:33:27 +0000 (+0000)
Subject: re PR fortran/87045 (pointer to array of character)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=edaff7c9448c4e4bdc4e4a42f5813ee543a1df31;p=gcc.git

re PR fortran/87045 (pointer to array of character)

2019-03-13  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/87045
	* trans-expr.c (gfc_trans_pointer_assignment): Move check for same
	string length so that we do not get false errors for deferred
	length.

	PR fortran/87045
	* gfortran.dg/pr87045.f90: New test.

From-SVN: r269664
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 281c29f0a66..8264e59d931 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-03-13  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/87045
+	* trans-expr.c (gfc_trans_pointer_assignment): Move check for same
+	string length so that we do not get false errors for deferred
+	length.
+
 2019-03-13  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/89601
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9019c558915..9575f391abd 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9278,16 +9278,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	    }
 	}
 
-      /* Check string lengths if applicable.  The check is only really added
-	 to the output code if -fbounds-check is enabled.  */
-      if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
-	{
-	  gcc_assert (expr2->ts.type == BT_CHARACTER);
-	  gcc_assert (strlen_lhs && strlen_rhs);
-	  gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
-				       strlen_lhs, strlen_rhs, &block);
-	}
-
       /* If rank remapping was done, check with -fcheck=bounds that
 	 the target is at least as large as the pointer.  */
       if (rank_remap && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
@@ -9322,6 +9312,16 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
 	}
 
+      /* Check string lengths if applicable.  The check is only really added
+	 to the output code if -fbounds-check is enabled.  */
+      if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
+	{
+	  gcc_assert (expr2->ts.type == BT_CHARACTER);
+	  gcc_assert (strlen_lhs && strlen_rhs);
+	  gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
+				       strlen_lhs, strlen_rhs, &block);
+	}
+
       gfc_add_block_to_block (&block, &lse.post);
       if (rank_remap)
 	gfc_add_block_to_block (&block, &rse.post);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f4d25f1e567..b7550a2c170 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-03-13  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/87045
+	* gfortran.dg/pr87045.f90: New test.
+
 2019-03-13  Vladimir Makarov  <vmakarov@redhat.com>
 
 	PR target/85860
diff --git a/gcc/testsuite/gfortran.dg/pr87045.f90 b/gcc/testsuite/gfortran.dg/pr87045.f90
new file mode 100644
index 00000000000..46b11f9112f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr87045.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds" }
+!
+! PR fortran/87045 - pointer to array of character
+! Contributed by Valery Weber
+! This used to give an invalid run-time error
+
+program test
+  character(:), dimension(:), allocatable, target :: t
+  character(:), pointer, dimension(:) :: p
+  allocate( character(3) :: t(2) )
+  t(1) = "abc"
+  t(2) = "123"
+  p => t
+  if (size (p) /= 2) stop 1
+  if (len  (p) /= 3) stop 2
+  if (p(1) /= "abc") stop 3
+  if (p(2) /= "123") stop 4
+end program test