From 69597e2f5d15e801cc4911e749a10b718c08fe9d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 21 Dec 2018 19:09:42 +0000 Subject: [PATCH] re PR fortran/87881 (gfortran.dg/inquiry_type_ref_(1.f08|3.f90) fail on darwin) 2018-12-21 Paul Thomas 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 PR fortran/87881 * gfortran.dg/inquiry_part_ref_4.f90: New test. From-SVN: r267337 --- gcc/fortran/ChangeLog | 12 +++- gcc/fortran/expr.c | 81 +++++++++++++----------- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90 | 15 +++++ 4 files changed, 73 insertions(+), 40 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90 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 + + 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 PR fortran/87992 @@ -125,7 +133,7 @@ 2018-12-08 Steven G. Kargl 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 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 + + PR fortran/87881 + * gfortran.dg/inquiry_part_ref_4.f90: New test. + 2018-12-21 Andreas Krebbel * 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 -- 2.7.4