diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile')
75 files changed, 1463 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/20080806-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/20080806-1.f90 new file mode 100644 index 000000000..3abc80ab1 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/20080806-1.f90 @@ -0,0 +1,24 @@ +MODULE M1 + IMPLICIT NONE + TYPE mmm + COMPLEX(KIND=8), DIMENSION(:,:), POINTER :: data + END TYPE mmm + +CONTAINS + + SUBROUTINE S(ma,mb,mc) + TYPE(mmm), POINTER :: ma,mb,mc + COMPLEX(KIND=8), DIMENSION(:, :), & + POINTER :: a, b, c + INTEGER :: i,j + a=>ma%data + b=>mb%data + c=>mc%data + DO i=1,size(a,1) + DO j=1,size(a,2) + c(i,j)=a(i,j)*b(i,j) + ENDDO + ENDDO + END SUBROUTINE + +END MODULE M1 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 new file mode 100644 index 000000000..871c08149 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/actual.f90 @@ -0,0 +1,38 @@ +module modull + +contains + +function fun( a ) + real, intent(in) :: a + real :: fun + fun = a +end function fun + +end module modull + + + +program t5 + +use modull + +real :: a, b + +b = foo( fun, a ) + +contains + +function foo( f, a ) + real, intent(in) :: a + interface + function f( x ) + real, intent(in) :: x + real :: f + end function f + end interface + real :: foo + + foo = f( a ) +end function foo + +end program t5 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 new file mode 100644 index 000000000..f5cce41f7 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/allocate.f90 @@ -0,0 +1,26 @@ +! Snippet to test various allocate statements + +program test_allocate + implicit none + type t + integer i + real r + end type + type pt + integer, pointer :: p + end type + integer, allocatable, dimension(:, :) :: a + type (t), pointer, dimension(:) :: b + type (pt), pointer :: c + integer, pointer:: p + integer n + + n = 10 + allocate (a(1:10, 4)) + allocate (a(5:n, n:14)) + allocate (a(6, 8)) + allocate (b(n)) + allocate (c) + allocate (c%p) + allocate (p) +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 new file mode 100644 index 000000000..3e5e07dad --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/ambig.f90 @@ -0,0 +1,26 @@ +MODULE TYPESP + TYPE DMT + REAL(KIND(1.D0)), POINTER :: ASPK(:) + END TYPE DMT +END MODULE TYPESP + +MODULE TCNST + Integer, Parameter :: DIM_TEMP_BUFFER=10000 + Real(Kind(1.d0)), Parameter :: COLROW_=0.33,PERCENT=0.7 +end MODULE TCNST + + +Subroutine DOWORK(A) + Use TYPESP + Use TCNST + Type(DMT), intent (inout) :: A + Real(Kind(1.d0)),Pointer :: ASPK(:) + Integer :: ISIZE, IDIM + + ISIZE=DIM_TEMP_BUFFER + + Allocate(ASPK(ISIZE),STAT=INFO) + IDIM = MIN(ISIZE,SIZE(A%ASPK)) + ASPK(1:IDIM) = A%ASPK(1:IDIM) + Return +End Subroutine DOWORK diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 new file mode 100644 index 000000000..1eec0bb59 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/arrayio.f90 @@ -0,0 +1,12 @@ +! Program to test array IO. Should print the numbers 1-20 in order +program arrayio + implicit none + integer, dimension(5, 4) :: a + integer i, j + + do j=1,4 + a(:, j) = (/ (i + (j - 1) * 5, i=1,5) /) + end do + + write (*) a +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 new file mode 100644 index 000000000..eef33e425 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/bergervoet2.f90 @@ -0,0 +1,5 @@ + function testi() result(res) + integer :: res + res = 0 + end function testi + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp new file mode 100644 index 000000000..1a6d1f0cb --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp @@ -0,0 +1,39 @@ +# Expect driver script for GCC Regression Tests +# Copyright (C) 2003-2014 Free Software Foundation, Inc. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# These tests come from many different contributors. + +if $tracelevel then { + strace $tracelevel +} + +# load support procs +load_lib fortran-torture.exp +load_lib torture-options.exp + +torture-init +set-torture-options [get-fortran-torture-options] + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + fortran-torture $testcase +} + +torture-finish diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/complex_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/complex_1.f90 new file mode 100644 index 000000000..605ec665f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/complex_1.f90 @@ -0,0 +1,5 @@ +program test_gfortran2 + Complex(8) :: g, zh + Real(8) :: g_q + g = zh - zh/cmplx(0.0_8,-g_q) +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 new file mode 100644 index 000000000..60f31092e --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_1.f90 @@ -0,0 +1,15 @@ +! Obscure failure that disappeared when the parameter was removed. +! Works OK now. +module mymod +implicit none +contains + subroutine test(i) + implicit none + integer i + end subroutine +end module mymod + +program error + use mymod +end program + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 new file mode 100644 index 000000000..76ef6c628 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_2.f90 @@ -0,0 +1,11 @@ +! Arrays declared in parent but used in the child. +program error + implicit none + integer, dimension (10) :: a +contains + subroutine test() + implicit none + a(1) = 0 + end subroutine +end program + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 new file mode 100644 index 000000000..da5e8475c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_3.f90 @@ -0,0 +1,12 @@ +! Program to check using parent variables in more than one contained function +program contained_3 + implicit none + integer var +contains + subroutine one + var = 1 + end subroutine + subroutine two + var = 2 + end subroutine +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 new file mode 100644 index 000000000..233dab878 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_4.f90 @@ -0,0 +1,35 @@ +! Check contained functions with the same name. +module contained_4 + +contains + + subroutine foo1() + call bar() + contains + subroutine bar() + end subroutine bar + end subroutine foo1 + + subroutine foo2() + call bar() + contains + subroutine bar() + end subroutine bar + end subroutine foo2 + +end module contained_4 + +subroutine foo1() +call bar() +contains + subroutine bar() + end subroutine bar +end subroutine + +subroutine foo2() + call bar() +contains + subroutine bar() + end subroutine bar +end subroutine foo2 + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 new file mode 100644 index 000000000..94946f76b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/contained_5.f90 @@ -0,0 +1,10 @@ +! Function returning an array continaed in a module. Caused problems 'cos +! we tried to add the dummy return vars to the parent scope. + +Module contained_5 +contains +FUNCTION test () + REAL, DIMENSION (1) :: test + test(1)=0.0 +END FUNCTION +end module diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 new file mode 100644 index 000000000..777cd132c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/convert.f90 @@ -0,0 +1,37 @@ +! Program to test conversion. Does not actualy test the generated code +program convert + implicit none + integer(kind=4) i + integer(kind=8) m + real(kind=4) r + real(kind=8) q + complex(kind=4) c + complex(kind=8) z + + ! each of these should generate a single intrinsic conversion expression + i = int(i) + i = int(m) + i = int(r) + i = int(q) + i = int(c) + i = int(z) + m = int(i, kind=8) + m = int(m, kind=8) + m = int(r, kind=8) + m = int(q, kind=8) + m = int(c, kind=8) + m = int(z, kind=8) + r = real(i) + r = real(m) + r = real(r) + r = real(q) + r = real(c) + r = real(z, kind=4) + q = real(i, kind=8) + q = real(m, kind=8) + q = real(r, kind=8) + q = real(q, kind=8) + q = real(c, kind=8) + ! Note real(<complex>) returns the type kind of the argument. + q = real(z) +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/data_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/data_1.f90 new file mode 100644 index 000000000..b28390993 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/data_1.f90 @@ -0,0 +1,11 @@ +! this tests the fix for PR 13826 +TYPE a + REAL x +END TYPE +TYPE(a) :: y +DATA y /a(1.)/ ! used to give an error about non-PARAMETER +END +! this tests the fix for PR 13940 +SUBROUTINE a +DATA i /z'f95f95'/ +END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_1.f90 new file mode 100644 index 000000000..635727b66 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_1.f90 @@ -0,0 +1,10 @@ +!This used to ICE as we chose the wrong type for the +! temporary to hold type%var +! fortran/18157 +program testcase_fold + type :: struct + real :: var ! its julian sec + end type struct + type(struct), dimension(:), pointer :: mystruct + mystruct(:)%var = mystruct(:)%var +END Program testcase_fold diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_2.f90 new file mode 100644 index 000000000..29515f556 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_2.f90 @@ -0,0 +1,17 @@ +!This used to ICE as we chose the wrong type for the +! temporary to hold type%x +! fortran/18157 +MODULE bug + IMPLICIT NONE + TYPE :: my_type + REAL :: x + END TYPE + TYPE (my_type), DIMENSION(3) :: t + CONTAINS + SUBROUTINE foo + INTEGER, DIMENSION(8) :: c(3) + t(c)%x = t(c)%x + RETURN + END SUBROUTINE foo +END MODULE bug + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_3.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_3.f90 new file mode 100644 index 000000000..d31167cc4 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/defined_type_3.f90 @@ -0,0 +1,10 @@ +!This used to ICE as we chose the wrong type for the +! temporary to hold type%var +! fortran/18157 +program testcase_fold + type :: struct + real :: var ! its julian sec + end type struct + type(struct), dimension(:), pointer :: mystruct + mystruct(1:2)%var = mystruct(2:3)%var +END Program testcase_fold diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/do_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/do_1.f90 new file mode 100644 index 000000000..396592c39 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/do_1.f90 @@ -0,0 +1,28 @@ +! test various forms of the DO statement +! inspired by PR14066 +LOGICAL L +DO i=1,10 +END DO +DO 10 i=1,20 + DO 20,j=1,10,2 +20 CONTINUE +10 END DO +L = .TRUE. +DO WHILE(L) + L = .FALSE. +END DO +DO 50 WHILE(.NOT.L) + L = .TRUE. +50 CONTINUE +DO + DO 30 + DO 40 +40 CONTINUE +30 END DO +END DO +outer: DO i=1,20 + inner: DO,j=i,30 + IF (j.EQ.2*i) CYCLE outer + END DO inner +END DO outer +END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 new file mode 100644 index 000000000..d54f64899 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/dummyfn.f90 @@ -0,0 +1,13 @@ +! Program to test array valued dummy functions +SUBROUTINE dummyfn(deriv) + implicit none + INTERFACE + FUNCTION deriv() + REAL :: deriv(4) + END FUNCTION deriv + END INTERFACE + + REAL :: dx(4) + + dx = deriv() +END SUBROUTINE diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty.f90 new file mode 100644 index 000000000..e69de29bb --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty.f90 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty_interface_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty_interface_1.f90 new file mode 100644 index 000000000..d90895423 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/empty_interface_1.f90 @@ -0,0 +1,4 @@ +! Program to test empty interfaces PR15051 +INTERFACE leer +END INTERFACE +END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif-1.f90 new file mode 100644 index 000000000..bdce67db9 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif-1.f90 @@ -0,0 +1,10 @@ +program emptyif + + implicit none + integer i,K(4) + + if (K(i)==0) then + ! do absolutely nothing + end if + +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 new file mode 100644 index 000000000..bd12d502e --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/emptyif.f90 @@ -0,0 +1,42 @@ +! Program to test empty IF statements +program emptyif + implicit none + logical c + logical d + + if (c) then + c = .true. + end if + + if (c) then + else + c = .true. + end if + + if (c) then + c = .true. + else + end if + + if (c) then + c = .true. + elseif (d) then + c = .true. + else + end if + + if (c) then + c = .true. + elseif (d) then + else + c = .true. + end if + + if (c) then + elseif (d) then + c = .true. + else + c = .true. + end if + +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 new file mode 100644 index 000000000..7a6b42403 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/enum_1.f90 @@ -0,0 +1,46 @@ +! Program to test parsing of ENUM in different program units + +program main + implicit none + interface + subroutine sub1 + end subroutine sub1 + end interface + integer :: i = 55 + + enum , bind (c) + enumerator :: a , b=5 + enumerator c, d + end enum + + call sub + call sub1 + i = fun() + +contains + + subroutine sub + enum, bind(c) + enumerator :: p = b, q = 10 + 50 + enumerator r, s + end enum + end subroutine sub + + function fun() + integer :: fun + enum, bind (c) + enumerator :: red, yellow = 23 + enumerator :: blue + enumerator :: green + end enum + fun = 1 + end function fun +end program main + +subroutine sub1 + implicit none + enum, bind(c) + enumerator x , y + enumerator :: z = 100 + end enum +end subroutine sub1 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 new file mode 100644 index 000000000..fab9aa665 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/fnresvar.f90 @@ -0,0 +1,5 @@ +! Explicit function rsult variables +function fnresvar() result (r) + integer r + r = 0 +end function diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/forall-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/forall-1.f90 new file mode 100644 index 000000000..caaea088a --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/forall-1.f90 @@ -0,0 +1,7 @@ + integer i, a(1) + logical(kind=8) s(1) + + s = .true. + a = 42 + forall (i=1:1, .not. s(1)) a(i) = 0 + end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 new file mode 100644 index 000000000..eb493411b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/gen_interf.f90 @@ -0,0 +1,19 @@ +! Program to test generic interfaces. +program gen_interf + implicit none + interface gen + function ifn (a) + integer :: a, ifn + end function + end interface + interface gsub + subroutine igsub (a) + integer a + end subroutine + end interface + + integer i + + call gsub (i) + i = gen(i) +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 new file mode 100644 index 000000000..8a6c4f56d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit.f90 @@ -0,0 +1,13 @@ +implicit integer(a), logical(b-c), real(d-y), integer(z) +a = 1_4 +b = .true. +c = b +d = 1.0e2 +y = d +z = a +end +! test prompted by PR 16161 +! we used to match "character (c)" wrongly in the below, confusing the parser +subroutine b +implicit character (c) +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 new file mode 100644 index 000000000..f56bd63b4 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 @@ -0,0 +1,32 @@ +! Test implicit character declarations. +! This requires some coordination between the typespec and variable name range +! matchers to get it right. +module implicit_1 + integer, parameter :: x = 10 + integer, parameter :: y = 6 + integer, parameter :: z = selected_int_kind(4) +end module +subroutine foo(n) + use implicit_1 + ! Test various combinations with and without character length + ! and type kind specifiers + implicit character(len=5) (a) + implicit character(n) (b) + implicit character*6 (c-d) + implicit character (e) + implicit character(x-y) (f) + implicit integer(z) (g) + implicit character (z) + + a1 = 'Hello' + b1 = 'world' + c1 = 'wibble' + d1 = 'hmmm' + e1 = 'n' + f1 = 'test' + g1 = 1 + x1 = 1.0 + y1 = 2.0 + z1 = 'A' +end + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_2.f90 new file mode 100644 index 000000000..c5b8456c8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/implicit_2.f90 @@ -0,0 +1,6 @@ +! PR 13372 -- we incorrectly added a symbol for p, which broke implicit typing +module t +implicit none +integer, parameter :: F = selected_real_kind(P = 6, R = 37) +end module t + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inline_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inline_1.f90 new file mode 100644 index 000000000..4c05baaaa --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inline_1.f90 @@ -0,0 +1,17 @@ +program gfcbug43 + call try_fit (1) + call try_fit (1) +contains + subroutine try_fit (k) + call fit (1, debug=.true.) + end subroutine try_fit + subroutine fit (k, debug) + logical, intent(in), optional :: debug + do j = 1, 2 + maxerr1 = funk (r ,x1 , x1) + end do + if (debug) then + print *, "help" + end if + end subroutine fit +end program gfcbug43 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inquiry_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inquiry_1.f90 new file mode 100644 index 000000000..12d67fc5e --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/inquiry_1.f90 @@ -0,0 +1,8 @@ +! Check that inquiry functions are allowed as specification expressions. +subroutine inquiry(x1) + implicit none + real, dimension(1:), intent(out) :: x1 + real, dimension(1:size(x1)) :: x3 + x3 = 0 + x1 = x3 +end subroutine diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 new file mode 100644 index 000000000..f67ae57ae --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/io_end.f90 @@ -0,0 +1,9 @@ +! Check we can cope with end labels in IO statements +program m + implicit none + integer i + do while (.true.) + read(*, *, end = 1) i + end do +1 continue +end program m diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-1.f90 new file mode 100644 index 000000000..03cad93a5 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-1.f90 @@ -0,0 +1,8 @@ +! PR fortran/33500 + +subroutine whatever() +logical(kind=1) :: l1, l2, l3 +if ((l1 .and. l2) .neqv. l3) then + l1 = .true. +endif +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-2.f90 new file mode 100644 index 000000000..c31443f94 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/logical-2.f90 @@ -0,0 +1,10 @@ +! Check for operand type validity after gimplification + +subroutine whatever() +logical(kind=1) :: l1 +logical(kind=2) :: l2 +logical(kind=4) :: l3 +if ((l1 .and. l2) .neqv. l3) then + l1 = .true. +endif +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/mloc.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/mloc.f90 new file mode 100644 index 000000000..8d1d754f5 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/mloc.f90 @@ -0,0 +1,8 @@ +! from PR 14928 +! we used to not accept the two argument variant of MINLOC and MAXLOC when +! the MASK keyword was omitted. + real b(10) + integer c(1) + c = minloc(b,b<0) + c = maxloc(b,b>0) +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 new file mode 100644 index 000000000..f727881d7 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_common.f90 @@ -0,0 +1,10 @@ +! We were incorrectly trying to create a variable for the common block itself, +! in addition to the variables it contains. +module FOO + implicit none + integer I + common /C/I +contains + subroutine BAR + end subroutine BAR +end module FOO diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 new file mode 100644 index 000000000..a1ca83a9a --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_expr.f90 @@ -0,0 +1,18 @@ +! This uncovered a bug in the reading/writing of expressions. +module module_expr_1 + integer a +end module + +module module_expr_2 + use module_expr_1 +contains + +subroutine myproc (p) + integer, dimension (a) :: p +end subroutine +end module + +program module_expr + use module_expr_1 + use module_expr_2 +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 new file mode 100644 index 000000000..17386d4b8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_proc.f90 @@ -0,0 +1,14 @@ +! Check module procedures with arguments +module module_proc +contains +subroutine s(p) + integer p +end subroutine +end module + +program test +use module_proc +integer i +call s(i) +end program + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 new file mode 100644 index 000000000..105073596 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/module_result.f90 @@ -0,0 +1,9 @@ +! Result variables in module procedures +module module_result + implicit none +contains +function test () result (res) + integer res + res = 0 +end function +end module diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/name_clash.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/name_clash.f90 new file mode 100644 index 000000000..7b8c0c7d1 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/name_clash.f90 @@ -0,0 +1,9 @@ +! This is the testcase from PR13249. +! the two different entities named AN_EXAMPLE shouldn't conflict + MODULE MOD + INTEGER FOO + END + PROGRAM MAIN + USE MOD + COMMON /FOO/ BAR + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 new file mode 100644 index 000000000..1e0b4a673 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args.f90 @@ -0,0 +1,6 @@ +! This caused problems because we created a symbol for P while +! trying to parse the argument list as a substring reference. +program named_args + implicit none + integer, parameter :: realdp = selected_real_kind(p=8,r=30) +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args_2.f90 new file mode 100644 index 000000000..c2d36eb58 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/named_args_2.f90 @@ -0,0 +1,8 @@ +! this is the reduced testcase from pr13372 +! we wrongly add a symbol "P" to the module +! Currently (2004/06/09) a workaround is in place +! PR 15481 tracks any steps towards a real fix. +module typeSizes +implicit none + integer, parameter :: FourByteReal = selected_real_kind(P = 6, R = 37) +end module typeSizes diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/nested.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/nested.f90 new file mode 100644 index 000000000..1059684dd --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/nested.f90 @@ -0,0 +1,23 @@ +! Program to test the nested functions +program intrinsic_pack + integer, parameter :: val(9) = (/0,0,0,0,9,0,0,0,7/) + integer, dimension(3, 3) :: a + integer, dimension(6) :: b + + a = reshape (val, (/3, 3/)) + b = 0 + b(1:6:3) = pack (a, a .ne. 0); + if (any (b(1:6:3) .ne. (/9, 7/))) call abort + b = pack (a(2:3, 2:3), a(2:3, 2:3) .ne. 0, (/1, 2, 3, 4, 5, 6/)); + if (any (b .ne. (/9, 7, 3, 4, 5, 6/))) call abort + +contains + subroutine tests_with_temp + ! A few tests which involve a temporary + if (any (pack(a, a.ne.0) .ne. (/9, 7/))) call abort + if (any (pack(a, .true.) .ne. val)) call abort + if (size(pack (a, .false.)) .ne. 0) call abort + if (any (pack(a, .false., (/1,2,3/)).ne. (/1,2,3/))) call abort + + end subroutine tests_with_temp +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/noncontinuation_1.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/noncontinuation_1.f new file mode 100644 index 000000000..5921f014d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/noncontinuation_1.f @@ -0,0 +1,3 @@ +! verifies that 0 in column six doesn't start a continuation line +!234567890 + 0 END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 new file mode 100644 index 000000000..8921bcddc --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_1.f90 @@ -0,0 +1,7 @@ +! legal +integer, parameter :: j = huge(j) +integer i + + if (j /= huge(i)) call abort +end + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 new file mode 100644 index 000000000..e480751f1 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_2.f90 @@ -0,0 +1,23 @@ +! Program to test initialization expressions involving subobjects +program parameter_2 + implicit none + type :: SS + integer :: I + integer :: J + end type SS + type :: TT + integer :: N + type (SS), dimension(2) :: o + end type + + type (SS), parameter :: s = SS (1, 2) + type (TT), parameter :: t = TT(42, (/ SS(3, 4), SS(8, 9) /)) + + integer, parameter :: a(2) = (/5, 10/) + integer, parameter :: d1 = s%i + integer, parameter :: d2 = a(2) + integer, parameter :: d4 = t%o(2)%j + + integer q1, q2, q3, q4 + common /c1/q1(d1), q2(d2), q3(a(1)), q4(d4) ! legal +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_3.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_3.f90 new file mode 100644 index 000000000..4f5b0d90b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/parameter_3.f90 @@ -0,0 +1,4 @@ +program tst + write (6,"(a,es15.8)") "2.0**(-0.0) = ",2.0**(-0.0) +end program tst + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr24136.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr24136.f new file mode 100644 index 000000000..87e3c61e0 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr24136.f @@ -0,0 +1,43 @@ + subroutine electra(ro,t,ye,ee,pe,se + a ,eer,eet,per,pet,ser,set,keyps) + implicit real*8 (a-h,o-z) + common /nunu/ nu,dnudr,dnudb,eta,detadnu,nup + data facen,facpr,facs,rg /2.037300d+24,1.358200d+24,1.686304d-10 + 1,8.314339d+07/ + data a1,a2,a3,a4 /2.059815d-03,-7.027778d-03 + 1,4.219747d-02,-1.132427d+00/ + beta=facs*t + b32=b12*beta + u=(f62/f52)**2 + dudnu=2.0d0*u*(df62/f62-df52/f52) + x=beta*u + f=1.0d0+x*(2.5d0+x*(2.0d0+0.5d0*x)) + df=2.5d0+x*(4.0d0+1.5d0*x) + dfdb=u*df + fi32=f32+(f-1.0d0)*f52/u + dfidnu=dfidu*dudnu+df32+(f-1.0d0)*df52/u + dfidb=dfdb*f52/u + dfidbet=dfidb+dfidnu*dnudb + gs=sqrt(g) + dg=0.75d0*gs + dgdb=u*dg + dgdu=beta*dg + gi32=f32+(g-1.0d0)*f52/u + dgidu=(u*dgdu-g+1.0d0)*f52/us + dgidnu=dgidu*dudnu+df32+(g-1.0d0)*df52/u + dgidb=dgdb*f52/u + dgidbet=dgidb+dgidnu*dnudb + dgidroe=dgidnu*dnudr + em=facen*b52*fi32 + demdbet=facen*b32*(2.5d0*fi32+beta*dfidbet) + dpmdbet=facpr*b32*(2.5d0*gi32+beta*dgidbet) + demdroe=facen*b52*dfidroe + dpmdroe=facpr*b52*dgidroe + call divine(nup,fp12,dfp12,s12) + s42=2.0d0 + call divine(nup,fp42,dfp42,s42) + eer=(ye*(demdroe+depdroe)-(em+ep)/ro)/ro + eet=facs*(demdbet+depdbet)/ro + per=ye*(dpmdroe+dppdroe) + pet=facs*(dpmdbet+dppdbet) + end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr26806.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr26806.f90 new file mode 100644 index 000000000..fad5e9d56 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr26806.f90 @@ -0,0 +1,11 @@ +module solv_cap + integer, private, save :: Ng1=0, Ng2=0 +contains + subroutine FourirG(G) + real, intent(in out), dimension(0:,0:) :: G + complex, allocatable, dimension(:,:) :: t + allocate( t(0:2*Ng1-1,0:2*Ng2-1) ) + t(0:Ng1,0:Ng2-1) = G(:,0:Ng2-1) ! Fill one quadrant (one extra row) + t(0:Ng1,Ng2:2*Ng2-1) = G(:,Ng2:1:-1) ! This quadrant using symmetry + end subroutine FourirG +end module solv_cap diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr30147.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr30147.f90 new file mode 100644 index 000000000..b9c1533d5 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr30147.f90 @@ -0,0 +1,14 @@ +MODULE input_cp2k_motion + IMPLICIT NONE + interface + SUBROUTINE keyword_create(variants) + CHARACTER(len=*), DIMENSION(:), & + INTENT(in) :: variants + end subroutine + end interface +CONTAINS + SUBROUTINE create_neb_section() + CALL keyword_create(variants=(/"K"/)) + END SUBROUTINE create_neb_section +END MODULE input_cp2k_motion + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32417.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32417.f90 new file mode 100644 index 000000000..913ce9498 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32417.f90 @@ -0,0 +1,15 @@ +! PR tree-opt/32417 +! this used to crash while running IV-opts +! aff_combination_add_elt was not ready to handle pointers correctly + +SUBROUTINE ONEINTS() + COMMON /INFOA / NAT,NUM + DIMENSION TINT(NUM*NUM,NAT,3,3,3),TINTM(NUM,NUM,NAT,3,3,3) + + CALL TINTS(IC) + DO ID=1,3 + DO IC=1,NAT + TINTM(J,I,IC,IAN,INU,ID) = TINT((I-1)*NUM+J,IC,IAN,INU,ID) + ENDDO + ENDDO +END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32583.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32583.f new file mode 100644 index 000000000..61c9d98b8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32583.f @@ -0,0 +1,40 @@ + subroutine detune(iv,ekk,ep,beta,dtu,dtup,dfac) + implicit real*8 (a-h,o-z) + parameter(npart=64,nmac=1) + parameter(nele=700,nblo=300,nper=16, + &nelb=100,nblz=20000,nzfz=300000,mmul=11) + parameter(nran=280000,ncom=100,mran=500,mpa=6,nrco=5,nema=15) + parameter(mcor=10) + parameter(npos=20000,nlya=10000,ninv=1000,nplo=20000) + parameter(nmon1=600,ncor1=600) + parameter(pieni=1d-17) + parameter(zero=0.0d0,half=0.5d0,one=1.0d0) + parameter(two=2.0d0,three=3.0d0,four=4.0d0) + dimension dfac(10),dtu(2,5),ep(2),beta(2),dtup(2,5,0:4,0:4) + save + pi=four*atan(one) + iv2=2*iv + iv3=iv+1 + vtu1=-ekk*(half**iv2)*dfac(iv2)/pi + dtu1=zero + dtu2=zero + do 10 iv4=1,iv3 + iv5=iv4-1 + iv6=iv-iv5 + vor=one + if(mod(iv6,2).ne.0) vor=-one + vtu2=vor/(dfac(iv5+1)**2)/(dfac(iv6+1)**2)*(beta(1)**iv5)* (beta + + (2)**iv6) + if(iv5.ne.0) then + dtu1=dtu1+vtu2*iv5*(ep(1)**(iv5-1))*(ep(2)**iv6) + dtup(1,iv,iv5-1,iv6)=dtup(1,iv,iv5-1,iv6)+vtu2*iv5*vtu1 + endif + if(iv6.ne.0) then + dtu2=dtu2+vtu2*iv6*(ep(1)**iv5)*(ep(2)**(iv6-1)) + dtup(2,iv,iv5,iv6-1)=dtup(2,iv,iv5,iv6-1)+vtu2*iv6*vtu1 + endif + 10 continue + dtu(1,iv)=dtu(1,iv)+vtu1*dtu1 + dtu(2,iv)=dtu(2,iv)+vtu1*dtu2 + return + end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f new file mode 100644 index 000000000..03896adab --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f @@ -0,0 +1,147 @@ + SUBROUTINE DIMOID(DEN,RLMO,SSQU,STRI,ATMU,IATM,IWHI,MAPT,INAT, + * IATB,L1,L2,M1,M2,NATS,NOSI,NCAT,NSWE) +C + IMPLICIT DOUBLE PRECISION(A-H,O-Z) +C + DIMENSION RLMO(L1,L1),SSQU(L1,L1),STRI(L2),ATMU(NATS),DEN(M2) + DIMENSION IATM(NATS,M1),IWHI(M1+NATS),MAPT(M1),INAT(M1+NATS) + DIMENSION IATB(NATS,M1) +C + PARAMETER (MXATM=500, MXSH=1000, MXGTOT=5000, MXAO=2047) +C + LOGICAL GOPARR,DSKWRK,MASWRK +C + COMMON /INFOA / NAT,ICH,MUL,NUM,NQMT,NE,NA,NB, + * ZAN(MXATM),C(3,MXATM) + COMMON /IOFILE/ IR,IW,IP,IJKO,IJKT,IDAF,NAV,IODA(400) + COMMON /NSHEL / EX(MXGTOT),CS(MXGTOT),CP(MXGTOT),CD(MXGTOT), + * CF(MXGTOT),CG(MXGTOT), + * KSTART(MXSH),KATOM(MXSH),KTYPE(MXSH), + * KNG(MXSH),KLOC(MXSH),KMIN(MXSH), + * KMAX(MXSH),NSHELL + COMMON /OPTLOC/ CVGLOC,MAXLOC,IPRTLO,ISYMLO,IFCORE,NOUTA,NOUTB, + * MOOUTA(MXAO),MOOUTB(MXAO) + COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK + COMMON /RUNLAB/ TITLE(10),A(MXATM),B(MXATM),BFLAB(MXAO) +C +C + DO 920 II=1,M1 + INAT(II) = 0 + 920 CONTINUE +C + + DO 900 IO = NOUTA+1,NUMLOC + IZ = IO - NOUTA + DO 895 II=NST,NEND + ATMU(II) = 0.0D+00 + IATM(II,IZ) = 0 + 895 CONTINUE + IFUNC = 0 + DO 890 ISHELL = 1,NSHELL + IAT = KATOM(ISHELL) + IST = KMIN(ISHELL) + IEN = KMAX(ISHELL) + DO 880 INO = IST,IEN + IFUNC = IFUNC + 1 + IF (IAT.LT.NST.OR.IAT.GT.NEND) GOTO 880 + ZINT = 0.0D+00 + DO 870 II = 1,L1 + ZINT = ZINT + RLMO(II,IO)*SSQU(II,IFUNC) + 870 CONTINUE + ATMU(IAT) = ATMU(IAT) + RLMO(IFUNC,IO)*ZINT + 880 CONTINUE + 890 CONTINUE + IF (MASWRK) WRITE(IW,9010) IZ,(ATMU(II),II=NST,NEND) + 900 CONTINUE +C + NOSI = 0 + DO 700 II=1,M1 + NO=0 + DO 720 JJ=1,NAT + NO = NO + 1 + 720 CONTINUE + 740 CONTINUE + IF (NO.GT.1.OR.NO.EQ.0) THEN + NOSI = NOSI + 1 + IWHI(NOSI) = II + ENDIF + IF (MASWRK) + * WRITE(IW,9030) II,(IATM(J,II),A(IATM(J,II)),J=1,NO) + 700 CONTINUE +C + IF (MASWRK) THEN + WRITE(IW,9035) NOSI + IF (NOSI.GT.0) THEN + WRITE(IW,9040) (IWHI(I),I=1,NOSI) + WRITE(IW,9040) + ELSE + WRITE(IW,9040) + ENDIF + ENDIF +C + CALL DCOPY(L1*L1,RLMO,1,SSQU,1) + CALL DCOPY(M2,DEN,1,STRI,1) +C + IP2 = NOUTA + IS2 = M1+NOUTA-NOSI + DO 695 II=1,NAT + INAT(II) = 0 + 695 CONTINUE +C + DO 690 IAT=1,NAT + DO 680 IORB=1,M1 + IP1 = IORB + NOUTA + IF (IATM(1,IORB).NE.IAT) GOTO 680 + IF (IATM(2,IORB).NE.0) GOTO 680 + INAT(IAT) = INAT(IAT) + 1 + IP2 = IP2 + 1 + CALL DCOPY(L1,SSQU(1,IP1),1,RLMO(1,IP2),1) + CALL ICOPY(NAT,IATM(1,IORB),1,IATB(1,IP2-NOUTA),1) + MAPT(IORB) = IP2-NOUTA + 680 CONTINUE + DO 670 IORB=1,NOSI + IS1 = IWHI(IORB) + NOUTA + IF (IAT.EQ.NAT.AND.IATM(1,IWHI(IORB)).EQ.0) GOTO 675 + IF (IATM(1,IWHI(IORB)).NE.IAT) GOTO 670 + 675 CONTINUE + IS2 = IS2 + 1 + MAPT(IWHI(IORB)) = IS2-NOUTA + 670 CONTINUE + 690 CONTINUE +C + NSWE = 0 + NCAT = 0 + LASP = 1 + NLAST = 0 + DO 620 II=1,NAT + NSWE = NSWE + (IWHI(II)*(IWHI(II)-1))/2 + NCAT = NCAT + 1 + INAT(NCAT) = LASP + NLAST + LASP = INAT(NCAT) + NLAST = IWHI(II) + IWHI(NCAT) = II + 620 CONTINUE +C + DO 610 II=1,NOSI + NCAT = NCAT + 1 + INAT(NCAT) = LASP + NLAST + LASP = INAT(NCAT) + NLAST = 1 + IWHI(NCAT) = 0 + 610 CONTINUE +C + RETURN +C + 8000 FORMAT(/1X,'** MULLIKEN ATOMIC POPULATIONS FOR EACH NON-FROZEN ', + * 'LOCALIZED ORBITAL **') + 9000 FORMAT(/3X,'ATOM',2X,100(I2,1X,A4)) + 9005 FORMAT(1X,'LMO') + 9010 FORMAT(1X,I3,3X,100F7.3) + 9015 FORMAT(/1X,'** ATOMIC POPULATIONS GREATER THAN ',F4.2, + * ' ARE CONSIDERED MAJOR **') + 9020 FORMAT(/2X,'LMO',3X,'MAJOR CONTRIBUTIONS FROM ATOM(S)') + 9030 FORMAT(2X,I3,2X,100(I2,1X,A2,2X)) + 9035 FORMAT(/1X,'NO OF LMOS INVOLVING MORE THAN ONE ATOM =',I3) + 9040 FORMAT(1X,'THESE ARE LMOS :',100I3) +C + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr33276.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr33276.f90 new file mode 100644 index 000000000..0eaac1a49 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr33276.f90 @@ -0,0 +1,27 @@ +! PR fortran/33276 +! this used to crash due to an uninitialized variable in expand_iterator. + +module foo + type buffer_type + integer(kind=kind(1)) :: item_end + character(256) :: string + end type + type textfile_type + type(buffer_type) :: buffer + end type +contains + function rest_of_line(self) result(res) + type(textfile_type) :: self + intent(inout) :: self + character(128) :: res + res = self%buffer%string(self%buffer%item_end+1: ) + end function + + subroutine read_intvec_ptr(v) + integer(kind=kind(1)), dimension(:), pointer :: v + integer(kind=kind(1)) :: dim,f,l,i + + if (dim>0) then; v = (/ (i, i=f,l) /) + end if + end subroutine +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr36078.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr36078.f90 new file mode 100644 index 000000000..b7f0aa3c3 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr36078.f90 @@ -0,0 +1,22 @@ + subroutine foo(func,p,eval) + real(kind=kind(1.0d0)), dimension(3,0:4,0:4,0:4) :: p + logical(kind=kind(.true.)), dimension(5,5,5) :: eval + interface + subroutine func(values,pt) + real(kind=kind(1.0d0)), dimension(:), intent(out) :: values + real(kind=kind(1.0d0)), dimension(:,:), intent(in) :: pt + end subroutine + end interface + real(kind=kind(1.0d0)), dimension(125,3) :: pt + integer(kind=kind(1)) :: n_pt + + n_pt = 1 + pt(1:n_pt,:) = & + reshape( & + pack( & + transpose(reshape(p,(/3,125/))), & + spread(reshape(eval,(/125/)),dim=2,ncopies=3)), & + (/n_pt,3/)) + + end subroutine + end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr37236.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr37236.f new file mode 100644 index 000000000..8f7cc3695 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr37236.f @@ -0,0 +1,82 @@ +C + SUBROUTINE FFTRC (A,N,X,IWK,WK) +C SPECIFICATIONS FOR ARGUMENTS + INTEGER N,IWK(1) + REAL*8 A(N),WK(1) + COMPLEX*16 X(1) +C SPECIFICATIONS FOR LOCAL VARIABLES + INTEGER ND2P1,ND2,I,MTWO,M,IMAX,ND4,NP2,K,NMK,J + REAL*8 RPI,ZERO,ONE,HALF,THETA,TP,G(2),B(2),Z(2),AI, + 1 AR + COMPLEX*16 XIMAG,ALPH,BETA,GAM,S1,ZD + EQUIVALENCE (GAM,G(1)),(ALPH,B(1)),(Z(1),AR),(Z(2),AI), + 1 (ZD,Z(1)) + DATA ZERO/0.0D0/,HALF/0.5D0/,ONE/1.0D0/,IMAX/24/ + DATA RPI/3.141592653589793D0/ +C FIRST EXECUTABLE STATEMENT + IF (N .NE. 2) GO TO 5 +C N EQUAL TO 2 + ZD = DCMPLX(A(1),A(2)) + THETA = AR + TP = AI + X(2) = DCMPLX(THETA-TP,ZERO) + X(1) = DCMPLX(THETA+TP,ZERO) + GO TO 9005 + 5 CONTINUE +C N GREATER THAN 2 + ND2 = N/2 + ND2P1 = ND2+1 +C MOVE A TO X + J = 1 + DO 6 I=1,ND2 + X(I) = DCMPLX(A(J),A(J+1)) + J = J+2 + 6 CONTINUE +C COMPUTE THE CENTER COEFFICIENT + GAM = DCMPLX(ZERO,ZERO) + DO 10 I=1,ND2 + GAM = GAM + X(I) + 10 CONTINUE + TP = G(1)-G(2) + GAM = DCMPLX(TP,ZERO) +C DETERMINE THE SMALLEST M SUCH THAT +C N IS LESS THAN OR EQUAL TO 2**M + MTWO = 2 + M = 1 + DO 15 I=1,IMAX + IF (ND2 .LE. MTWO) GO TO 20 + MTWO = MTWO+MTWO + M = M+1 + 15 CONTINUE + 20 IF (ND2 .EQ. MTWO) GO TO 25 +C N IS NOT A POWER OF TWO, CALL FFTCC + CALL FFTCC (X,ND2,IWK,WK) + GO TO 30 +C N IS A POWER OF TWO, CALL FFT2C + 25 CALL FFT2C (X,M,IWK) + 30 ALPH = X(1) + X(1) = B(1) + B(2) + ND4 = (ND2+1)/2 + IF (ND4 .LT. 2) GO TO 40 + NP2 = ND2 + 2 + THETA = RPI/ND2 + TP = THETA + XIMAG = DCMPLX(ZERO,ONE) +C DECOMPOSE THE COMPLEX VECTOR X +C INTO THE COMPONENTS OF THE TRANSFORM +C OF THE INPUT DATA. + DO 35 K = 2,ND4 + NMK = NP2 - K + S1 = DCONJG(X(NMK)) + ALPH = X(K) + S1 + BETA = XIMAG*(S1-X(K)) + S1 = DCMPLX(DCOS(THETA),DSIN(THETA)) + X(K) = (ALPH+BETA*S1)*HALF + X(NMK) = DCONJG(ALPH-BETA*S1)*HALF + THETA = THETA + TP + 35 CONTINUE + 40 CONTINUE + X(ND2P1) = GAM + 9005 RETURN + END + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f new file mode 100644 index 000000000..5ead135d8 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f @@ -0,0 +1,28 @@ + SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + $ LDVR, MM, M, WORK, INFO ) + DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) + DOUBLE PRECISION X( 2, 2 ) + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ ZERO, X, 2, SCALE, XNORM, IERR ) + CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 ) + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 90 + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + END IF + END IF + CALL DLALN2( .FALSE., 2, 2, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ XNORM, IERR ) + CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+N ), 1 ) + CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, + $ WORK( 1+N2 ), 1 ) + END IF + 90 CONTINUE + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40413.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40413.f90 new file mode 100644 index 000000000..d8fa73d69 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40413.f90 @@ -0,0 +1,46 @@ +module state_matrices + + implicit none + private + + public :: state_matrix_copy + public :: state_matrix_t + public :: matrix_element_t + + type :: matrix_element_t + private + integer, dimension(:), allocatable :: f + end type matrix_element_t + + type :: state_matrix_t + private + type(matrix_element_t), dimension(:), allocatable :: me + end type state_matrix_t + + type :: polarization_t + logical :: polarized = .false. + integer :: spin_type = 0 + integer :: multiplicity = 0 + type(state_matrix_t) :: state + end type polarization_t + +contains + + function polarization_copy (pol_in) result (pol) + type(polarization_t) :: pol + type(polarization_t), intent(in) :: pol_in + !!! type(state_matrix_t) :: state_dummy + pol%polarized = pol_in%polarized + pol%spin_type = pol_in%spin_type + pol%multiplicity = pol_in%multiplicity + !!! state_dummy = state_matrix_copy (pol_in%state) + !!! pol%state = state_dummy + pol%state = state_matrix_copy (pol_in%state) + end function polarization_copy + + function state_matrix_copy (state_in) result (state) + type(state_matrix_t) :: state + type(state_matrix_t), intent(in), target :: state_in + end function state_matrix_copy + +end module state_matrices diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f new file mode 100644 index 000000000..de7664ce6 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f @@ -0,0 +1,18 @@ + SUBROUTINE VROT2(N,DIS) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + PARAMETER(ZERO=0.0D+00) + COMMON /SYMSPD/ PTR(3,144) + DIMENSION DIS(3,2),TMP(3,2) + DO I = 1,3 + TMP1 = ZERO + DO J = 1,3 + TMP1 = TMP1 + PTR(I,N+J) + END DO + TMP(I,1) = TMP1 + END DO + DO I = 1,3 + DIS(I,1) = TMP(I,1) + END DO + RETURN + END + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f90 new file mode 100644 index 000000000..64b129efc --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr40421.f90 @@ -0,0 +1,15 @@ +subroutine pr40421 (j, q, r) + double precision :: q(1,1), r(1,1,3) + save + integer :: i, j, m, n + double precision :: s, t, u + do i=1,2 + do m=1,j + do n=1,1 + s=q(n,m)*r(n,m,1) + t=q(n,m)*r(n,m,2) + u=q(n,m)*r(n,m,3) + end do + end do + end do +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr41654.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr41654.f90 new file mode 100644 index 000000000..aa61905de --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr41654.f90 @@ -0,0 +1,15 @@ +SUBROUTINE SCANBUFR (LBUFRIGNOREERROR, LBOPRPRO, LLSPLIT) +LOGICAL :: LBUFRIGNOREERROR, LBOPRPRO, LLSPLIT +INTEGER :: IBOTYP, IBSTYP +IF ((IBOTYP.eq.0).AND.(IBSTYP.eq.1)) GO TO 251 +IF ((IBOTYP.eq.0).AND.(IBSTYP.eq.3)) GO TO 251 +IF(LBUFRIGNOREERROR) THEN + goto 360 +ENDIF +251 CONTINUE +IF(LBOPRPRO.AND.LLSPLIT) THEN + CALL OBSCREEN +ENDIF +360 CONTINUE +END SUBROUTINE SCANBUFR + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr42781.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr42781.f90 new file mode 100644 index 000000000..952285063 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr42781.f90 @@ -0,0 +1,59 @@ +! ICE with gfortran 4.5 at -O1: +!gfcbug98.f90: In function ‘convert_cof’: +!gfcbug98.f90:36:0: internal compiler error: in pt_solutions_same_restrict_base, +!at tree-ssa-structalias.c:5072 +module foo + implicit none + type t_time + integer :: secs = 0 + end type t_time +contains + elemental function time_cyyyymmddhh (cyyyymmddhh) result (time) + type (t_time) :: time + character(len=10),intent(in) :: cyyyymmddhh + end function time_cyyyymmddhh + + function nf90_open(path, mode, ncid) + character(len = *), intent(in) :: path + integer, intent(in) :: mode + integer, intent(out) :: ncid + integer :: nf90_open + end function nf90_open +end module foo +!============================================================================== +module gfcbug98 + use foo + implicit none + + type t_fileinfo + character(len=10) :: atime = ' ' + end type t_fileinfo + + type t_body + real :: bg(10) + end type t_body +contains + subroutine convert_cof (ifile) + character(len=*) ,intent(in) :: ifile + + character(len=5) :: version + type(t_fileinfo) :: gattr + type(t_time) :: atime + type(t_body),allocatable :: tmp_dat(:) + real ,allocatable :: BDA(:, :, :) + + call open_input + call convert_data + contains + subroutine open_input + integer :: i,j + version = '' + j = nf90_open(ifile, 1, i) + end subroutine open_input + !-------------------------------------------------------------------------- + subroutine convert_data + BDA(1,:,1) = tmp_dat(1)% bg(:) + atime = time_cyyyymmddhh (gattr% atime) + end subroutine convert_data + end subroutine convert_cof +end module gfcbug98 diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45598.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45598.f90 new file mode 100644 index 000000000..b8a883e53 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45598.f90 @@ -0,0 +1,13 @@ +program main +implicit none +character(len=10) :: digit_string = '123456789' +character :: digit_arr(10) +call copy(digit_string, digit_arr) +print '(1x, a1)',digit_arr(1:9) +contains + subroutine copy(in, out) + character, dimension(10) :: in, out + out(1:10) = in(1:10) + end subroutine copy +end program main + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45634.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45634.f90 new file mode 100644 index 000000000..ab0c33ad3 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45634.f90 @@ -0,0 +1,5 @@ + SUBROUTINE RCRDRD (VTYP) + CHARACTER(4), INTENT(OUT) :: VTYP + CHARACTER(1), SAVE :: DBL = "D" + VTYP = DBL + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45738.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45738.f90 new file mode 100644 index 000000000..b0541e357 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr45738.f90 @@ -0,0 +1,11 @@ +PROGRAM TestInfinite + integer(8) :: bit_pattern_NegInf_i8 = -4503599627370496_8 + + integer(8) :: i + real(8) :: r + + r = transfer(bit_pattern_NegInf_i8_p,r) + i = transfer(r,i) + +END PROGRAM TestInfinite + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr49721-1.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr49721-1.f new file mode 100644 index 000000000..9ddd068cb --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr49721-1.f @@ -0,0 +1,9 @@ + PARAMETER( LM=7 ) + PARAMETER( NM=2+2**LM, NV=NM**3 ) + PARAMETER( NR = (8*(NM**3+NM**2+5*NM-23+7*LM))/7 ) + COMMON /X/ U, V, R, A + REAL*8 U(NR),V(NV),R(NR),A(0:3) + DO 20 IT=1,NIT + CALL RESID(U,V,R,N,A) + 20 CONTINUE + END diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr57517.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr57517.f90 new file mode 100644 index 000000000..f32698aa3 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/pr57517.f90 @@ -0,0 +1,13 @@ +SUBROUTINE cal_helicity (uh, ph, phb, wavg, ims, ime, its, ite) + INTEGER, INTENT( IN ) :: ims, ime, its, ite + REAL, DIMENSION( ims:ime), INTENT( IN ) :: ph, phb, wavg + REAL, DIMENSION( ims:ime), INTENT( INOUT ) :: uh + INTEGER :: i + REAL :: zu + DO i = its, ite + zu = (ph(i ) + phb(i)) + (ph(i-1) + phb(i-1)) + IF (wavg(i) .GT. 0) THEN + uh(i) = uh(i) + zu + ENDIF + END DO +END SUBROUTINE cal_helicity diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 new file mode 100644 index 000000000..a8e632b1f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/shape_reshape.f90 @@ -0,0 +1,8 @@ +! This checks that the shape of the SHAPE intrinsic is known. +PROGRAM shape_reshape + INTEGER, ALLOCATABLE :: I(:,:) + ALLOCATE(I(2,2)) + I = RESHAPE((/1,2,3,4/),SHAPE=SHAPE(I)) + DEALLOCATE(I) +END PROGRAM + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 new file mode 100644 index 000000000..9a936f09c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/stoppause.f90 @@ -0,0 +1,10 @@ +! Program to check the STOP and PAUSE intrinsics +program stoppause + + pause + pause 1 + pause 'Hello world' + stop + stop 42 + stop 'Go away' +end program diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 new file mode 100644 index 000000000..9625b10fe --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/strparm_1.f90 @@ -0,0 +1,6 @@ +! Check known length string parameters +subroutine test (s) + character(len=80) :: s + + s = "Hello World" +end subroutine diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/transfer-1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/transfer-1.f90 new file mode 100644 index 000000000..9fa4bfc34 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/transfer-1.f90 @@ -0,0 +1,22 @@ +! Bigendian test posted by Perseus in comp.lang.fortran on 4 July 2005. + integer(1), parameter :: zero = 0 + LOGICAL, PARAMETER :: bigend = IACHAR(TRANSFER(1,"a")) == zero + LOGICAL :: bigendian + call foo () +contains + subroutine foo () + integer :: chr, ans + if (bigend) then + ans = 1 + else + ans = 0 + end if + chr = IACHAR(TRANSFER(1,"a")) + bigendian = chr == 0_4 + if (bigendian) then + ans = 1 + else + ans = 0 + end if + end subroutine foo +end diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/vrp_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/vrp_1.f90 new file mode 100644 index 000000000..a8d0c295c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/vrp_1.f90 @@ -0,0 +1,17 @@ + SUBROUTINE STONUM(STRVAR,LENGTH) + CHARACTER STRVAR*(*) , CHK + LOGICAL MEND , NMARK , MMARK , EMARK + NMARK = .FALSE. + MMARK = .FALSE. + DO WHILE ( .NOT.MEND ) + IF ( CHK.GE.'0' .AND. CHK.LE.'9' ) THEN + IF ( CHK.EQ.'E' ) THEN + NMARK = .TRUE. + ELSEIF ( .NOT.MMARK .AND. CHK.EQ.'*' .AND. .NOT.NMARK ) & + & THEN + MMARK = .TRUE. + ENDIF + ENDIF + ENDDO + END + diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 new file mode 100644 index 000000000..50b83cc6a --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/compile/write.f90 @@ -0,0 +1,5 @@ +! Program to test simple IO +program testwrite + write (*) 1 + write (*) "Hello World" +end program |