diff options
author | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
---|---|---|
committer | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
commit | 1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch) | |
tree | c607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 | |
parent | 283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff) | |
download | toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2 toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip |
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 new file mode 100644 index 000000000..ca4d45c70 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 @@ -0,0 +1,78 @@ +! { dg-do run } +! +! PR fortran/53255 +! +! Contributed by Reinhold Bader. +! +! Before TYPE(ext)'s .tr. wrongly called the base type's trace +! instead of ext's trace_ext. +! +module mod_base + implicit none + private + integer, public :: base_cnt = 0 + type, public :: base + private + real :: r(2,2) = reshape( (/ 1.0, 2.0, 3.0, 4.0 /), (/ 2, 2 /)) + contains + procedure, private :: trace + generic :: operator(.tr.) => trace + end type base +contains + complex function trace(this) + class(base), intent(in) :: this + base_cnt = base_cnt + 1 +! write(*,*) 'executing base' + trace = this%r(1,1) + this%r(2,2) + end function trace +end module mod_base + +module mod_ext + use mod_base + implicit none + private + integer, public :: ext_cnt = 0 + public :: base, base_cnt + type, public, extends(base) :: ext + private + real :: i(2,2) = reshape( (/ 1.0, 1.0, 1.0, 1.5 /), (/ 2, 2 /)) + contains + procedure, private :: trace => trace_ext + end type ext +contains + complex function trace_ext(this) + class(ext), intent(in) :: this + +! the following should be executed through invoking .tr. p below +! write(*,*) 'executing override' + ext_cnt = ext_cnt + 1 + trace_ext = .tr. this%base + (0.0, 1.0) * ( this%i(1,1) + this%i(2,2) ) + end function trace_ext + +end module mod_ext +program test_override + use mod_ext + implicit none + type(base) :: o + type(ext) :: p + real :: r + + ! Note: ext's ".tr." (trace_ext) calls also base's "trace" + +! write(*,*) .tr. o +! write(*,*) .tr. p + if (base_cnt /= 0 .or. ext_cnt /= 0) call abort () + r = .tr. o + if (base_cnt /= 1 .or. ext_cnt /= 0) call abort () + r = .tr. p + if (base_cnt /= 2 .or. ext_cnt /= 1) call abort () + + if (abs(.tr. o - 5.0 ) < 1.0e-6 .and. abs( .tr. p - (5.0,2.5)) < 1.0e-6) & + then + if (base_cnt /= 4 .or. ext_cnt /= 2) call abort () +! write(*,*) 'OK' + else + call abort() +! write(*,*) 'FAIL' + end if +end program test_override |