[Patch, Fortran] PR 63363: No diagnostic for passing function as actual argument to KIND

[Janus Weil]

Hi all,

here is a small patch which enhances the diagnostics for the intrinsic
KIND function. Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus



2014-12-22  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/63363
    * check.c (gfc_check_kind): Reject polymorphic and non-data arguments.

2014-12-22  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/63363
    * gfortran.dg/kind_1.f90: New.

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (Revision 219014)
+++ gcc/fortran/check.c (Arbeitskopie)
@@ -2531,13 +2531,20 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig,
 bool
 gfc_check_kind (gfc_expr *x)
 {
-  if (x->ts.type == BT_DERIVED)
+  if (x->ts.type == BT_DERIVED || x->ts.type == BT_CLASS)
     {
-      gfc_error ("%qs argument of %qs intrinsic at %L must be a "
-                "non-derived type", gfc_current_intrinsic_arg[0]->name,
+      gfc_error ("%qs argument of %qs intrinsic at %L must be of "
+                "intrinsic type", gfc_current_intrinsic_arg[0]->name,
                 gfc_current_intrinsic, &x->where);
       return false;
     }
+  if (x->ts.type == BT_PROCEDURE)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a data entity",
+                gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+                &x->where);
+      return false;
+    }
 
   return true;
 }

! { dg-do compile }
!
! PR 63363: No diagnostic for passing function as actual argument to KIND
!
! Contributed by Ian Harvey <ian_har...@bigpond.com>

  type :: t
  end type
  type(t) :: d
  class(*), allocatable :: c

  print *, KIND(d)    ! { dg-error "must be of intrinsic type" }
  print *, KIND(c)    ! { dg-error "must be of intrinsic type" }

  print *, KIND(f)    ! { dg-error "must be a data entity" }
  print *, KIND(f())
  print *, KIND(s)    ! { dg-error "must be a data entity" }
contains
  FUNCTION f()
    INTEGER(SELECTED_INT_KIND(4)) :: f
  END FUNCTION
  subroutine s
  end subroutine
END