This very simple patch implements the subject feature.
Fortran Standard draft F2016 states in 9.10.3.2:
The output list in an INQUIRE statement shall not contain any derived-type list
items that require a defined input/output procedure as described in subclause
9.6.3. If a derived-type list item appears in the output list, the value
returned for the IOLENGTH= specifier assumes that no defined input/output
procedure will be invoked.
The language seems a little obscure. I think the first sentence means don't
expect inquire to use a UDDTIO procedure and the second sentence says when you
use a derived type that has UDDTIO procedures in the output list, treat them as
if they don't and use the default derived type lengths.
Regression tested on x86-64-linux. New test case attached.
I will give this a day or two for comment.
OK for trunk.
Jerry
2016-10-15 Jerry DeLisle <jvdeli...@gcc.gnu.org>
* trans-io.c (transfer_expr): Ignore dtio procedures for inquire
with iolength.
2016-10-15 Jerry DeLisle <jvdeli...@gcc.gnu.org>
* gfortran.dg/dtio_16.f90: New test.
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 3cdbf1fd..216317ad 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -2325,7 +2325,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree
addr_expr,
if (derived->attr.has_dtio_procs)
arg2 = get_dtio_proc (ts, code, &dtio_sub);
- if (dtio_sub != NULL)
+ if ((dtio_sub != NULL) && (last_dt != IOLENGTH))
{
tree decl;
decl = build_fold_indirect_ref_loc (input_location,
! { dg-do run }
! Tests that inquire(iolength=) treats derived types as if they do not
! have User Defined procedures. Fortran Draft F2016 Standard, 9.10.3
MODULE p
TYPE :: person
CHARACTER (LEN=20) :: name
INTEGER(4) :: age
END TYPE person
INTERFACE WRITE(FORMATTED)
MODULE procedure pwf
END INTERFACE
INTERFACE WRITE(UNFORMATTED)
MODULE procedure pwuf
END INTERFACE
INTERFACE read(FORMATTED)
MODULE procedure prf
END INTERFACE
INTERFACE read(UNFORMATTED)
MODULE procedure pruf
END INTERFACE
CONTAINS
SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
CLASS(person), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER (LEN=*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: vlist(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
END SUBROUTINE pwf
SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
CLASS(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER (LEN=*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: vlist(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
END SUBROUTINE prf
SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
CLASS(person), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
print *, "in pwuf"
WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age
END SUBROUTINE pwuf
SUBROUTINE pruf (dtv,unit,iostat,iomsg)
CLASS(person), INTENT(INOUT) :: dtv
INTEGER, INTENT(IN) :: unit
INTEGER, INTENT(OUT) :: iostat
CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
print *, "in pruf"
READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
END SUBROUTINE pruf
END MODULE p
PROGRAM test
USE p
TYPE (person) :: chairman
integer(4) :: rl, tl, kl
chairman%name="Charlie"
chairman%age=62
inquire(iolength=rl) rl, kl, chairman, rl, chairman, t;
if (rl.ne.64) call abort
END PROGRAM test
