From e653dd207e1e7fe9f3f6a5bfa8cbbf4b19b1f193 Mon Sep 17 00:00:00 2001 From: Slava Zakharin Date: Thu, 29 May 2025 11:42:25 -0700 Subject: [PATCH 1/2] [gfortran] Fixed cray_pointers_2.f90 aliasing issues. The test started failing after https://github.com/llvm/llvm-project/pull/140803 The issue is that the Cray pointee and the underlying storage are both accessed in subroutines violating Fortran aliasing rules for the dummy arguments. GCC tried to "solve" that by using `-fno-inline` option, but it should be better to make the aliasing explicit with proper `TARGET` attribute placement. --- Fortran/UnitTests/CMakeLists.txt | 1 + .../UnitTests/cray_pointers_2/CMakeLists.txt | 3 + .../cray_pointers_2/cray_pointers_2.f90 | 3625 +++++++++++++++++ .../UnitTests/cray_pointers_2/lit.local.cfg | 2 + .../gfortran/regression/DisabledFiles.cmake | 6 + 5 files changed, 3637 insertions(+) create mode 100644 Fortran/UnitTests/cray_pointers_2/CMakeLists.txt create mode 100644 Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 create mode 100644 Fortran/UnitTests/cray_pointers_2/lit.local.cfg diff --git a/Fortran/UnitTests/CMakeLists.txt b/Fortran/UnitTests/CMakeLists.txt index 00178231e7..5c63b0da1e 100644 --- a/Fortran/UnitTests/CMakeLists.txt +++ b/Fortran/UnitTests/CMakeLists.txt @@ -1,6 +1,7 @@ # This file should only contain add_subdirectory(...) one for each test add_subdirectory(hello) add_subdirectory(assign-goto) +add_subdirectory(cray_pointers_2) add_subdirectory(execute_command_line) add_subdirectory(fcvs21_f95) # NIST Fortran Compiler Validation Suite add_subdirectory(finalization) diff --git a/Fortran/UnitTests/cray_pointers_2/CMakeLists.txt b/Fortran/UnitTests/cray_pointers_2/CMakeLists.txt new file mode 100644 index 0000000000..8b9f2da57c --- /dev/null +++ b/Fortran/UnitTests/cray_pointers_2/CMakeLists.txt @@ -0,0 +1,3 @@ +llvm_singlesource() + +file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}") diff --git a/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 b/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 new file mode 100644 index 0000000000..4cfe0e05ae --- /dev/null +++ b/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 @@ -0,0 +1,3625 @@ +! { dg-do run } +! { dg-options "-O3 -fcray-pointer -fbounds-check -fno-inline" } +! { dg-timeout-factor 4 } +! +! Series of routines for testing a Cray pointer implementation +! +! Note: Some of the test cases violate Fortran's alias rules; +! the "-fno-inline option" for now prevents failures. +! +program craytest + common /errors/errors(400) + common /foo/foo ! To prevent optimizations + integer foo + integer i + logical errors + errors = .false. + foo = 0 + call ptr1 + call ptr2 + call ptr3 + call ptr4 + call ptr5 + call ptr6 + call ptr7 + call ptr8 + call ptr9(9,10,11) + call ptr10(9,10,11) + call ptr11(9,10,11) + call ptr12(9,10,11) + call ptr13(9,10) + call parmtest +! NOTE: Tests 1 through 12 were removed from this file +! and placed in loc_1.f90, so we start at 13 + do i=13,400 + if (errors(i)) then +! print *,"Test",i,"failed." + STOP 1 + endif + end do + if (foo.eq.0) then +! print *,"Test did not run correctly." + STOP 2 + endif +end program craytest + +! ptr1 through ptr13 that Cray pointees are correctly used with +! a variety of declaration styles +subroutine ptr1 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1(n) + type(drvd) dpte2(m,n) + type(drvd) dpte3(o,m,n) + integer ipte1 (n) + integer ipte2 (m,n) + integer ipte3 (o,m,n) + real rpte1(n) + real rpte2(m,n) + real rpte3(o,m,n) + character chpte1(n) + character chpte2(m,n) + character chpte3(o,m,n) + character*8 ch8pte1(n) + character*8 ch8pte2(m,n) + character*8 ch8pte3(o,m,n) + + pointer(iptr1,dpte1) + pointer(iptr2,dpte2) + pointer(iptr3,dpte3) + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr6,ipte3) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3) + pointer(iptr10,chpte1) + pointer(iptr11,chpte2) + pointer(iptr12,chpte3) + pointer(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #13 + errors(13) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #14 + errors(14) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #15 + errors(15) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #16 + errors(16) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #17 + errors(17) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #18 + errors(18) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #19 + errors(19) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #20 + errors(20) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #21 + errors(21) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #22 + errors(22) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #23 + errors(23) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #24 + errors(24) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #25 + errors(25) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #26 + errors(26) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #27 + errors(27) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #28 + errors(28) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #29 + errors(29) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #30 + errors(30) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #31 + errors(31) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #32 + errors(32) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #33 + errors(33) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #34 + errors(34) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #35 + errors(35) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #36 + errors(36) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #37 + errors(37) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #38 + errors(38) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #39 + errors(39) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #40 + errors(40) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #41 + errors(41) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #42 + errors(42) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #43 + errors(43) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #44 + errors(44) = .true. + endif + end do + end do + end do + +end subroutine ptr1 + + +subroutine ptr2 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + pointer(iptr1,dpte1(n)) + pointer(iptr2,dpte2(m,n)) + pointer(iptr3,dpte3(o,m,n)) + pointer(iptr4,ipte1(n)) + pointer(iptr5,ipte2 (m,n)) + pointer(iptr6,ipte3(o,m,n)) + pointer(iptr7,rpte1(n)) + pointer(iptr8,rpte2(m,n)) + pointer(iptr9,rpte3(o,m,n)) + pointer(iptr10,chpte1(n)) + pointer(iptr11,chpte2(m,n)) + pointer(iptr12,chpte3(o,m,n)) + pointer(iptr13,ch8pte1(n)) + pointer(iptr14,ch8pte2(m,n)) + pointer(iptr15,ch8pte3(o,m,n)) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #45 + errors(45) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #46 + errors(46) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #47 + errors(47) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #48 + errors(48) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #49 + errors(49) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #50 + errors(50) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #51 + errors(51) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #52 + errors(52) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #53 + errors(53) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #54 + errors(54) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #55 + errors(55) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #56 + errors(56) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #57 + errors(57) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #58 + errors(58) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #59 + errors(59) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #60 + errors(60) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #61 + errors(61) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #62 + errors(62) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #63 + errors(63) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #64 + errors(64) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #65 + errors(65) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #66 + errors(66) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #67 + errors(67) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #68 + errors(68) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #69 + errors(69) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #70 + errors(70) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #71 + errors(71) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #72 + errors(72) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #73 + errors(73) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #74 + errors(74) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #75 + errors(75) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #76 + errors(76) = .true. + endif + end do + end do + end do +end subroutine ptr2 + +subroutine ptr3 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1(n)) + pointer(iptr2,dpte2(m,n)) + pointer(iptr3,dpte3(o,m,n)) + pointer(iptr4,ipte1(n)) + pointer(iptr5,ipte2 (m,n)) + pointer(iptr6,ipte3(o,m,n)) + pointer(iptr7,rpte1(n)) + pointer(iptr8,rpte2(m,n)) + pointer(iptr9,rpte3(o,m,n)) + pointer(iptr10,chpte1(n)) + pointer(iptr11,chpte2(m,n)) + pointer(iptr12,chpte3(o,m,n)) + pointer(iptr13,ch8pte1(n)) + pointer(iptr14,ch8pte2(m,n)) + pointer(iptr15,ch8pte3(o,m,n)) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #77 + errors(77) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #78 + errors(78) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #79 + errors(79) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #80 + errors(80) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #81 + errors(81) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #82 + errors(82) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #83 + errors(83) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #84 + errors(84) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #85 + errors(85) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #86 + errors(86) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #87 + errors(87) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #88 + errors(88) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #89 + errors(89) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #90 + errors(90) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #91 + errors(91) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #92 + errors(92) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #93 + errors(93) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #94 + errors(94) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #95 + errors(95) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #96 + errors(96) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #97 + errors(97) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #98 + errors(98) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #99 + errors(99) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #100 + errors(100) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #101 + errors(101) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #102 + errors(102) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #103 + errors(103) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #104 + errors(104) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #105 + errors(105) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #106 + errors(106) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #107 + errors(107) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #108 + errors(108) = .true. + endif + end do + end do + end do +end subroutine ptr3 + +subroutine ptr4 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3) + pointer (iptr4,ipte1), (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3),(iptr10,chpte1) + pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + type(drvd) dpte1(n) + type(drvd) dpte2(m,n) + type(drvd) dpte3(o,m,n) + integer ipte1 (n) + integer ipte2 (m,n) + integer ipte3 (o,m,n) + real rpte1(n) + real rpte2(m,n) + real rpte3(o,m,n) + character chpte1(n) + character chpte2(m,n) + character chpte3(o,m,n) + character*8 ch8pte1(n) + character*8 ch8pte2(m,n) + character*8 ch8pte3(o,m,n) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #109 + errors(109) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #110 + errors(110) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #111 + errors(111) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #112 + errors(112) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #113 + errors(113) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #114 + errors(114) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #115 + errors(115) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #116 + errors(116) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #117 + errors(117) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #118 + errors(118) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #119 + errors(119) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #120 + errors(120) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #121 + errors(121) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #122 + errors(122) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #123 + errors(123) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #124 + errors(124) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #125 + errors(125) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #126 + errors(126) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #127 + errors(127) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #128 + errors(128) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #129 + errors(129) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #130 + errors(130) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #131 + errors(131) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #132 + errors(132) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #133 + errors(133) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #134 + errors(134) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #135 + errors(135) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #136 + errors(136) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #137 + errors(137) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #138 + errors(138) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #139 + errors(139) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #140 + errors(140) = .true. + endif + end do + end do + end do + +end subroutine ptr4 + +subroutine ptr5 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1(*) + type(drvd) dpte2(m,*) + type(drvd) dpte3(o,m,*) + integer ipte1 (*) + integer ipte2 (m,*) + integer ipte3 (o,m,*) + real rpte1(*) + real rpte2(m,*) + real rpte3(o,m,*) + character chpte1(*) + character chpte2(m,*) + character chpte3(o,m,*) + character*8 ch8pte1(*) + character*8 ch8pte2(m,*) + character*8 ch8pte3(o,m,*) + + pointer(iptr1,dpte1) + pointer(iptr2,dpte2) + pointer(iptr3,dpte3) + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr6,ipte3) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3) + pointer(iptr10,chpte1) + pointer(iptr11,chpte2) + pointer(iptr12,chpte3) + pointer(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #141 + errors(141) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #142 + errors(142) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #143 + errors(143) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #144 + errors(144) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #145 + errors(145) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #146 + errors(146) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #147 + errors(147) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #148 + errors(148) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #149 + errors(149) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #150 + errors(150) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #151 + errors(151) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #152 + errors(152) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #153 + errors(153) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #154 + errors(154) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #155 + errors(155) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #156 + errors(156) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #157 + errors(157) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #158 + errors(158) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #159 + errors(159) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #160 + errors(160) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #161 + errors(161) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #162 + errors(162) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #163 + errors(163) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #164 + errors(164) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #165 + errors(165) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #166 + errors(166) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #167 + errors(167) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #168 + errors(168) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #169 + errors(169) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #170 + errors(170) = .true. + endif + end do + end do + end do + +end subroutine ptr5 + + +subroutine ptr6 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + pointer(iptr1,dpte1(*)) + pointer(iptr2,dpte2(m,*)) + pointer(iptr3,dpte3(o,m,*)) + pointer(iptr4,ipte1(*)) + pointer(iptr5,ipte2 (m,*)) + pointer(iptr6,ipte3(o,m,*)) + pointer(iptr7,rpte1(*)) + pointer(iptr8,rpte2(m,*)) + pointer(iptr9,rpte3(o,m,*)) + pointer(iptr10,chpte1(*)) + pointer(iptr11,chpte2(m,*)) + pointer(iptr12,chpte3(o,m,*)) + pointer(iptr13,ch8pte1(*)) + pointer(iptr14,ch8pte2(m,*)) + pointer(iptr15,ch8pte3(o,m,*)) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #171 + errors(171) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #172 + errors(172) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #173 + errors(173) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #174 + errors(174) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #175 + errors(175) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #176 + errors(176) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #177 + errors(177) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #178 + errors(178) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #179 + errors(179) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #180 + errors(180) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #181 + errors(181) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #182 + errors(182) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #183 + errors(183) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #184 + errors(184) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #185 + errors(185) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #186 + errors(186) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #187 + errors(187) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #188 + errors(188) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #189 + errors(189) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #190 + errors(190) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #191 + errors(191) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #192 + errors(192) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #193 + errors(193) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #194 + errors(194) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #195 + errors(195) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #196 + errors(196) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #197 + errors(197) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #198 + errors(198) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #199 + errors(199) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #200 + errors(200) = .true. + endif + end do + end do + end do + +end subroutine ptr6 + +subroutine ptr7 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1(*)) + pointer(iptr2,dpte2(m,*)) + pointer(iptr3,dpte3(o,m,*)) + pointer(iptr4,ipte1(*)) + pointer(iptr5,ipte2 (m,*)) + pointer(iptr6,ipte3(o,m,*)) + pointer(iptr7,rpte1(*)) + pointer(iptr8,rpte2(m,*)) + pointer(iptr9,rpte3(o,m,*)) + pointer(iptr10,chpte1(*)) + pointer(iptr11,chpte2(m,*)) + pointer(iptr12,chpte3(o,m,*)) + pointer(iptr13,ch8pte1(*)) + pointer(iptr14,ch8pte2(m,*)) + pointer(iptr15,ch8pte3(o,m,*)) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #201 + errors(201) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #202 + errors(202) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #203 + errors(203) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #204 + errors(204) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #205 + errors(205) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #206 + errors(206) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #207 + errors(207) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #208 + errors(208) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #209 + errors(209) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #210 + errors(210) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #211 + errors(211) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #212 + errors(212) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #213 + errors(213) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #214 + errors(214) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #215 + errors(215) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #216 + errors(216) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #217 + errors(217) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #218 + errors(218) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #219 + errors(219) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #220 + errors(220) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #221 + errors(221) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #222 + errors(222) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #223 + errors(223) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #224 + errors(224) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #225 + errors(225) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #226 + errors(226) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #227 + errors(227) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #228 + errors(228) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #229 + errors(229) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #230 + errors(230) = .true. + endif + end do + end do + end do + +end subroutine ptr7 + +subroutine ptr8 + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1) + pointer(iptr2,dpte2) + pointer(iptr3,dpte3) + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr6,ipte3) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3) + pointer(iptr10,chpte1) + pointer(iptr11,chpte2) + pointer(iptr12,chpte3) + pointer(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + type(drvd) dpte1(*) + type(drvd) dpte2(m,*) + type(drvd) dpte3(o,m,*) + integer ipte1 (*) + integer ipte2 (m,*) + integer ipte3 (o,m,*) + real rpte1(*) + real rpte2(m,*) + real rpte3(o,m,*) + character chpte1(*) + character chpte2(m,*) + character chpte3(o,m,*) + character*8 ch8pte1(*) + character*8 ch8pte2(m,*) + character*8 ch8pte3(o,m,*) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #231 + errors(231) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #232 + errors(232) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #233 + errors(233) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #234 + errors(234) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #235 + errors(235) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #236 + errors(236) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #237 + errors(237) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #238 + errors(238) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #239 + errors(239) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #240 + errors(240) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #241 + errors(241) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #242 + errors(242) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #243 + errors(243) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #244 + errors(244) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #245 + errors(245) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #246 + errors(246) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #247 + errors(247) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #248 + errors(248) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #249 + errors(249) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #250 + errors(250) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #251 + errors(251) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #252 + errors(252) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #253 + errors(253) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #254 + errors(254) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #255 + errors(255) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #256 + errors(256) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #257 + errors(257) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #258 + errors(258) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #259 + errors(259) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #260 + errors(260) = .true. + endif + end do + end do + end do +end subroutine ptr8 + + +subroutine ptr9(nnn,mmm,ooo) + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer :: nnn,mmm,ooo + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1(nnn) + type(drvd) dpte2(mmm,nnn) + type(drvd) dpte3(ooo,mmm,nnn) + integer ipte1 (nnn) + integer ipte2 (mmm,nnn) + integer ipte3 (ooo,mmm,nnn) + real rpte1(nnn) + real rpte2(mmm,nnn) + real rpte3(ooo,mmm,nnn) + character chpte1(nnn) + character chpte2(mmm,nnn) + character chpte3(ooo,mmm,nnn) + character*8 ch8pte1(nnn) + character*8 ch8pte2(mmm,nnn) + character*8 ch8pte3(ooo,mmm,nnn) + + pointer(iptr1,dpte1) + pointer(iptr2,dpte2) + pointer(iptr3,dpte3) + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr6,ipte3) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3) + pointer(iptr10,chpte1) + pointer(iptr11,chpte2) + pointer(iptr12,chpte3) + pointer(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #261 + errors(261) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #262 + errors(262) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #263 + errors(263) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #264 + errors(264) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #265 + errors(265) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #266 + errors(266) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #267 + errors(267) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #268 + errors(268) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #269 + errors(269) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #270 + errors(270) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #271 + errors(271) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #272 + errors(272) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #273 + errors(273) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #274 + errors(274) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #275 + errors(275) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #276 + errors(276) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #277 + errors(277) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #278 + errors(278) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #279 + errors(279) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #280 + errors(280) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #281 + errors(281) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #282 + errors(282) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #283 + errors(283) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #284 + errors(284) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #285 + errors(285) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #286 + errors(286) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #287 + errors(287) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #288 + errors(288) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #289 + errors(289) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #290 + errors(290) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #291 + errors(291) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #292 + errors(292) = .true. + endif + end do + end do + end do + +end subroutine ptr9 + +subroutine ptr10(nnn,mmm,ooo) + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer :: nnn,mmm,ooo + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + pointer(iptr1,dpte1(nnn)) + pointer(iptr2,dpte2(mmm,nnn)) + pointer(iptr3,dpte3(ooo,mmm,nnn)) + pointer(iptr4,ipte1(nnn)) + pointer(iptr5,ipte2 (mmm,nnn)) + pointer(iptr6,ipte3(ooo,mmm,nnn)) + pointer(iptr7,rpte1(nnn)) + pointer(iptr8,rpte2(mmm,nnn)) + pointer(iptr9,rpte3(ooo,mmm,nnn)) + pointer(iptr10,chpte1(nnn)) + pointer(iptr11,chpte2(mmm,nnn)) + pointer(iptr12,chpte3(ooo,mmm,nnn)) + pointer(iptr13,ch8pte1(nnn)) + pointer(iptr14,ch8pte2(mmm,nnn)) + pointer(iptr15,ch8pte3(ooo,mmm,nnn)) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #293 + errors(293) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #294 + errors(294) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #295 + errors(295) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #296 + errors(296) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #297 + errors(297) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #298 + errors(298) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #299 + errors(299) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #300 + errors(300) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #301 + errors(301) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #302 + errors(302) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #303 + errors(303) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #304 + errors(304) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #305 + errors(305) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #306 + errors(306) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #307 + errors(307) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #308 + errors(308) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #309 + errors(309) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #310 + errors(310) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #311 + errors(311) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #312 + errors(312) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #313 + errors(313) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #314 + errors(314) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #315 + errors(315) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #316 + errors(316) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #317 + errors(317) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #318 + errors(318) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #319 + errors(319) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #320 + errors(320) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #321 + errors(321) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #322 + errors(322) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #323 + errors(323) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #324 + errors(324) = .true. + endif + end do + end do + end do +end subroutine ptr10 + +subroutine ptr11(nnn,mmm,ooo) + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer :: nnn,mmm,ooo + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1(nnn)) + pointer(iptr2,dpte2(mmm,nnn)) + pointer(iptr3,dpte3(ooo,mmm,nnn)) + pointer(iptr4,ipte1(nnn)) + pointer(iptr5,ipte2 (mmm,nnn)) + pointer(iptr6,ipte3(ooo,mmm,nnn)) + pointer(iptr7,rpte1(nnn)) + pointer(iptr8,rpte2(mmm,nnn)) + pointer(iptr9,rpte3(ooo,mmm,nnn)) + pointer(iptr10,chpte1(nnn)) + pointer(iptr11,chpte2(mmm,nnn)) + pointer(iptr12,chpte3(ooo,mmm,nnn)) + pointer(iptr13,ch8pte1(nnn)) + pointer(iptr14,ch8pte2(mmm,nnn)) + pointer(iptr15,ch8pte3(ooo,mmm,nnn)) + + type(drvd) dpte1 + type(drvd) dpte2 + type(drvd) dpte3 + integer ipte1 + integer ipte2 + integer ipte3 + real rpte1 + real rpte2 + real rpte3 + character chpte1 + character chpte2 + character chpte3 + character*8 ch8pte1 + character*8 ch8pte2 + character*8 ch8pte3 + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #325 + errors(325) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #326 + errors(326) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #327 + errors(327) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #328 + errors(328) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #329 + errors(329) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #330 + errors(330) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #331 + errors(331) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #332 + errors(332) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #333 + errors(333) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #334 + errors(334) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #335 + errors(335) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #336 + errors(336) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #337 + errors(337) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #338 + errors(338) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #339 + errors(339) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #340 + errors(340) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #341 + errors(341) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #342 + errors(342) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #343 + errors(343) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #344 + errors(344) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #345 + errors(345) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #346 + errors(346) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #347 + errors(347) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #348 + errors(348) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #349 + errors(349) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #350 + errors(350) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #351 + errors(351) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #352 + errors(352) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #353 + errors(353) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #354 + errors(354) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #355 + errors(355) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #356 + errors(356) = .true. + endif + end do + end do + end do +end subroutine ptr11 + +subroutine ptr12(nnn,mmm,ooo) + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: i,j,k + integer :: nnn,mmm,ooo + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer, parameter :: o = 11 + integer itarg1 (n) + integer itarg2 (m,n) + integer itarg3 (o,m,n) + real rtarg1(n) + real rtarg2(m,n) + real rtarg3(o,m,n) + character chtarg1(n) + character chtarg2(m,n) + character chtarg3(o,m,n) + character*8 ch8targ1(n) + character*8 ch8targ2(m,n) + character*8 ch8targ3(o,m,n) + type drvd + real r1 + integer i1 + integer i2(5) + end type drvd + type(drvd) dtarg1(n) + type(drvd) dtarg2(m,n) + type(drvd) dtarg3(o,m,n) + + pointer(iptr1,dpte1) + pointer(iptr2,dpte2) + pointer(iptr3,dpte3) + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr6,ipte3) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + pointer(iptr9,rpte3) + pointer(iptr10,chpte1) + pointer(iptr11,chpte2) + pointer(iptr12,chpte3) + pointer(iptr13,ch8pte1) + pointer(iptr14,ch8pte2) + pointer(iptr15,ch8pte3) + + type(drvd) dpte1(nnn) + type(drvd) dpte2(mmm,nnn) + type(drvd) dpte3(ooo,mmm,nnn) + integer ipte1 (nnn) + integer ipte2 (mmm,nnn) + integer ipte3 (ooo,mmm,nnn) + real rpte1(nnn) + real rpte2(mmm,nnn) + real rpte3(ooo,mmm,nnn) + character chpte1(nnn) + character chpte2(mmm,nnn) + character chpte3(ooo,mmm,nnn) + character*8 ch8pte1(nnn) + character*8 ch8pte2(mmm,nnn) + character*8 ch8pte3(ooo,mmm,nnn) + + iptr1 = loc(dtarg1) + iptr2 = loc(dtarg2) + iptr3 = loc(dtarg3) + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr6 = loc(itarg3) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + iptr9 = loc(rtarg3) + iptr10= loc(chtarg1) + iptr11= loc(chtarg2) + iptr12= loc(chtarg3) + iptr13= loc(ch8targ1) + iptr14= loc(ch8targ2) + iptr15= loc(ch8targ3) + + + do, i=1,n + dpte1(i)%i1=i + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #357 + errors(357) = .true. + endif + + dtarg1(i)%i1=2*dpte1(i)%i1 + if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then + ! Error #358 + errors(358) = .true. + endif + + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #359 + errors(359) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #360 + errors(360) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #361 + errors(361) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #362 + errors(362) = .true. + endif + + chpte1(i) = 'a' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #363 + errors(363) = .true. + endif + + chtarg1(i) = 'z' + if (chne(chpte1(i), chtarg1(i))) then + ! Error #364 + errors(364) = .true. + endif + + ch8pte1(i) = 'aaaaaaaa' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #365 + errors(365) = .true. + endif + + ch8targ1(i) = 'zzzzzzzz' + if (ch8ne(ch8pte1(i), ch8targ1(i))) then + ! Error #366 + errors(366) = .true. + endif + + do, j=1,m + dpte2(j,i)%r1=1.0 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #367 + errors(367) = .true. + endif + + dtarg2(j,i)%r1=2*dpte2(j,i)%r1 + if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then + ! Error #368 + errors(368) = .true. + endif + + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #369 + errors(369) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #370 + errors(370) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #371 + errors(371) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #372 + errors(372) = .true. + endif + + chpte2(j,i) = 'a' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #373 + errors(373) = .true. + endif + + chtarg2(j,i) = 'z' + if (chne(chpte2(j,i), chtarg2(j,i))) then + ! Error #374 + errors(374) = .true. + endif + + ch8pte2(j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #375 + errors(375) = .true. + endif + + ch8targ2(j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then + ! Error #376 + errors(376) = .true. + endif + do k=1,o + dpte3(k,j,i)%i2(1+mod(i,5))=i + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #377 + errors(377) = .true. + endif + + dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) + if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & + dtarg3(k,j,i)%i2(1+mod(i,5)))) then + ! Error #378 + errors(378) = .true. + endif + + ipte3(k,j,i) = i + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #379 + errors(379) = .true. + endif + + itarg3(k,j,i) = -ipte3(k,j,i) + if (intne(ipte3(k,j,i), itarg3(k,j,i))) then + ! Error #380 + errors(380) = .true. + endif + + rpte3(k,j,i) = i * 2.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #381 + errors(381) = .true. + endif + + rtarg3(k,j,i) = i * 3.0 + if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then + ! Error #382 + errors(382) = .true. + endif + + chpte3(k,j,i) = 'a' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #383 + errors(383) = .true. + endif + + chtarg3(k,j,i) = 'z' + if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then + ! Error #384 + errors(384) = .true. + endif + + ch8pte3(k,j,i) = 'aaaaaaaa' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #385 + errors(385) = .true. + endif + + ch8targ3(k,j,i) = 'zzzzzzzz' + if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then + ! Error #386 + errors(386) = .true. + endif + end do + end do + end do + + rtarg3 = .5 + ! Vector syntax + do, i=1,n + ipte3 = i + rpte3 = rpte3+1 + do, j=1,m + do k=1,o + if (intne(itarg3(k,j,i), i)) then + ! Error #387 + errors(387) = .true. + endif + + if (realne(rtarg3(k,j,i), i+.5)) then + ! Error #388 + errors(388) = .true. + endif + end do + end do + end do + +end subroutine ptr12 + +! Misc +subroutine ptr13(nnn,mmm) + common /errors/errors(400) + logical :: errors, intne, realne, chne, ch8ne + integer :: nnn,mmm + integer :: i,j + integer, parameter :: n = 9 + integer, parameter :: m = 10 + integer itarg1 (n) + integer itarg2 (m,n) + real rtarg1(n) + real rtarg2(m,n) + + integer ipte1 + integer ipte2 + real rpte1 + real rpte2 + + dimension ipte1(n) + dimension rpte2(mmm,nnn) + + pointer(iptr4,ipte1) + pointer(iptr5,ipte2) + pointer(iptr7,rpte1) + pointer(iptr8,rpte2) + + dimension ipte2(mmm,nnn) + dimension rpte1(n) + + iptr4 = loc(itarg1) + iptr5 = loc(itarg2) + iptr7 = loc(rtarg1) + iptr8 = loc(rtarg2) + + do, i=1,n + ipte1(i) = i + if (intne(ipte1(i), itarg1(i))) then + ! Error #389 + errors(389) = .true. + endif + + itarg1(i) = -ipte1(i) + if (intne(ipte1(i), itarg1(i))) then + ! Error #390 + errors(390) = .true. + endif + + rpte1(i) = i * 5.0 + if (realne(rpte1(i), rtarg1(i))) then + ! Error #391 + errors(391) = .true. + endif + + rtarg1(i) = i * (-5.0) + if (realne(rpte1(i), rtarg1(i))) then + ! Error #392 + errors(392) = .true. + endif + + do, j=1,m + ipte2(j,i) = i + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #393 + errors(393) = .true. + endif + + itarg2(j,i) = -ipte2(j,i) + if (intne(ipte2(j,i), itarg2(j,i))) then + ! Error #394 + errors(394) = .true. + endif + + rpte2(j,i) = i * (-2.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #395 + errors(395) = .true. + endif + + rtarg2(j,i) = i * (-3.0) + if (realne(rpte2(j,i), rtarg2(j,i))) then + ! Error #396 + errors(396) = .true. + endif + + end do + end do +end subroutine ptr13 + + +! Test the passing of pointers and pointees as parameters +subroutine parmtest + interface + subroutine parmptr(ipointer,intarr,n,m) + integer :: n,m + integer, target :: intarr(m,n) + pointer (ipointer,newpte) + integer, target :: newpte(m,n) + end subroutine parmptr + subroutine parmpte(pointee,intarr,n,m) + integer :: n,m + integer, target :: pointee (m,n) + integer, target :: intarr (m,n) + end subroutine parmpte + end interface + integer, parameter :: n = 12 + integer, parameter :: m = 13 + integer iarray(m,n) + pointer (ipt,iptee) + integer iptee (m,n) + + ipt = loc(iarray) + ! write(*,*) "loc(iarray)",loc(iarray) + call parmptr(ipt,iarray,n,m) + ! write(*,*) "loc(iptee)",loc(iptee) + call parmpte(iptee,iarray,n,m) +end subroutine parmtest + +subroutine parmptr(ipointer,intarr,n,m) + common /errors/errors(400) + logical :: errors, intne + integer :: n,m,i,j + integer, target :: intarr(m,n) + pointer (ipointer,newpte) + integer, target :: newpte(m,n) + ! write(*,*) "loc(newpte)",loc(newpte) + ! write(*,*) "loc(intarr)",loc(intarr) + ! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1)) + ! newpte(1,1) = 101 + ! write(*,*) "newpte(1,1)=",newpte(1,1) + ! write(*,*) "intarr(1,1)=",intarr(1,1) + do, i=1,n + do, j=1,m + newpte(j,i) = i + if (intne(newpte(j,i),intarr(j,i))) then + ! Error #397 + errors(397) = .true. + endif + + call donothing(newpte(j,i),intarr(j,i)) + intarr(j,i) = -newpte(j,i) + if (intne(newpte(j,i),intarr(j,i))) then + ! Error #398 + errors(398) = .true. + endif + end do + end do +end subroutine parmptr + +subroutine parmpte(pointee,intarr,n,m) + common /errors/errors(400) + logical :: errors, intne + integer :: n,m,i,j + integer, target :: pointee (m,n) + integer, target :: intarr (m,n) + ! write(*,*) "loc(pointee)",loc(pointee) + ! write(*,*) "loc(intarr)",loc(intarr) + ! write(*,*) "loc(pointee(1,1))",loc(pointee(1,1)) + ! pointee(1,1) = 99 + ! write(*,*) "pointee(1,1)=",pointee(1,1) + ! write(*,*) "intarr(1,1)=",intarr(1,1) + + do, i=1,n + do, j=1,m + pointee(j,i) = i + if (intne(pointee(j,i),intarr(j,i))) then + ! Error #399 + errors(399) = .true. + endif + + intarr(j,i) = 2*pointee(j,i) + call donothing(pointee(j,i),intarr(j,i)) + if (intne(pointee(j,i),intarr(j,i))) then + ! Error #400 + errors(400) = .true. + endif + end do + end do +end subroutine parmpte + +! Separate function calls to break Cray pointer-indifferent optimization +logical function intne(ii,jj) + integer :: i,j + common /foo/foo + integer foo + foo = foo + 1 + intne = ii.ne.jj + if (intne) then + write (*,*) ii," doesn't equal ",jj + endif +end function intne + +logical function realne(r1,r2) + real :: r1, r2 + common /foo/foo + integer foo + foo = foo + 1 + realne = r1.ne.r2 + if (realne) then + write (*,*) r1," doesn't equal ",r2 + endif +end function realne + +logical function chne(ch1,ch2) + character :: ch1, ch2 + common /foo/foo + integer foo + foo = foo + 1 + chne = ch1.ne.ch2 + if (chne) then + write (*,*) ch1," doesn't equal ",ch2 + endif +end function chne + +logical function ch8ne(ch1,ch2) + character*8 :: ch1, ch2 + common /foo/foo + integer foo + foo = foo + 1 + ch8ne = ch1.ne.ch2 + if (ch8ne) then + write (*,*) ch1," doesn't equal ",ch2 + endif +end function ch8ne + +subroutine donothing(ii,jj) + common/foo/foo + integer :: ii,jj,foo + if (foo.le.1) then + foo = 1 + else + foo = foo - 1 + endif + if (foo.eq.0) then + ii = -1 + jj = 1 +! print *,"Test did not run correctly" + STOP 3 + endif +end subroutine donothing + diff --git a/Fortran/UnitTests/cray_pointers_2/lit.local.cfg b/Fortran/UnitTests/cray_pointers_2/lit.local.cfg new file mode 100644 index 0000000000..1166820260 --- /dev/null +++ b/Fortran/UnitTests/cray_pointers_2/lit.local.cfg @@ -0,0 +1,2 @@ +config.traditional_output = True +config.single_source = True diff --git a/Fortran/gfortran/regression/DisabledFiles.cmake b/Fortran/gfortran/regression/DisabledFiles.cmake index 02762f886b..8156dd8b4d 100644 --- a/Fortran/gfortran/regression/DisabledFiles.cmake +++ b/Fortran/gfortran/regression/DisabledFiles.cmake @@ -135,6 +135,12 @@ file(GLOB UNSUPPORTED_FILES CONFIGURE_DEPENDS # 2023 (and before) 15.5.2.14 point (4). `f()` references the actual argument # of `x` while `x` does not have the TARGET or POINTER attribute. aliasing_array_result_1.f90 + + # Test is not conformant, because the Cray pointee and the underlying + # storage are accessed at the same time, and violate Fortran rules + # for accessing/modifying DUMMY arguments. + # Also see https://flang.llvm.org/docs/Aliasing.html#cray-pointers + cray_pointers_2.f90 ) # These tests are skipped because they hit a 'not yet implemented' assertion From c6778d4fd03a4fd56ce56ca45dd072583b6cccd0 Mon Sep 17 00:00:00 2001 From: Slava Zakharin Date: Thu, 29 May 2025 12:19:20 -0700 Subject: [PATCH 2/2] Updated comments. --- .../UnitTests/cray_pointers_2/cray_pointers_2.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 b/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 index 4cfe0e05ae..2a1f6a1557 100644 --- a/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 +++ b/Fortran/UnitTests/cray_pointers_2/cray_pointers_2.f90 @@ -1,11 +1,13 @@ -! { dg-do run } -! { dg-options "-O3 -fcray-pointer -fbounds-check -fno-inline" } -! { dg-timeout-factor 4 } +! The original gfortran test on which this is based is compiled with +! -fcray-pointer -fbounds-check -fno-inline. Of these, we may want to compile +! with -fbounds-check (or its equivalent) if it is ever supported in flang ! ! Series of routines for testing a Cray pointer implementation ! -! Note: Some of the test cases violate Fortran's alias rules; -! the "-fno-inline option" for now prevents failures. +! The original source is in Fortran/gfortran/regression/cray_pointers_2.f90 +! The parmptr and parmpte subroutines violate the non-aliasing +! rules for the dummy arguments, so a TARGET attribute was added +! for them (including the interface declarations inside parmtest). ! program craytest common /errors/errors(400)