diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/block_11.f90 | 68 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pointer_intent_6.f90 | 19 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr52621.f90 | 20 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_comp_34.f90 | 30 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/public_private_module_3.f90 | 59 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/public_private_module_4.f90 | 23 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/read_float_4.f90 | 18 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/reassoc_10.f | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/reassoc_11.f | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/reassoc_7.f | 16 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/reassoc_8.f | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/reassoc_9.f | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_call_23.f03 | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/vect/rnflow-trs2a2.f90 | 33 |
14 files changed, 382 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/block_11.f90 b/gcc/testsuite/gfortran.dg/block_11.f90 new file mode 100644 index 00000000000..83c6519d970 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_11.f90 @@ -0,0 +1,68 @@ +! { dg-do link } +! +! PR fortran/52729 +! +! Based on a contribution of Andrew Benson +! +module testMod + type testType + end type testType +contains + subroutine testSub() + implicit none + procedure(double precision ), pointer :: r + class (testType ), pointer :: testObject + double precision :: testVal + + ! Failed as testFunc was BT_UNKNOWN + select type (testObject) + class is (testType) + testVal=testFunc() + r => testFunc + end select + return + end subroutine testSub + + double precision function testFunc() + implicit none + return + end function testFunc +end module testMod + +module testMod2 + implicit none +contains + subroutine testSub() + procedure(double precision ), pointer :: r + double precision :: testVal + ! Failed as testFunc was BT_UNKNOWN + block + r => testFunc + testVal=testFunc() + end block + end subroutine testSub + + double precision function testFunc() + end function testFunc +end module testMod2 + +module m3 + implicit none +contains + subroutine my_test() + procedure(), pointer :: ptr + ! Before the fix, one had the link error + ! "undefined reference to `sub.1909'" + block + ptr => sub + call sub() + end block + end subroutine my_test + subroutine sub(a) + integer, optional :: a + end subroutine sub +end module m3 + +end + +! { dg-final { cleanup-modules "testmod testmod2 m3" } } diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_6.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_6.f90 new file mode 100644 index 00000000000..56c7de5ebba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_intent_6.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR fortran/52864 +! +! Assigning to an intent(in) pointer (which is valid). +! + program test + type PoisFFT_Solver3D + complex, dimension(:,:,:), & + pointer :: work => null() + end type PoisFFT_Solver3D + contains + subroutine PoisFFT_Solver3D_FullPeriodic(D, p) + type(PoisFFT_Solver3D), intent(in) :: D + real, intent(in), pointer :: p(:) + D%work(i,j,k) = 0.0 + p = 0.0 + end subroutine + end diff --git a/gcc/testsuite/gfortran.dg/pr52621.f90 b/gcc/testsuite/gfortran.dg/pr52621.f90 new file mode 100644 index 00000000000..d305e4db9b6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr52621.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-O2 -fprefetch-loop-arrays" } + + SUBROUTINE GHDSYM(IZ,IS,LMMAX,S,LMS,Y,L2M,DRL,NLAY2,K0,DCUT)!, +! + COMPLEX Y(L2M,L2M),H(33),S(LMS) + COMPLEX RU,CI,CZ,K0,FF,Z,Z1,Z2,Z3,ST +! + DO 140 KK=1,4 + DO 130 L=1,L2M + L1=L*L-L + DO 120 M=1,L + IPM=L1+M + IMM=L1-M+2 + S(IPM)=S(IPM)+Z3*Y(L,M) + IF (M.NE.1) S(IMM)=S(IMM)+Z3*Y(M-1,L)*CSGN +120 CONTINUE +130 CONTINUE +140 CONTINUE + END diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_34.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_34.f90 new file mode 100644 index 00000000000..031f74418ca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_34.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! +! PR 51082: [F03] Wrong result for a pointer to a proc-pointer component +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + +program ala + implicit none + + type process_list + procedure(ala1), pointer, nopass :: process + end type + + type(process_list), target :: p_list + type(process_list), pointer :: p + + p_list%process => ala1 + p => p_list + + write(*,*) p_list%process(1.0) + write(*,*) p%process(1.0) !!!! failed + +contains + + real function ala1(x) + real, intent(in) :: x + ala1 = x + end function + +end program diff --git a/gcc/testsuite/gfortran.dg/public_private_module_3.f90 b/gcc/testsuite/gfortran.dg/public_private_module_3.f90 new file mode 100644 index 00000000000..03f00c200e7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/public_private_module_3.f90 @@ -0,0 +1,59 @@ +! { dg-do link } +! { dg-additional-sources public_private_module_4.f90 } +! +! PR fortran/52916 +! Cf. PR fortran/40973 +! +! Ensure that PRIVATE specific functions do not get +! marked as TREE_PUBLIC() = 0, if the generic name is +! PUBLIC. +! +module m + interface gen + module procedure bar + end interface gen + + type t + end type t + + interface operator(.myop.) + module procedure my_op + end interface + + interface operator(+) + module procedure my_plus + end interface + + interface assignment(=) + module procedure my_assign + end interface + + private :: bar, my_op, my_plus, my_assign +contains + subroutine bar() + print *, "bar" + end subroutine bar + function my_op(op1, op2) result(res) + type(t) :: res + type(t), intent(in) :: op1, op2 + end function my_op + function my_plus(op1, op2) result(res) + type(t) :: res + type(t), intent(in) :: op1, op2 + end function my_plus + subroutine my_assign(lhs, rhs) + type(t), intent(out) :: lhs + type(t), intent(in) :: rhs + end subroutine my_assign +end module m + +module m2 + type t2 + contains + procedure, nopass :: func => foo + end type t2 + private :: foo +contains + subroutine foo() + end subroutine foo +end module m2 diff --git a/gcc/testsuite/gfortran.dg/public_private_module_4.f90 b/gcc/testsuite/gfortran.dg/public_private_module_4.f90 new file mode 100644 index 00000000000..82600e46b04 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/public_private_module_4.f90 @@ -0,0 +1,23 @@ +! { dg-do compile { target skip-all-targets } } +! +! To be used by public_private_module_3.f90 +! +! PR fortran/52916 +! Cf. PR fortran/40973 +! +! Ensure that PRIVATE specific functions do not get +! marked as TREE_PUBLIC() = 0, if the generic name is +! PUBLIC. +! +use m +use m2 +implicit none + +type(t) :: a, b, c +type(t2) :: x + +call gen() +a = b + (c .myop. a) + +call x%func() +end diff --git a/gcc/testsuite/gfortran.dg/read_float_4.f90 b/gcc/testsuite/gfortran.dg/read_float_4.f90 new file mode 100644 index 00000000000..01a0de8c04f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_float_4.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! PR libgfortran/53051 +! +! Check that reading "4.0q0" works, i.e. floating-point +! numbers which use "q" to indicate the exponential. +! (Which is a vendor extension.) +! + character(len=20) :: str + real :: r + integer :: i + + r = 0 + str = '1.0q0' + read(str, *, iostat=i) r + if (r /= 1.0 .or. i /= 0) call abort() + !print *, r + end diff --git a/gcc/testsuite/gfortran.dg/reassoc_10.f b/gcc/testsuite/gfortran.dg/reassoc_10.f new file mode 100644 index 00000000000..698e2c49bb4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reassoc_10.f @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math -fdump-tree-optimized" } + + SUBROUTINE S55199(P,Q,Dvdph) + implicit none + real(8) :: c1,c2,c3,P,Q,Dvdph + c1=0.1d0 + c2=0.2d0 + c3=0.3d0 + Dvdph = c1 + 2.*P*c2 + 3.*P**2*Q**3*c3 + END + +! There should be five multiplies following un-distribution +! and power expansion. + +! { dg-final { scan-tree-dump-times " \\\* " 5 "optimized" } } +! { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/reassoc_11.f b/gcc/testsuite/gfortran.dg/reassoc_11.f new file mode 100644 index 00000000000..242201680b3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reassoc_11.f @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math" } + +! This tests only for compile-time failure, which formerly occurred +! when a __builtin_powi was introduced by reassociation in a bad place. + + SUBROUTINE GRDURBAN(URBWSTR, ZIURB, GRIDHT) + + IMPLICIT NONE + INTEGER :: I + REAL :: SW2, URBWSTR, ZIURB, GRIDHT(87) + + SAVE + + SW2 = 1.6*(GRIDHT(I)/ZIURB)**0.667*URBWSTR**2 + + END diff --git a/gcc/testsuite/gfortran.dg/reassoc_7.f b/gcc/testsuite/gfortran.dg/reassoc_7.f new file mode 100644 index 00000000000..4f70ef6f9dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reassoc_7.f @@ -0,0 +1,16 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math -fdump-tree-optimized" } + + SUBROUTINE S55199(P,Dvdph) + implicit none + real(8) :: c1,c2,c3,P,Dvdph + c1=0.1d0 + c2=0.2d0 + c3=0.3d0 + Dvdph = c1 + 2.*P*c2 + 3.*P**2*c3 + END + +! There should be two multiplies following un-distribution. + +! { dg-final { scan-tree-dump-times " \\\* " 2 "optimized" } } +! { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/reassoc_8.f b/gcc/testsuite/gfortran.dg/reassoc_8.f new file mode 100644 index 00000000000..4a6ea72f220 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reassoc_8.f @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math -fdump-tree-optimized" } + + SUBROUTINE S55199(P,Dvdph) + implicit none + real(8) :: c1,c2,c3,P,Dvdph + c1=0.1d0 + c2=0.2d0 + c3=0.3d0 + Dvdph = c1 + 2.*P**2*c2 + 3.*P**3*c3 + END + +! There should be three multiplies following un-distribution +! and power expansion. + +! { dg-final { scan-tree-dump-times " \\\* " 3 "optimized" } } +! { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/reassoc_9.f b/gcc/testsuite/gfortran.dg/reassoc_9.f new file mode 100644 index 00000000000..53950ee9bc9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reassoc_9.f @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math -fdump-tree-optimized" } + + SUBROUTINE S55199(P,Dvdph) + implicit none + real(8) :: c1,c2,c3,P,Dvdph + c1=0.1d0 + c2=0.2d0 + c3=0.3d0 + Dvdph = c1 + 2.*P**2*c2 + 3.*P**4*c3 + END + +! There should be three multiplies following un-distribution +! and power expansion. + +! { dg-final { scan-tree-dump-times " \\\* " 3 "optimized" } } +! { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_call_23.f03 b/gcc/testsuite/gfortran.dg/typebound_call_23.f03 new file mode 100644 index 00000000000..5baa26179d4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_23.f03 @@ -0,0 +1,28 @@ +! { dg-do compile } +! +! PR 52968: [OOP] Call to type-bound procedure wrongly rejected +! +! Contributed by Reuben Budiardja <reubendb@gmail.com> + +module SolverModule + + type :: SolverType + class ( EquationTemplate ), pointer :: Equation + end type + + type :: EquationTemplate + contains + procedure, nopass :: Evaluate + end type + +contains + + subroutine Evaluate () + end subroutine + + subroutine Solve + type ( SolverType ) :: S + call S % Equation % Evaluate () + end subroutine + +end module diff --git a/gcc/testsuite/gfortran.dg/vect/rnflow-trs2a2.f90 b/gcc/testsuite/gfortran.dg/vect/rnflow-trs2a2.f90 new file mode 100644 index 00000000000..1d13cea80e0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/vect/rnflow-trs2a2.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! { dg-require-effective-target vect_double } + + function trs2a2 (j, k, u, d, m) +! matrice de transition intermediaire, partant de k sans descendre +! sous j. R = IjU(I-Ik)DIj, avec Ii = deltajj, j >= i. +! alternative: trs2a2 = 0 +! trs2a2 (j:k-1, j:k-1) = matmul (utrsft (j:k-1,j:k-1), +! dtrsft (j:k-1,j:k-1)) +! + real, dimension (1:m,1:m) :: trs2a2 ! resultat + real, dimension (1:m,1:m) :: u, d ! matrices utrsft, dtrsft + integer, intent (in) :: j, k, m ! niveaux vallee pic +! +!##### following line replaced by Prentice to make less system dependent +! real (kind = kind (1.0d0)) :: dtmp + real (kind = selected_real_kind (10,50)) :: dtmp +! + trs2a2 = 0.0 + do iclw1 = j, k - 1 + do iclw2 = j, k - 1 + dtmp = 0.0d0 + do iclww = j, k - 1 + dtmp = dtmp + u (iclw1, iclww) * d (iclww, iclw2) + enddo + trs2a2 (iclw1, iclw2) = dtmp + enddo + enddo + return + end function trs2a2 + +! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } +! { dg-final { cleanup-tree-dump "vect" } } |