aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog12
-rw-r--r--gcc/fortran/expr.c81
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f9015
4 files changed, 73 insertions, 40 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04eade5..0ea79f3 100644
--- 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 6cea5b0..f4880a4 100644
--- 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 7889c08..687d700 100644
--- 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
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
generated by cgit v1.1 at 2025-05-24 23:20:32 +0000