[fortran] PR40196 - [F03] [F08] Type parameter inquiry (str%len, a%kind) and Complex parts (z%re, z%im)

Message ID CAGkQGiJXe216tKYS8-MSvbFNuvTSUFFbh6UHq33tgWx6qYEJ7Q@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR40196 - [F03] [F08] Type parameter inquiry (str%len, a%kind) and Complex parts (z%re, z%im)
Related show

Commit Message

Paul Richard Thomas Oct. 27, 2018, 7:03 p.m.
I was triggered to do this by one of the comments in response to Anton
Shterenlikht's standards survey. The comment was sufficiently
inconsiderate that my first thought was not to respond. However,
curiosity got the better of me... so said the dead cat!

There is a lot of this patch but it is (more or less) straight
forward. The tricky parts were to get the logic right in
gfc_match_varspec and in expr.c. One more step on the way to real
F2002 and F2008 compliance!

Bootstraps and regtests on FC28/x86_64 - OK for trunk?

Paul

2018-10-27  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/40196
    * dependency.c (are_identical_variables): Return false if the
    inquiry refs are not the same.
    (gfc_ref_needs_temporary_p): Break on an inquiry ref.
    * dump_parse_tree.c (show_ref): Show the inquiry ref type.
    * expr.c (gfc_free_ref_list): Break on an inquiry ref.
    (gfc_copy_ref): Copy the inquiry ref types.
    (find_inquiry_ref): New function.
    (simplify_const_ref, simplify_ref_chain): Call it. Add new arg
    to simplify_ref_chain.
    (gfc_simplify_expr): Use the new arg in call to
    simplify_ref_chain.
    (gfc_get_full_arrayspec_from_expr, gfc_is_coarray): Break on
    inquiry ref.
    (gfc_traverse_expr): Return true for inquiry ref.
    * frontend-passes.c (gfc_expr_walker): Break on inquiry ref.
    * gfortran.h : Add enums and union member in gfc_ref to
    implement inquiry refs.
    * intrinsic.c : Fix white nois.
    * match.c (gfc_match_assignment): A constant lavlue is an
    error.
    * module.c : Add DECL_MIO_NAME for inquiry_type and the mstring
    for inquiry_types.
    (mio_ref): Handle inquiry refs.
    * primary.c (is_inquiry_ref): New function.
    (gfc_match_varspec): Handle inquiry refs calling new function.
    (gfc_variable_attr): Detect inquiry ref for disambiguation
    with components.
    (caf_variable_attr): Treat inquiry and substring refs in the
    same way.
    * resolve.c (find_array_spec): ditto.
    (gfc_resolve_substring_charlen): If there is neither a charlen
    ref not an inquiry ref, return.
    (resolve_ref): Handle inqiry refs as appropriate.
    (resolve_allocate_expr): ENtities with an inquiry ref cannot be
    allocated.
    * simplify.c (simplify_bound, simplify_cobound): Punt on
    inquiry refs.
    * trans-array.c (get_array_ctor_var_strlen): Break on inquiry
    ref.
    *trans-expr.c (conv_inquiry): New function.
    (gfc_conv_variable): Retain the last typespec to pass to
    conv_inquiry on detecting an inquiry ref.


2018-10-27  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/40196
    * gfortran.dg/inquiry_part_ref_1.f08: New test.

Comments

Bernhard Reutner-Fischer Oct. 28, 2018, 9:16 a.m. | #1
On Sat, 27 Oct 2018 20:03:47 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

A few nits.

> + /* Pull an inquiry result out of an expression.  */

> + 

> + static bool

> + find_inquiry_ref (gfc_expr *p, gfc_expr **newp)

> + {

> +   gfc_ref *ref;

> +   gfc_ref *inquiry = NULL;

> +   gfc_expr *tmp;

> + 

> +   tmp = gfc_copy_expr (p);

> + 

> +   if (tmp->ref && tmp->ref->type == REF_INQUIRY)

> +     {

> +       inquiry = tmp->ref;

> +       tmp->ref = NULL;

> +     }

> +   else

> +     {

> +       for (ref = tmp->ref; ref; ref = ref->next)

> + 	if (ref->next && ref->next->type == REF_INQUIRY)

> + 	  {

> + 	    inquiry = ref->next;

> + 	    ref->next = NULL;

> + 	  }

> +     }

> + 

> +   if(!inquiry)


missing space before open parenthesis

> *************** typedef struct gfc_ref

> *** 1960,1965 ****

> --- 1963,1970 ----

>       }

>       ss;

>   

> +     inquiry_type i;


inq would be easier to understand and unambiguous imho.

> + /* Used by gfc_match_varspec() to match an inquiry reference.  */

> + 

> + static bool

> + is_inquiry_ref (const char *name, gfc_ref **ref)

> + {

> +   inquiry_type type;

> + 

> +   if (name == NULL)

> +     return false;

> + 

> +   if (ref) *ref = NULL;

> + 

> +   switch (name[0])

> +     {

> +     case 'r':

> +       if (strcmp (name, "re") == 0)

> + 	type = INQUIRY_RE;

> +       else

> + 	return false;

> +       break;

> + 

> +     case 'i':

> +       if (strcmp (name, "im") == 0)

> + 	type = INQUIRY_IM;

> +       else

> + 	return false;

> +       break;

> + 

> +     case 'k':

> +       if (strcmp (name, "kind") == 0)

> + 	type = INQUIRY_KIND;

> +       else

> + 	return false;

> +       break;

> + 

> +     case 'l':

> +       if (strcmp (name, "len") == 0)

> + 	type = INQUIRY_LEN;

> +       else

> + 	return false;

> +       break;

> + 

> +     default:

> +       return false;

> +     }


Is the switch really worth it? I'd have used a plain chain of strcmp,
fwiw.

> ! 	  switch (tmp->u.i)

> ! 	    {

> ! 	    case INQUIRY_RE:

> ! 	    case INQUIRY_IM:

> ! 	      if (!gfc_notify_std (GFC_STD_F2008, "re or im

> part_refs at %C")) ! 		return MATCH_ERROR;


I guess RE and IM should be capitalised?

> *************** gfc_variable_attr (gfc_expr *expr, gfc_t

> *** 2358,2363 ****

> --- 2521,2527 ----

>     gfc_ref *ref;

>     gfc_symbol *sym;

>     gfc_component *comp;

> +   bool has_inquiry_part;

>   

>     if (expr->expr_type != EXPR_VARIABLE && expr->expr_type !=

> EXPR_FUNCTION) gfc_internal_error ("gfc_variable_attr(): Expression

> isn't a variable"); *************** gfc_variable_attr (gfc_expr

> *expr, gfc_t *** 2387,2392 ****

> --- 2551,2561 ----

>     if (ts != NULL && expr->ts.type == BT_UNKNOWN)

>       *ts = sym->ts;

>   

> +   has_inquiry_part = false;

> +   for (ref = expr->ref; ref; ref = ref->next)

> +     if (ref->type == REF_INQUIRY)

> +       has_inquiry_part = true;


you could break here

> + 

>     for (ref = expr->ref; ref; ref = ref->next)

>       switch (ref->type)

>         {


> Index: gcc/fortran/trans-expr.c

> ===================================================================

> *** gcc/fortran/trans-expr.c	(revision 265411)

> --- gcc/fortran/trans-expr.c	(working copy)

> *************** conv_parent_component_references (gfc_se

> *** 2510,2515 ****

> --- 2510,2549 ----

>     conv_parent_component_references (se, &parent);

>   }

>   

> + 

> + static void

> + conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr *expr,

> gfc_typespec *ts)

> + {

> +   tree res = se->expr;

> + 

> +   switch (ref->u.i)

> +     {

> +     case INQUIRY_RE:

> +       res = fold_build1_loc (input_location, REALPART_EXPR,

> + 			     TREE_TYPE (TREE_TYPE (res)), res);

> +       break;

> + 

> +     case INQUIRY_IM:

> +       res = fold_build1_loc (input_location, IMAGPART_EXPR,

> + 			     TREE_TYPE (TREE_TYPE (res)), res);

> +       break;

> + 

> +     case INQUIRY_KIND:

> +       res = build_int_cst (gfc_typenode_for_spec (&expr->ts),

> + 			   ts->kind);

> +       break;

> + 

> +     case INQUIRY_LEN:

> +       res = fold_convert (gfc_typenode_for_spec (&expr->ts),

> + 			  se->string_length);

> +       break;

> + 

> +     default:

> +       gcc_unreachable ();

> +     }

> +   se->expr = res;


Don't you have to gfc_free_expr (se->expr) or gfc_replace_expr() ?

cheers,
Paul Richard Thomas Oct. 28, 2018, 11:31 a.m. | #2
Hi Bernhard,

Thanks for going through the patch:
....snip....
> missing space before open parenthesis


Corrected.
....snip....
> inq would be easier to understand and unambiguous imho.


Why? inquiry_type seems fine to me.

....snip....
> Is the switch really worth it? I'd have used a plain chain of strcmp,

> fwiw.


I have done it. However, I might revert in order to combine the switch
block where I set the typespec for the primary expression.

....snip....
> I guess RE and IM should be capitalised?


Done

> you could break here

>

> > +

> >     for (ref = expr->ref; ref; ref = ref->next)

> >       switch (ref->type)

> >         {


Done

>

> > Index: gcc/fortran/trans-expr.c

....snip...

> Don't you have to gfc_free_expr (se->expr) or gfc_replace_expr() ?


No these are tree expressions not gfc_expr. No cleanup is needed.

I haven't added testcases for errors. Does anybody think that this is necessary?

Cheers

Paul
Thomas Koenig Oct. 28, 2018, 12:38 p.m. | #3
Hi Paul,


>> inq would be easier to understand and unambiguous imho.

> 

> Why? inquiry_type seems fine to me.


I think Bernhard means the name of the member, i.

I think it makes sense to leave as it is - gfc_ref is a
struct that occurs a lot in complicated expressions, and the other
members are one and two letters, too.

> ....snip....

>> Is the switch really worth it? I'd have used a plain chain of strcmp,

>> fwiw.

> 

> I have done it. However, I might revert in order to combine the switch

> block where I set the typespec for the primary expression.


Whatever suits you best.

> I haven't added testcases for errors. Does anybody think that this is necessary?


Might not be a bad idea to run through at least each new error message
again.

There is one illwfL test case which ICEs:

$ cat b.f90
program main
   character(len=:), allocatable :: a
   allocate(a,source="abc")
   a%len = 2
   print *,a
end
$ gfortran b.f90
gimplification failed:
(integer(kind=4)) .a <nop_expr 0x7f138ae67740
     type <integer_type 0x7f138acd15e8 integer(kind=4) public SI
         size <integer_cst 0x7f138acbcdb0 constant 32>
         unit-size <integer_cst 0x7f138acbcdc8 constant 4>
         align:32 warn_if_not_align:0 symtab:0 alias-set -1 
canonical-type 0x7f138acd15e8 precision:32 min <integer_cst 
0x7f138acbcd68 -2147483648> max <integer_cst 0x7f138acbcd80 2147483647>
         pointer_to_this <pointer_type 0x7f138acd89d8>>

     arg:0 <var_decl 0x7f138b980ab0 .a
         type <integer_type 0x7f138acd1738 integer(kind=8) public DI
             size <integer_cst 0x7f138acbcb70 constant 64>
             unit-size <integer_cst 0x7f138acbcb88 constant 8>
             align:64 warn_if_not_align:0 symtab:0 alias-set -1 
canonical-type 0x7f138acd1738 precision:64 min <integer_cst 
0x7f138acbcdf8 -9223372036854775808> max <integer_cst 0x7f138acbce10 
9223372036854775807>
             pointer_to_this <pointer_type 0x7f138ad057e0>>
         used DI b.f90:1:0 size <integer_cst 0x7f138acbcb70 64> 
unit-size <integer_cst 0x7f138acbcb88 8>
         align:64 warn_if_not_align:0 context <function_decl 
0x7f138ae83200 MAIN__>
         chain <var_decl 0x7f138b980b40 a type <pointer_type 0x7f138ae82540>
             used unsigned DI b.f90:2:0 size <integer_cst 0x7f138acbcb70 
64> unit-size <integer_cst 0x7f138acbcb88 8>
             align:64 warn_if_not_align:0 context <function_decl 
0x7f138ae83200 MAIN__>>>>
b.f90:4:0:

     4 |   a%len = 2
       |
internal compiler error: gimplification failed
0xb45602 gimplify_expr(tree_node**, gimple**, gimple**, bool 
(*)(tree_node*), int)
         ../../trunk/gcc/gimplify.c:12568

Regards

	Thomas
Paul Richard Thomas Oct. 28, 2018, 8:19 p.m. | #4
Hi Thomas,

I tried failing cases of that kind; or assignment to len/kind part refs and
returned correct errors. Must check where I was going wrong.

Paul from a chilly Garching-bei-Muenchen


On Sun, 28 Oct 2018, 13:38 Thomas Koenig <tkoenig@netcologne.de wrote:

> Hi Paul,

>

>

> >> inq would be easier to understand and unambiguous imho.

> >

> > Why? inquiry_type seems fine to me.

>

> I think Bernhard means the name of the member, i.

>

> I think it makes sense to leave as it is - gfc_ref is a

> struct that occurs a lot in complicated expressions, and the other

> members are one and two letters, too.

>

> > ....snip....

> >> Is the switch really worth it? I'd have used a plain chain of strcmp,

> >> fwiw.

> >

> > I have done it. However, I might revert in order to combine the switch

> > block where I set the typespec for the primary expression.

>

> Whatever suits you best.

>

> > I haven't added testcases for errors. Does anybody think that this is

> necessary?

>

> Might not be a bad idea to run through at least each new error message

> again.

>

> There is one illwfL test case which ICEs:

>

> $ cat b.f90

> program main

>    character(len=:), allocatable :: a

>    allocate(a,source="abc")

>    a%len = 2

>    print *,a

> end

> $ gfortran b.f90

> gimplification failed:

> (integer(kind=4)) .a <nop_expr 0x7f138ae67740

>      type <integer_type 0x7f138acd15e8 integer(kind=4) public SI

>          size <integer_cst 0x7f138acbcdb0 constant 32>

>          unit-size <integer_cst 0x7f138acbcdc8 constant 4>

>          align:32 warn_if_not_align:0 symtab:0 alias-set -1

> canonical-type 0x7f138acd15e8 precision:32 min <integer_cst

> 0x7f138acbcd68 -2147483648> max <integer_cst 0x7f138acbcd80 2147483647>

>          pointer_to_this <pointer_type 0x7f138acd89d8>>

>

>      arg:0 <var_decl 0x7f138b980ab0 .a

>          type <integer_type 0x7f138acd1738 integer(kind=8) public DI

>              size <integer_cst 0x7f138acbcb70 constant 64>

>              unit-size <integer_cst 0x7f138acbcb88 constant 8>

>              align:64 warn_if_not_align:0 symtab:0 alias-set -1

> canonical-type 0x7f138acd1738 precision:64 min <integer_cst

> 0x7f138acbcdf8 -9223372036854775808> max <integer_cst 0x7f138acbce10

> 9223372036854775807>

>              pointer_to_this <pointer_type 0x7f138ad057e0>>

>          used DI b.f90:1:0 size <integer_cst 0x7f138acbcb70 64>

> unit-size <integer_cst 0x7f138acbcb88 8>

>          align:64 warn_if_not_align:0 context <function_decl

> 0x7f138ae83200 MAIN__>

>          chain <var_decl 0x7f138b980b40 a type <pointer_type

> 0x7f138ae82540>

>              used unsigned DI b.f90:2:0 size <integer_cst 0x7f138acbcb70

> 64> unit-size <integer_cst 0x7f138acbcb88 8>

>              align:64 warn_if_not_align:0 context <function_decl

> 0x7f138ae83200 MAIN__>>>>

> b.f90:4:0:

>

>      4 |   a%len = 2

>        |

> internal compiler error: gimplification failed

> 0xb45602 gimplify_expr(tree_node**, gimple**, gimple**, bool

> (*)(tree_node*), int)

>          ../../trunk/gcc/gimplify.c:12568

>

> Regards

>

>         Thomas

>
Paul Richard Thomas Oct. 29, 2018, 5:51 p.m. | #5
Hi Thomas,

Thanks for finding the assignment a%len = 2 that escapes the check for
lvalues. I am back home tomorrow night and will investigate why this
one evades the trap. I think that an error test is needed in
expr.c(gfc_check_assign).

Cheers

Paul

On Sun, 28 Oct 2018 at 13:38, Thomas Koenig <tkoenig@netcologne.de> wrote:
>

> Hi Paul,

>

>

> >> inq would be easier to understand and unambiguous imho.

> >

> > Why? inquiry_type seems fine to me.

>

> I think Bernhard means the name of the member, i.

>

> I think it makes sense to leave as it is - gfc_ref is a

> struct that occurs a lot in complicated expressions, and the other

> members are one and two letters, too.

>

> > ....snip....

> >> Is the switch really worth it? I'd have used a plain chain of strcmp,

> >> fwiw.

> >

> > I have done it. However, I might revert in order to combine the switch

> > block where I set the typespec for the primary expression.

>

> Whatever suits you best.

>

> > I haven't added testcases for errors. Does anybody think that this is necessary?

>

> Might not be a bad idea to run through at least each new error message

> again.

>

> There is one illwfL test case which ICEs:

>

> $ cat b.f90

> program main

>    character(len=:), allocatable :: a

>    allocate(a,source="abc")

>    a%len = 2

>    print *,a

> end

> $ gfortran b.f90

> gimplification failed:

> (integer(kind=4)) .a <nop_expr 0x7f138ae67740

>      type <integer_type 0x7f138acd15e8 integer(kind=4) public SI

>          size <integer_cst 0x7f138acbcdb0 constant 32>

>          unit-size <integer_cst 0x7f138acbcdc8 constant 4>

>          align:32 warn_if_not_align:0 symtab:0 alias-set -1

> canonical-type 0x7f138acd15e8 precision:32 min <integer_cst

> 0x7f138acbcd68 -2147483648> max <integer_cst 0x7f138acbcd80 2147483647>

>          pointer_to_this <pointer_type 0x7f138acd89d8>>

>

>      arg:0 <var_decl 0x7f138b980ab0 .a

>          type <integer_type 0x7f138acd1738 integer(kind=8) public DI

>              size <integer_cst 0x7f138acbcb70 constant 64>

>              unit-size <integer_cst 0x7f138acbcb88 constant 8>

>              align:64 warn_if_not_align:0 symtab:0 alias-set -1

> canonical-type 0x7f138acd1738 precision:64 min <integer_cst

> 0x7f138acbcdf8 -9223372036854775808> max <integer_cst 0x7f138acbce10

> 9223372036854775807>

>              pointer_to_this <pointer_type 0x7f138ad057e0>>

>          used DI b.f90:1:0 size <integer_cst 0x7f138acbcb70 64>

> unit-size <integer_cst 0x7f138acbcb88 8>

>          align:64 warn_if_not_align:0 context <function_decl

> 0x7f138ae83200 MAIN__>

>          chain <var_decl 0x7f138b980b40 a type <pointer_type 0x7f138ae82540>

>              used unsigned DI b.f90:2:0 size <integer_cst 0x7f138acbcb70

> 64> unit-size <integer_cst 0x7f138acbcb88 8>

>              align:64 warn_if_not_align:0 context <function_decl

> 0x7f138ae83200 MAIN__>>>>

> b.f90:4:0:

>

>      4 |   a%len = 2

>        |

> internal compiler error: gimplification failed

> 0xb45602 gimplify_expr(tree_node**, gimple**, gimple**, bool

> (*)(tree_node*), int)

>          ../../trunk/gcc/gimplify.c:12568

>

> Regards

>

>         Thomas




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

Index: gcc/fortran/dependency.c
===================================================================
*** gcc/fortran/dependency.c	(revision 265411)
--- gcc/fortran/dependency.c	(working copy)
*************** are_identical_variables (gfc_expr *e1, g
*** 189,194 ****
--- 189,199 ----
  
  	  break;
  
+ 	case REF_INQUIRY:
+ 	  if (r1->u.i != r2->u.i)
+ 	    return false;
+ 	  break;
+ 
  	default:
  	  gfc_internal_error ("are_identical_variables: Bad type");
  	}
*************** gfc_ref_needs_temporary_p (gfc_ref *ref)
*** 905,910 ****
--- 910,916 ----
  	return subarray_p;
  
        case REF_COMPONENT:
+       case REF_INQUIRY:
  	break;
        }
  
Index: gcc/fortran/dump-parse-tree.c
===================================================================
*** gcc/fortran/dump-parse-tree.c	(revision 265411)
--- gcc/fortran/dump-parse-tree.c	(working copy)
*************** show_ref (gfc_ref *p)
*** 308,313 ****
--- 308,330 ----
  	fputc (')', dumpfile);
  	break;
  
+       case REF_INQUIRY:
+ 	switch (p->u.i)
+ 	{
+ 	  case INQUIRY_KIND:
+ 	    fprintf (dumpfile, " INQUIRY_KIND ");
+ 	    break;
+ 	  case INQUIRY_LEN:
+ 	    fprintf (dumpfile, " INQUIRY_LEN ");
+ 	    break;
+ 	  case INQUIRY_RE:
+ 	    fprintf (dumpfile, " INQUIRY_RE ");
+ 	    break;
+ 	  case INQUIRY_IM:
+ 	    fprintf (dumpfile, " INQUIRY_IM ");
+ 	}
+ 	break;
+ 
        default:
  	gfc_internal_error ("show_ref(): Bad component code");
        }
*************** write_decl (gfc_typespec *ts, gfc_array_
*** 3167,3173 ****
  
    fputs (sym_name, dumpfile);
    fputs (post, dumpfile);
!     
    if (rok == T_WARN)
      fprintf (dumpfile," /* WARNING: Converting '%s' to interoperable type */",
  	     gfc_typename (ts));
--- 3184,3190 ----
  
    fputs (sym_name, dumpfile);
    fputs (post, dumpfile);
! 
    if (rok == T_WARN)
      fprintf (dumpfile," /* WARNING: Converting '%s' to interoperable type */",
  	     gfc_typename (ts));
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 265411)
--- gcc/fortran/expr.c	(working copy)
*************** gfc_free_ref_list (gfc_ref *p)
*** 599,604 ****
--- 599,605 ----
  	  break;
  
  	case REF_COMPONENT:
+ 	case REF_INQUIRY:
  	  break;
  	}
  
*************** gfc_copy_ref (gfc_ref *src)
*** 756,761 ****
--- 757,766 ----
        dest->u.c = src->u.c;
        break;
  
+     case REF_INQUIRY:
+       dest->u.i = src->u.i;
+       break;
+ 
      case REF_SUBSTRING:
        dest->u.ss = src->u.ss;
        dest->u.ss.start = gfc_copy_expr (src->u.ss.start);
*************** find_substring_ref (gfc_expr *p, gfc_exp
*** 1691,1696 ****
--- 1696,1792 ----
  }
  
  
+ /* Pull an inquiry result out of an expression.  */
+ 
+ static bool
+ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
+ {
+   gfc_ref *ref;
+   gfc_ref *inquiry = NULL;
+   gfc_expr *tmp;
+ 
+   tmp = gfc_copy_expr (p);
+ 
+   if (tmp->ref && tmp->ref->type == REF_INQUIRY)
+     {
+       inquiry = tmp->ref;
+       tmp->ref = NULL;
+     }
+   else
+     {
+       for (ref = tmp->ref; ref; ref = ref->next)
+ 	if (ref->next && ref->next->type == REF_INQUIRY)
+ 	  {
+ 	    inquiry = ref->next;
+ 	    ref->next = NULL;
+ 	  }
+     }
+ 
+   if(!inquiry)
+     {
+       gfc_free_expr (tmp);
+       return false;
+     }
+ 
+   gfc_resolve_expr (tmp);
+ 
+   switch (inquiry->u.i)
+     {
+     case INQUIRY_LEN:
+       if (tmp->ts.type != BT_CHARACTER)
+ 	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;
+ 
+     case INQUIRY_KIND:
+       if (tmp->ts.type == BT_DERIVED || tmp->ts.type == BT_CLASS)
+ 	goto cleanup;
+ 
+       *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;
+ 
+       *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;
+ 
+       *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;
+     }
+ 
+   if (!(*newp))
+     goto cleanup;
+   else if ((*newp)->expr_type != EXPR_CONSTANT)
+     {
+       gfc_free_expr (*newp);
+       goto cleanup;
+     }
+ 
+   gfc_free_expr (tmp);
+   return true;
+ 
+ cleanup:
+   gfc_free_expr (tmp);
+   return false;
+ }
+ 
+ 
  
  /* Simplify a subobject reference of a constructor.  This occurs when
     parameter variable values are substituted.  */
*************** static bool
*** 1699,1705 ****
  simplify_const_ref (gfc_expr *p)
  {
    gfc_constructor *cons, *c;
!   gfc_expr *newp;
    gfc_ref *last_ref;
  
    while (p->ref)
--- 1795,1801 ----
  simplify_const_ref (gfc_expr *p)
  {
    gfc_constructor *cons, *c;
!   gfc_expr *newp = NULL;
    gfc_ref *last_ref;
  
    while (p->ref)
*************** simplify_const_ref (gfc_expr *p)
*** 1800,1807 ****
  	  remove_subobject_ref (p, cons);
  	  break;
  
  	case REF_SUBSTRING:
!   	  if (!find_substring_ref (p, &newp))
  	    return false;
  
  	  gfc_replace_expr (p, newp);
--- 1896,1912 ----
  	  remove_subobject_ref (p, cons);
  	  break;
  
+ 	case REF_INQUIRY:
+ 	  if (!find_inquiry_ref (p, &newp))
+ 	    return false;
+ 
+ 	  gfc_replace_expr (p, newp);
+ 	  gfc_free_ref_list (p->ref);
+ 	  p->ref = NULL;
+ 	  break;
+ 
  	case REF_SUBSTRING:
! 	  if (!find_substring_ref (p, &newp))
  	    return false;
  
  	  gfc_replace_expr (p, newp);
*************** simplify_const_ref (gfc_expr *p)
*** 1818,1826 ****
  /* Simplify a chain of references.  */
  
  static bool
! simplify_ref_chain (gfc_ref *ref, int type)
  {
    int n;
  
    for (; ref; ref = ref->next)
      {
--- 1923,1932 ----
  /* Simplify a chain of references.  */
  
  static bool
! simplify_ref_chain (gfc_ref *ref, int type, gfc_expr **p)
  {
    int n;
+   gfc_expr *newp;
  
    for (; ref; ref = ref->next)
      {
*************** simplify_ref_chain (gfc_ref *ref, int ty
*** 1845,1850 ****
--- 1951,1965 ----
  	    return false;
  	  break;
  
+ 	case REF_INQUIRY:
+ 	  if (!find_inquiry_ref (*p, &newp))
+ 	    return false;
+ 
+ 	  gfc_replace_expr (*p, newp);
+ 	  gfc_free_ref_list ((*p)->ref);
+ 	  (*p)->ref = NULL;
+ 	  break;
+ 
  	default:
  	  break;
  	}
*************** gfc_simplify_expr (gfc_expr *p, int type
*** 1933,1938 ****
--- 2048,2056 ----
    switch (p->expr_type)
      {
      case EXPR_CONSTANT:
+       if (p->ref && p->ref->type == REF_INQUIRY)
+ 	simplify_ref_chain (p->ref, type, &p);
+       break;
      case EXPR_NULL:
        break;
  
*************** gfc_simplify_expr (gfc_expr *p, int type
*** 1969,1975 ****
        break;
  
      case EXPR_SUBSTRING:
!       if (!simplify_ref_chain (p->ref, type))
  	return false;
  
        if (gfc_is_constant_expr (p))
--- 2087,2093 ----
        break;
  
      case EXPR_SUBSTRING:
!       if (!simplify_ref_chain (p->ref, type, &p))
  	return false;
  
        if (gfc_is_constant_expr (p))
*************** gfc_simplify_expr (gfc_expr *p, int type
*** 2031,2044 ****
  	}
  
        /* Simplify subcomponent references.  */
!       if (!simplify_ref_chain (p->ref, type))
  	return false;
  
        break;
  
      case EXPR_STRUCTURE:
      case EXPR_ARRAY:
!       if (!simplify_ref_chain (p->ref, type))
  	return false;
  
        if (!simplify_constructor (p->value.constructor, type))
--- 2149,2162 ----
  	}
  
        /* Simplify subcomponent references.  */
!       if (!simplify_ref_chain (p->ref, type, &p))
  	return false;
  
        break;
  
      case EXPR_STRUCTURE:
      case EXPR_ARRAY:
!       if (!simplify_ref_chain (p->ref, type, &p))
  	return false;
  
        if (!simplify_constructor (p->value.constructor, type))
*************** gfc_get_full_arrayspec_from_expr (gfc_ex
*** 4780,4785 ****
--- 4898,4904 ----
  	      continue;
  
  	    case REF_SUBSTRING:
+ 	    case REF_INQUIRY:
  	      continue;
  
  	    case REF_ARRAY:
*************** gfc_traverse_expr (gfc_expr *expr, gfc_s
*** 4932,4937 ****
--- 5051,5059 ----
  	      }
  	  break;
  
+ 	case REF_INQUIRY:
+ 	  return true;
+ 
  	default:
  	  gcc_unreachable ();
  	}
*************** gfc_is_coarray (gfc_expr *e)
*** 5286,5291 ****
--- 5408,5414 ----
  	break;
  
       case REF_SUBSTRING:
+      case REF_INQUIRY:
  	break;
      }
  
Index: gcc/fortran/frontend-passes.c
===================================================================
*** gcc/fortran/frontend-passes.c	(revision 265412)
--- gcc/fortran/frontend-passes.c	(working copy)
*************** gfc_expr_walker (gfc_expr **e, walk_expr
*** 5035,5040 ****
--- 5035,5041 ----
  		    break;
  
  		  case REF_COMPONENT:
+ 		  case REF_INQUIRY:
  		    break;
  		  }
  	      }
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 265411)
--- gcc/fortran/gfortran.h	(working copy)
*************** gfc_array_ref;
*** 1936,1942 ****
     before the component component.  */
  
  enum ref_type
!   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING };
  
  typedef struct gfc_ref
  {
--- 1936,1945 ----
     before the component component.  */
  
  enum ref_type
!   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING, REF_INQUIRY };
! 
! enum inquiry_type
!   { INQUIRY_RE, INQUIRY_IM, INQUIRY_KIND, INQUIRY_LEN };
  
  typedef struct gfc_ref
  {
*************** typedef struct gfc_ref
*** 1960,1965 ****
--- 1963,1970 ----
      }
      ss;
  
+     inquiry_type i;
+ 
    }
    u;
  
Index: gcc/fortran/intrinsic.c
===================================================================
*** gcc/fortran/intrinsic.c	(revision 265411)
--- gcc/fortran/intrinsic.c	(working copy)
*************** add_subroutines (void)
*** 3316,3322 ****
      *st = "status", *stat = "stat", *sz = "size", *t = "to",
      *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
      *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
!  
    int di, dr, dc, dl, ii;
  
    di = gfc_default_integer_kind;
--- 3316,3322 ----
      *st = "status", *stat = "stat", *sz = "size", *t = "to",
      *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
      *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
! 
    int di, dr, dc, dl, ii;
  
    di = gfc_default_integer_kind;
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c	(revision 265411)
--- gcc/fortran/match.c	(working copy)
*************** gfc_match_assignment (void)
*** 1350,1355 ****
--- 1350,1363 ----
  
    rvalue = NULL;
    m = gfc_match (" %e%t", &rvalue);
+ 
+   if (lvalue->expr_type == EXPR_CONSTANT)
+     {
+       /* This clobbers %len and %kind.  */
+       m = MATCH_ERROR;
+       gfc_error ("Assignment to a constant expression at %C");
+     }
+ 
    if (m != MATCH_YES)
      {
        gfc_current_locus = old_loc;
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(revision 265411)
--- gcc/fortran/module.c	(working copy)
*************** DECL_MIO_NAME (procedure_type)
*** 2125,2130 ****
--- 2125,2131 ----
  DECL_MIO_NAME (ref_type)
  DECL_MIO_NAME (sym_flavor)
  DECL_MIO_NAME (sym_intent)
+ DECL_MIO_NAME (inquiry_type)
  #undef DECL_MIO_NAME
  
  /* Symbol attributes are stored in list with the first three elements
*************** static const mstring ref_types[] = {
*** 3140,3145 ****
--- 3141,3155 ----
      minit ("ARRAY", REF_ARRAY),
      minit ("COMPONENT", REF_COMPONENT),
      minit ("SUBSTRING", REF_SUBSTRING),
+     minit ("INQUIRY", REF_INQUIRY),
+     minit (NULL, -1)
+ };
+ 
+ static const mstring inquiry_types[] = {
+     minit ("RE", INQUIRY_RE),
+     minit ("IM", INQUIRY_IM),
+     minit ("KIND", INQUIRY_KIND),
+     minit ("LEN", INQUIRY_LEN),
      minit (NULL, -1)
  };
  
*************** mio_ref (gfc_ref **rp)
*** 3170,3175 ****
--- 3180,3189 ----
        mio_expr (&r->u.ss.end);
        mio_charlen (&r->u.ss.length);
        break;
+ 
+     case REF_INQUIRY:
+       r->u.i = MIO_NAME (inquiry_type) (r->u.i, inquiry_types);
+       break;
      }
  
    mio_rparen ();
Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c	(revision 265411)
--- gcc/fortran/primary.c	(working copy)
*************** match_sym_complex_part (gfc_expr **resul
*** 1249,1255 ****
    if (sym->attr.flavor != FL_PARAMETER)
      {
        /* Give the matcher for implied do-loops a chance to run.  This yields
! 	 a much saner error message for "write(*,*) (i, i=1, 6" where the 
  	 right parenthesis is missing.  */
        char c;
        gfc_gobble_whitespace ();
--- 1249,1255 ----
    if (sym->attr.flavor != FL_PARAMETER)
      {
        /* Give the matcher for implied do-loops a chance to run.  This yields
! 	 a much saner error message for "write(*,*) (i, i=1, 6" where the
  	 right parenthesis is missing.  */
        char c;
        gfc_gobble_whitespace ();
*************** extend_ref (gfc_expr *primary, gfc_ref *
*** 1936,1941 ****
--- 1936,1998 ----
  }
  
  
+ /* Used by gfc_match_varspec() to match an inquiry reference.  */
+ 
+ static bool
+ is_inquiry_ref (const char *name, gfc_ref **ref)
+ {
+   inquiry_type type;
+ 
+   if (name == NULL)
+     return false;
+ 
+   if (ref) *ref = NULL;
+ 
+   switch (name[0])
+     {
+     case 'r':
+       if (strcmp (name, "re") == 0)
+ 	type = INQUIRY_RE;
+       else
+ 	return false;
+       break;
+ 
+     case 'i':
+       if (strcmp (name, "im") == 0)
+ 	type = INQUIRY_IM;
+       else
+ 	return false;
+       break;
+ 
+     case 'k':
+       if (strcmp (name, "kind") == 0)
+ 	type = INQUIRY_KIND;
+       else
+ 	return false;
+       break;
+ 
+     case 'l':
+       if (strcmp (name, "len") == 0)
+ 	type = INQUIRY_LEN;
+       else
+ 	return false;
+       break;
+ 
+     default:
+       return false;
+     }
+ 
+   if (ref)
+     {
+       *ref = gfc_get_ref ();
+       (*ref)->type = REF_INQUIRY;
+       (*ref)->u.i = type;
+     }
+ 
+   return true;
+ }
+ 
+ 
  /* Match any additional specifications associated with the current
     variable like member references or substrings.  If equiv_flag is
     set we only match stuff that is allowed inside an EQUIVALENCE
*************** gfc_match_varspec (gfc_expr *primary, in
*** 1955,1960 ****
--- 2012,2019 ----
    gfc_expr *tgt_expr = NULL;
    match m;
    bool unknown;
+   bool inquiry;
+   locus old_loc;
    char sep;
  
    tail = NULL;
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2087,2092 ****
--- 2146,2164 ----
    if (m == MATCH_ERROR)
      return MATCH_ERROR;
  
+   inquiry = false;
+   if (m == MATCH_YES && sep == '%'
+       && primary->ts.type != BT_CLASS
+       && primary->ts.type != BT_DERIVED)
+     {
+       match mm;
+       old_loc = gfc_current_locus;
+       mm = gfc_match_name (name);
+       if (mm == MATCH_YES && is_inquiry_ref (name, &tmp))
+ 	inquiry = true;
+       gfc_current_locus = old_loc;
+     }
+ 
    if (sym->ts.type == BT_UNKNOWN && m == MATCH_YES
        && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
      gfc_set_default_type (sym, 0, sym->ns);
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2118,2135 ****
  	}
      }
    else if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
!            && m == MATCH_YES)
      {
        gfc_error ("Unexpected %<%c%> for nonderived-type variable %qs at %C",
  		 sep, sym->name);
        return MATCH_ERROR;
      }
  
!   if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
        || m != MATCH_YES)
      goto check_substring;
  
!   sym = sym->ts.u.derived;
  
    for (;;)
      {
--- 2190,2210 ----
  	}
      }
    else if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
!            && m == MATCH_YES && !inquiry)
      {
        gfc_error ("Unexpected %<%c%> for nonderived-type variable %qs at %C",
  		 sep, sym->name);
        return MATCH_ERROR;
      }
  
!   if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS && !inquiry)
        || m != MATCH_YES)
      goto check_substring;
  
!   if (!inquiry)
!     sym = sym->ts.u.derived;
!   else
!     sym = NULL;
  
    for (;;)
      {
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2142,2147 ****
--- 2217,2231 ----
        if (m != MATCH_YES)
  	return MATCH_ERROR;
  
+       if (primary->ts.type != BT_CLASS && primary->ts.type != BT_DERIVED)
+ 	{
+ 	  inquiry = is_inquiry_ref (name, &tmp);
+ 	  if (inquiry)
+ 	    sym = NULL;
+ 	}
+       else
+ 	inquiry = false;
+ 
        if (sym && sym->f2k_derived)
  	tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus);
        else
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2197,2220 ****
  	  break;
  	}
  
!       component = gfc_find_component (sym, name, false, false, &tmp);
!       if (component == NULL)
  	return MATCH_ERROR;
  
!       /* Extend the reference chain determined by gfc_find_component.  */
        if (primary->ref == NULL)
!         primary->ref = tmp;
        else
!         {
!           /* Set by the for loop below for the last component ref.  */
!           gcc_assert (tail != NULL);
!           tail->next = tmp;
!         }
  
        /* The reference chain may be longer than one hop for union
!          subcomponents; find the new tail.  */
        for (tail = tmp; tail->next; tail = tail->next)
!         ;
  
        primary->ts = component->ts;
  
--- 2281,2369 ----
  	  break;
  	}
  
!       if (!inquiry)
! 	component = gfc_find_component (sym, name, false, false, &tmp);
!       else
! 	component = NULL;
! 
!       if (component == NULL && !inquiry)
  	return MATCH_ERROR;
  
!       /* Extend the reference chain determined by gfc_find_component or
! 	 is_inquiry_ref.  */
        if (primary->ref == NULL)
! 	primary->ref = tmp;
        else
! 	{
! 	  /* Set by the for loop below for the last component ref.  */
! 	  gcc_assert (tail != NULL);
! 	  tail->next = tmp;
! 	}
  
        /* The reference chain may be longer than one hop for union
! 	 subcomponents; find the new tail.  */
        for (tail = tmp; tail->next; tail = tail->next)
! 	;
! 
!       if (tmp && tmp->type == REF_INQUIRY)
! 	{
! 	  gfc_simplify_expr (primary, 0);
! 
! 	  if (primary->expr_type == EXPR_CONSTANT)
! 	    goto check_done;
! 
! 	  switch (tmp->u.i)
! 	    {
! 	    case INQUIRY_RE:
! 	    case INQUIRY_IM:
! 	      if (!gfc_notify_std (GFC_STD_F2008, "re or im part_refs at %C"))
! 		return MATCH_ERROR;
! 
! 	      if (primary->ts.type != BT_COMPLEX)
! 		{
! 		  gfc_error ("The RE or IM part_ref at %C must be "
! 			     "applied to a COMPLEX expression");
! 		  return MATCH_ERROR;
! 		}
! 	      primary->ts.type = BT_REAL;
! 	      break;
! 
! 	    case INQUIRY_LEN:
! 	      if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
! 		return MATCH_ERROR;
! 
! 	      if (primary->ts.type != BT_CHARACTER)
! 		{
! 		  gfc_error ("The LEN part_ref at %C must be applied "
! 			     "to a CHARACTER expression");
! 		  return MATCH_ERROR;
! 		}
! 	      primary->ts.u.cl = NULL;
! 	      primary->ts.type = BT_INTEGER;
! 	      primary->ts.kind = gfc_default_integer_kind;
! 	      break;
! 
! 	    case INQUIRY_KIND:
! 	      if (!gfc_notify_std (GFC_STD_F2003, "KIND part_ref at %C"))
! 		return MATCH_ERROR;
! 
! 	      if (primary->ts.type == BT_CLASS
! 		  || primary->ts.type == BT_DERIVED)
! 		{
! 		  gfc_error ("The KIND part_ref at %C must be applied "
! 			     "to an expression of intrinsic type");
! 		  return MATCH_ERROR;
! 		}
! 	      primary->ts.type = BT_INTEGER;
! 	      primary->ts.kind = gfc_default_integer_kind;
! 	      break;
! 
! 	    default:
! 	      gcc_unreachable ();
! 	    }
! 
! 	  goto check_done;
! 	}
  
        primary->ts = component->ts;
  
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2263,2273 ****
  	    return m;
  	}
  
        if ((component->ts.type != BT_DERIVED && component->ts.type != BT_CLASS)
! 	  || gfc_match_member_sep (component->ts.u.derived) != MATCH_YES)
  	break;
  
!       sym = component->ts.u.derived;
      }
  
  check_substring:
--- 2412,2436 ----
  	    return m;
  	}
  
+ check_done:
+       /* In principle, we could have eg. expr%re%kind so we must allow for
+ 	 this possibility.  */
+       if (gfc_match_char ('%') == MATCH_YES)
+ 	{
+ 	  if (component && (component->ts.type == BT_DERIVED
+ 			    || component->ts.type == BT_CLASS))
+ 	    sym = component->ts.u.derived;
+ 	  continue;
+ 	}
+       else if (inquiry)
+ 	break;
+ 
        if ((component->ts.type != BT_DERIVED && component->ts.type != BT_CLASS)
!   	  || gfc_match_member_sep (component->ts.u.derived) != MATCH_YES)
  	break;
  
!       if (component->ts.type == BT_DERIVED || component->ts.type == BT_CLASS)
! 	sym = component->ts.u.derived;
      }
  
  check_substring:
*************** gfc_variable_attr (gfc_expr *expr, gfc_t
*** 2358,2363 ****
--- 2521,2527 ----
    gfc_ref *ref;
    gfc_symbol *sym;
    gfc_component *comp;
+   bool has_inquiry_part;
  
    if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
      gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");
*************** gfc_variable_attr (gfc_expr *expr, gfc_t
*** 2387,2392 ****
--- 2551,2561 ----
    if (ts != NULL && expr->ts.type == BT_UNKNOWN)
      *ts = sym->ts;
  
+   has_inquiry_part = false;
+   for (ref = expr->ref; ref; ref = ref->next)
+     if (ref->type == REF_INQUIRY)
+       has_inquiry_part = true;
+ 
    for (ref = expr->ref; ref; ref = ref->next)
      switch (ref->type)
        {
*************** gfc_variable_attr (gfc_expr *expr, gfc_t
*** 2423,2429 ****
        case REF_COMPONENT:
  	comp = ref->u.c.component;
  	attr = comp->attr;
! 	if (ts != NULL)
  	  {
  	    *ts = comp->ts;
  	    /* Don't set the string length if a substring reference
--- 2592,2598 ----
        case REF_COMPONENT:
  	comp = ref->u.c.component;
  	attr = comp->attr;
! 	if (ts != NULL && !has_inquiry_part)
  	  {
  	    *ts = comp->ts;
  	    /* Don't set the string length if a substring reference
*************** gfc_variable_attr (gfc_expr *expr, gfc_t
*** 2450,2455 ****
--- 2619,2625 ----
  
  	break;
  
+       case REF_INQUIRY:
        case REF_SUBSTRING:
  	allocatable = pointer = 0;
  	break;
*************** caf_variable_attr (gfc_expr *expr, bool
*** 2630,2635 ****
--- 2800,2806 ----
  	break;
  
        case REF_SUBSTRING:
+       case REF_INQUIRY:
  	allocatable = pointer = 0;
  	break;
        }
*************** gfc_convert_to_structure_constructor (gf
*** 2914,2920 ****
  	      to = e < c ? e : c;
  	      for (i = 0; i < to; i++)
  		dest[i] = actual->expr->value.character.string[i];
! 	      
  	      for (i = e; i < c; i++)
  		dest[i] = ' ';
  
--- 3085,3091 ----
  	      to = e < c ? e : c;
  	      for (i = 0; i < to; i++)
  		dest[i] = actual->expr->value.character.string[i];
! 
  	      for (i = e; i < c; i++)
  		dest[i] = ' ';
  
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 265411)
--- gcc/fortran/resolve.c	(working copy)
*************** find_array_spec (gfc_expr *e)
*** 4740,4745 ****
--- 4740,4746 ----
  	break;
  
        case REF_SUBSTRING:
+       case REF_INQUIRY:
  	break;
        }
  
*************** gfc_resolve_substring_charlen (gfc_expr
*** 4962,4974 ****
  
    for (char_ref = e->ref; char_ref; char_ref = char_ref->next)
      {
!       if (char_ref->type == REF_SUBSTRING)
!       	break;
        if (char_ref->type == REF_COMPONENT)
  	ts = &char_ref->u.c.component->ts;
      }
  
!   if (!char_ref)
      return;
  
    gcc_assert (char_ref->next == NULL);
--- 4963,4975 ----
  
    for (char_ref = e->ref; char_ref; char_ref = char_ref->next)
      {
!       if (char_ref->type == REF_SUBSTRING || char_ref->type == REF_INQUIRY)
! 	break;
        if (char_ref->type == REF_COMPONENT)
  	ts = &char_ref->u.c.component->ts;
      }
  
!   if (!char_ref || char_ref->type == REF_INQUIRY)
      return;
  
    gcc_assert (char_ref->next == NULL);
*************** resolve_ref (gfc_expr *expr)
*** 5056,5061 ****
--- 5057,5063 ----
  	break;
  
        case REF_COMPONENT:
+       case REF_INQUIRY:
  	break;
  
        case REF_SUBSTRING:
*************** resolve_ref (gfc_expr *expr)
*** 5129,5134 ****
--- 5131,5137 ----
  	  break;
  
  	case REF_SUBSTRING:
+ 	case REF_INQUIRY:
  	  break;
  	}
  
*************** resolve_deallocate_expr (gfc_expr *e)
*** 7233,7238 ****
--- 7236,7242 ----
  	  break;
  
  	case REF_SUBSTRING:
+ 	case REF_INQUIRY:
  	  allocatable = 0;
  	  break;
  	}
*************** resolve_allocate_expr (gfc_expr *e, gfc_
*** 7525,7530 ****
--- 7529,7535 ----
  		break;
  
  	      case REF_SUBSTRING:
+ 	      case REF_INQUIRY:
  		allocatable = 0;
  		pointer = 0;
  		break;
Index: gcc/fortran/simplify.c
===================================================================
*** gcc/fortran/simplify.c	(revision 265411)
--- gcc/fortran/simplify.c	(working copy)
*************** simplify_bound (gfc_expr *array, gfc_exp
*** 4182,4187 ****
--- 4182,4188 ----
  	  continue;
  
  	case REF_SUBSTRING:
+ 	case REF_INQUIRY:
  	  continue;
  	}
      }
*************** simplify_cobound (gfc_expr *array, gfc_e
*** 4324,4329 ****
--- 4325,4331 ----
  	  continue;
  
  	case REF_SUBSTRING:
+ 	case REF_INQUIRY:
  	  continue;
  	}
      }
*************** gfc_simplify_minmaxloc (gfc_expr *array,
*** 5406,5412 ****
  
        back_val = back->value.logical;
      }
!   
    if (sign < 0)
      init_val = INT_MAX;
    else if (sign > 0)
--- 5408,5414 ----
  
        back_val = back->value.logical;
      }
! 
    if (sign < 0)
      init_val = INT_MAX;
    else if (sign > 0)
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 265411)
--- gcc/fortran/trans-array.c	(working copy)
*************** get_array_ctor_var_strlen (stmtblock_t *
*** 2078,2083 ****
--- 2078,2086 ----
  	  mpz_clear (char_len);
  	  return;
  
+ 	case REF_INQUIRY:
+ 	  break;
+ 
  	default:
  	 gcc_unreachable ();
  	}
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 265411)
--- gcc/fortran/trans-expr.c	(working copy)
*************** conv_parent_component_references (gfc_se
*** 2510,2515 ****
--- 2510,2549 ----
    conv_parent_component_references (se, &parent);
  }
  
+ 
+ static void
+ conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr *expr, gfc_typespec *ts)
+ {
+   tree res = se->expr;
+ 
+   switch (ref->u.i)
+     {
+     case INQUIRY_RE:
+       res = fold_build1_loc (input_location, REALPART_EXPR,
+ 			     TREE_TYPE (TREE_TYPE (res)), res);
+       break;
+ 
+     case INQUIRY_IM:
+       res = fold_build1_loc (input_location, IMAGPART_EXPR,
+ 			     TREE_TYPE (TREE_TYPE (res)), res);
+       break;
+ 
+     case INQUIRY_KIND:
+       res = build_int_cst (gfc_typenode_for_spec (&expr->ts),
+ 			   ts->kind);
+       break;
+ 
+     case INQUIRY_LEN:
+       res = fold_convert (gfc_typenode_for_spec (&expr->ts),
+ 			  se->string_length);
+       break;
+ 
+     default:
+       gcc_unreachable ();
+     }
+   se->expr = res;
+ }
+ 
  /* Return the contents of a variable. Also handles reference/pointer
     variables (all Fortran pointer references are implicit).  */
  
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 2720,2725 ****
--- 2754,2760 ----
        gcc_assert (se->string_length);
      }
  
+   gfc_typespec *ts = &sym->ts;
    while (ref)
      {
        switch (ref->type)
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 2740,2745 ****
--- 2775,2781 ----
  	  break;
  
  	case REF_COMPONENT:
+ 	  ts = &ref->u.c.component->ts;
  	  if (first_time && is_classarray && sym->attr.dummy
  	      && se->descriptor_only
  	      && !CLASS_DATA (sym)->attr.allocatable
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 2767,2772 ****
--- 2803,2812 ----
  			      expr->symtree->name, &expr->where);
  	  break;
  
+ 	case REF_INQUIRY:
+ 	  conv_inquiry (se, ref, expr, ts);
+ 	  break;
+ 
  	default:
  	  gcc_unreachable ();
  	  break;
*************** gfc_apply_interface_mapping_to_ref (gfc_
*** 4135,4140 ****
--- 4175,4181 ----
  	break;
  
        case REF_COMPONENT:
+       case REF_INQUIRY:
  	break;
  
        case REF_SUBSTRING:
Index: gcc/testsuite/gfortran.dg/inquiry_type_ref_1.f08
===================================================================
*** gcc/testsuite/gfortran.dg/inquiry_type_ref_1.f08	(nonexistent)
--- gcc/testsuite/gfortran.dg/inquiry_type_ref_1.f08	(working copy)
***************
*** 0 ****
--- 1,55 ----
+ ! { dg-do run }
+ !
+ ! Test the implementation of inquiry part references (PR40196).
+ ! "Type parameter inquiry (str%len, a%kind) and Complex parts (z%re, z%im)"
+ !
+ ! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+ !
+ module m
+   complex, target :: z
+   character (:), allocatable :: str
+   real, pointer :: r => z%re
+   real, pointer :: i => z%im
+   type :: mytype
+     complex :: z = ( 10.0, 11.0 )
+     character(6) :: str
+   end type
+ end module
+ 
+   use m
+ 
+   type(mytype) :: der
+   integer :: j
+   character (len=der%str%len) :: str1
+   complex, parameter :: zc = ( 99.0, 199.0 )
+   REAL, parameter :: rc = zc%re
+   REAL, parameter :: ic = zc%im
+ 
+   z = (2.0,4.0)
+   str = "abcd"
+ 
+ ! Check the pointer initializations
+   if (r .ne. real (z)) stop 1
+   if (i .ne. imag (z)) stop 2
+ 
+ ! Check the use of inquiry part_refs on lvalues and rvalues.
+   z%im = 4.0 * z%re
+ 
+ ! Check that the result is OK.
+   if (z%re .ne. real (z)) stop 3
+   if (abs (z*im - 4.0 * real (z)) .lt. 1e-6) stop 4
+ 
+ ! Check a double inquiry part_ref.
+   if (z%im%kind .ne. kind (z)) stop 5
+ 
+ ! Test on deferred character length.
+   if (str%kind .ne. kind (str)) stop 6
+   if (str%len .ne. len (str)) stop 7
+ 
+ ! Check the use in specification expressions.
+   if (len (der%str) .ne. LEN (str1)) stop 8
+   if (rc .ne. real (zc)) stop 9
+   if (ic .ne. aimag (zc)) stop 10
+ 
+ end
+