git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/48298 ([F03] User-Defined Derived-Type IO (DTIO)) 

2016-10-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48298
	* trans-io.c (transfer_expr): Ignore dtio procedures for inquire
	with iolength.

	* gfortran.dg/dtio_16.f90: New test.

From-SVN: r241216
This commit is contained in:
Jerry DeLisle 2016-10-16 16:29:46 +00:00
parent 01c0b7cf89
commit 6c0347f607
4 changed files with 84 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2016-10-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/48298
* trans-io.c (transfer_expr): Ignore dtio procedures for inquire
with iolength.
2016-10-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/77972

2
gcc/fortran/trans-io.c
View File

@ -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,

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2016-10-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* gfortran.dg/dtio_16.f90: New test.
2016-10-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc.target/sparc/bmaskbshuf.c: Rename to...

73
gcc/testsuite/gfortran.dg/dtio_16.f90 Normal file
View File

@ -0,0 +1,73 @@
! { 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
IMPLICIT NONE
TYPE (person) :: chairman
integer(4) :: rl, tl, kl
chairman%name="Charlie"
chairman%age=62
inquire(iolength=rl) rl, kl, chairman, rl, chairman, tl
if (rl.ne.64) call abort
END PROGRAM test