re PR fortran/82173 ([meta-bug] Parameterized derived type errors)

2017-09-13  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/82173
	* gfortran.dg/pdt_10.f03 : New test.

From-SVN: r252734

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4db5051e0edf9a48e71a6c125cdc7e8431b1dc4d..885fd06ef44c3d15d70cc23c2c436a6641206f24 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2017-09-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <pault@gcc.gnu.org>
 
        PR fortran/82173

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6e78d0d0e495ac65b5402a004c217b9022837f1f..f6e0a7f528fcace518412b979ecb406d2135575f 100644 (file)
--- 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 7fb8ec16b8e5562dbbf2eac2ce5ce7f3ef733155..c37d233806c9466b34756b771479f1b6d9e2ff72 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-09-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/82173
+       * gfortran.dg/pdt_10.f03 : New test.
+
 2017-09-13  Paolo Carlini  <paolo.carlini@oracle.com>
 
        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 (file)
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