re PR fortran/87881 (gfortran.dg/inquiry_type_ref_(1.f08|3.f90) fail on darwin)

2018-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87881
	* expr.c (find_inquiry_ref): Loop through the inquiry refs in
	case there are two of them.
	(simplify_ref_chain): Return true after a successful call to
	find_inquiry_ref.

2018-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87881
	* gfortran.dg/inquiry_part_ref_4.f90: New test.

From-SVN: r267337

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04eade51b47e219bdcda50add080f06de0b7389f..0ea79f3215e2a3385dfc8d4aa6325568e1ab4048 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/87881
+       * expr.c (find_inquiry_ref): Loop through the inquiry refs in
+       case there are two of them.
+       (simplify_ref_chain): Return true after a successful call to
+       find_inquiry_ref.
+
 2018-12-19  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/87992
@@ -125,7 +133,7 @@
 2018-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/88357
-       * class.c (insert_component_ref): Check for NULL pointer and 
+       * class.c (insert_component_ref): Check for NULL pointer and
        previous error message issued.
        * parse.c (parse_associate): Check for NULL pointer.
        * resolve.c (resolve_assoc_var): Check for NULL pointer.
@@ -2848,7 +2856,7 @@ notice and this notice are preserved.
 2018-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/88357
-       * class.c (insert_component_ref): Check for NULL pointer and 
+       * class.c (insert_component_ref): Check for NULL pointer and
        previous error message issued.
        * parse.c (parse_associate): Check for NULL pointer.
        * resolve.c (resolve_assoc_var): Check for NULL pointer.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6cea5b07393c16a4357f123d32c4ebef6ece4969..f4880a4b8aeb711eea2799f10049faf01123b841 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1730,56 +1730,61 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 
   gfc_resolve_expr (tmp);
 
-  switch (inquiry->u.i)
+  /* In principle there can be more than one inquiry reference.  */
+  for (; inquiry; inquiry = inquiry->next)
     {
-    case INQUIRY_LEN:
-      if (tmp->ts.type != BT_CHARACTER)
-       goto cleanup;
+      switch (inquiry->u.i)
+       {
+       case INQUIRY_LEN:
+         if (tmp->ts.type != BT_CHARACTER)
+           goto cleanup;
 
-      if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
-       goto cleanup;
+         if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
+           goto cleanup;
 
-      if (!tmp->ts.u.cl->length
-         || tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
-       goto cleanup;
+         if (!tmp->ts.u.cl->length
+             || tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+           goto cleanup;
 
-      *newp = gfc_copy_expr (tmp->ts.u.cl->length);
-      break;
+         *newp = gfc_copy_expr (tmp->ts.u.cl->length);
+         break;
 
-    case INQUIRY_KIND:
-      if (tmp->ts.type == BT_DERIVED || tmp->ts.type == BT_CLASS)
-       goto cleanup;
+       case INQUIRY_KIND:
+         if (tmp->ts.type == BT_DERIVED || tmp->ts.type == BT_CLASS)
+           goto cleanup;
 
-      if (!gfc_notify_std (GFC_STD_F2003, "KIND part_ref at %C"))
-       goto cleanup;
+         if (!gfc_notify_std (GFC_STD_F2003, "KIND part_ref at %C"))
+           goto cleanup;
 
-      *newp = gfc_get_int_expr (gfc_default_integer_kind,
-                               NULL, tmp->ts.kind);
-      break;
+         *newp = gfc_get_int_expr (gfc_default_integer_kind,
+                                   NULL, tmp->ts.kind);
+         break;
 
-    case INQUIRY_RE:
-      if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
-       goto cleanup;
+       case INQUIRY_RE:
+         if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
+           goto cleanup;
 
-      if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C"))
-       goto cleanup;
+         if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C"))
+           goto cleanup;
 
-      *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
-      mpfr_set ((*newp)->value.real,
-               mpc_realref (p->value.complex), GFC_RND_MODE);
-      break;
+         *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
+         mpfr_set ((*newp)->value.real,
+                   mpc_realref (p->value.complex), GFC_RND_MODE);
+         break;
 
-    case INQUIRY_IM:
-      if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
-       goto cleanup;
+       case INQUIRY_IM:
+         if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
+           goto cleanup;
 
-      if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C"))
-       goto cleanup;
+         if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C"))
+           goto cleanup;
 
-      *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
-      mpfr_set ((*newp)->value.real,
-               mpc_imagref (p->value.complex), GFC_RND_MODE);
-      break;
+         *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
+         mpfr_set ((*newp)->value.real,
+                   mpc_imagref (p->value.complex), GFC_RND_MODE);
+         break;
+       }
+      tmp = gfc_copy_expr (*newp);
     }
 
   if (!(*newp))
@@ -1970,7 +1975,7 @@ simplify_ref_chain (gfc_ref *ref, int type, gfc_expr **p)
          gfc_replace_expr (*p, newp);
          gfc_free_ref_list ((*p)->ref);
          (*p)->ref = NULL;
-         break;
+         return true;;
 
        default:
          break;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7889c08ef36e114e1a431cb648bb54a80e0c05fa..687d7006badd72e39d08e2cd9a9ad04ff853d8af 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/87881
+       * gfortran.dg/inquiry_part_ref_4.f90: New test.
+
 2018-12-21  Andreas Krebbel  <krebbel@linux.ibm.com>
 
        * gcc.target/s390/vector/fp-signedint-convert-1.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90
new file mode 100644 (file)
index 0000000..f0ae5e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Check the fix for PR87881.
+!
+  complex(8) :: zi = (0,-1_8)
+  character(2) :: chr ='ab'
+  if (zi%re%kind .ne. kind (real (zi))) stop 1
+  if (chr%len%kind .ne. kind (len (chr))) stop 2
+
+! After simplification there should only be the delarations for 'zi' and 'chr'
+
+! { dg-final { scan-tree-dump-times "zi" 1 "original" } }
+! { dg-final { scan-tree-dump-times "chr" 1 "original" } }
+end