From 87f3a5cfb59347cd794c97c52b075d38dfc9ed48 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Wed, 13 Sep 2017 21:15:26 +0000 Subject: re PR fortran/82173 ([meta-bug] Parameterized derived type errors) 2017-09-13 Paul Thomas PR fortran/82173 * decl.c (match_char_kind): If the kind expression is parameterized, save it in saved_kind_expr and set kind = 0. (gfc_get_pdt_instance): Resolve and simplify before emitting error on expression kind. Insert a missing simplification after insertion of kind expressions. 2017-09-13 Paul Thomas PR fortran/82173 * gfortran.dg/pdt_10.f03 : New test. From-SVN: r252734 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/decl.c | 13 +++++++++++-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/pdt_10.f03 | 30 ++++++++++++++++++++++++++++++ 4 files changed, 55 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pdt_10.f03 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4db5051..885fd06 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2017-09-13 Paul Thomas + + PR fortran/82173 + * decl.c (match_char_kind): If the kind expression is + parameterized, save it in saved_kind_expr and set kind = 0. + (gfc_get_pdt_instance): Resolve and simplify before emitting + error on expression kind. Insert a missing simplification after + insertion of kind expressions. + 2017-09-12 Paul Thomas PR fortran/82173 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 6e78d0d..f6e0a7f 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2884,6 +2884,13 @@ match_char_kind (int * kind, int * is_iso_c) goto no_match; } + if (gfc_derived_parameter_expr (e)) + { + saved_kind_expr = e; + *kind = 0; + return MATCH_YES; + } + fail = gfc_extract_int (e, kind, 1); *is_iso_c = e->ts.is_iso_c; if (fail) @@ -3296,6 +3303,9 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, if (kind_expr) { + /* Try simplification even for LEN expressions. */ + gfc_resolve_expr (kind_expr); + gfc_simplify_expr (kind_expr, 1); /* Variable expressions seem to default to BT_PROCEDURE. TODO find out why this is and fix it. */ if (kind_expr->ts.type != BT_INTEGER @@ -3308,8 +3318,6 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, } tail->expr = gfc_copy_expr (kind_expr); - /* Try simplification even for LEN expressions. */ - gfc_simplify_expr (tail->expr, 1); } if (actual_param) @@ -3453,6 +3461,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, { gfc_expr *e = gfc_copy_expr (c1->kind_expr); gfc_insert_kind_parameter_exprs (e); + gfc_simplify_expr (e, 1); gfc_extract_int (e, &c2->ts.kind); gfc_free_expr (e); if (gfc_validate_kind (c2->ts.type, c2->ts.kind, true) < 0) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7fb8ec1..c37d233 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-09-13 Paul Thomas + + PR fortran/82173 + * gfortran.dg/pdt_10.f03 : New test. + 2017-09-13 Paolo Carlini PR c++/68177 diff --git a/gcc/testsuite/gfortran.dg/pdt_10.f03 b/gcc/testsuite/gfortran.dg/pdt_10.f03 new file mode 100644 index 0000000..2f3194a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_10.f03 @@ -0,0 +1,30 @@ +! { dg-do run } +! +! Fixes problem setting CHARACTER KIND expressions in PDT components +! and resolution of intrinsic functions and numeric expressions. +! +! Contributed by FortranFan on clf thread "Parameterized Derived Types +! make first appearance in gfortran 8.0.0" +! +program p + use, intrinsic :: iso_fortran_env, only : CK => character_kinds + implicit none + character(kind = 4), parameter :: c = 'a' + type :: pdt_t(k,l) + integer, kind :: k = CK(1) + integer, len :: l + character(kind=k,len=l) :: s + end type + type(pdt_t(l=12)) :: foo + type(pdt_t(k = kind (c), l=12)) :: foo_4 + + foo%s = "Hello World!" + if (foo%s .ne. "Hello World!") call abort + if (KIND (foo%s) .ne. 1) call abort + if (len (foo%s) .ne. 12) call abort + + foo_4%s = "Hello World!" + if (foo_4%s .ne. "Hello World!") call abort + if (KIND (foo_4%s) .ne. 1) call abort + if (len (foo_4%s) .ne. 12) call abort +end program -- cgit v1.1