aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
-rw-r--r--gcc/testsuite/gfortran.dg/derived_init_4.f9060
-rw-r--r--gcc/testsuite/gfortran.dg/execute_command_line_3.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/graphite/id-27.f9040
-rw-r--r--gcc/testsuite/gfortran.dg/graphite/id-28.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/graphite/pr82449.f11
-rw-r--r--gcc/testsuite/gfortran.dg/graphite/pr82451.f39
-rw-r--r--gcc/testsuite/gfortran.dg/illegal_char.f906
7 files changed, 195 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/derived_init_4.f90 b/gcc/testsuite/gfortran.dg/derived_init_4.f90
new file mode 100644
index 00000000000..114975150aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_4.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! Test the fix for PR81048, where in the second call to 'g2' the
+! default initialization was "forgotten". 'g1', 'g1a' and 'g3' check
+! that this does not occur for scalars and explicit results.
+!
+! Contributed by David Smith <dm577216smith@gmail.com>
+!
+program test
+ type f
+ integer :: f = -1
+ end type
+ type(f) :: a, b(3)
+ type(f), allocatable :: ans
+ b = g2(a)
+ b = g2(a)
+ ans = g1(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1a(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1a(a)
+ if (ans%f .ne. -1) call abort
+ b = g3(a)
+ b = g3(a)
+contains
+ function g3(a) result(res)
+ type(f) :: a, res(3)
+ do j = 1, 3
+ if (res(j)%f == -1) then
+ res(j)%f = a%f - 1
+ else
+ call abort
+ endif
+ enddo
+ end function g3
+
+ function g2(a)
+ type(f) :: a, g2(3)
+ do j = 1, 3
+ if (g2(j)%f == -1) then
+ g2(j)%f = a%f - 1
+ else
+ call abort
+ endif
+ enddo
+ end function g2
+
+ function g1(a)
+ type(f) :: g1, a
+ if (g1%f .ne. -1 ) call abort
+ end function
+
+ function g1a(a) result(res)
+ type(f) :: res, a
+ if (res%f .ne. -1 ) call abort
+ end function
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/execute_command_line_3.f90 b/gcc/testsuite/gfortran.dg/execute_command_line_3.f90
new file mode 100644
index 00000000000..87d73d1b50f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/execute_command_line_3.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR 82233 - there were program aborts for some of these commands.
+! Original test case by Urban Jost.
+program boom
+implicit none
+integer :: i,j
+character(len=256) :: msg
+character(len=:), allocatable :: command
+ command='notthere'
+ msg='' ! seems to only be defined if exitstatus.ne.0
+ ! ok -- these work
+ call execute_command_line(command , wait=.false., exitstat=i, cmdstat=j, cmdmsg=msg)
+ if (j /= 0 .or. msg /= '') call abort
+ call execute_command_line(command , exitstat=i, cmdstat=j, cmdmsg=msg )
+ if (j /= 3 .or. msg /= "Invalid command line" ) call abort
+ msg = ''
+ call execute_command_line(command , wait=.false., exitstat=i, cmdmsg=msg )
+ print *,msg
+ if (msg /= '') call abort
+ call execute_command_line(command , exitstat=i, cmdstat=j )
+ if (j /= 3) call abort
+ call execute_command_line(command , wait=.false., exitstat=i )
+
+end program boom
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-27.f90 b/gcc/testsuite/gfortran.dg/graphite/id-27.f90
new file mode 100644
index 00000000000..e1e7ec0951f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-27.f90
@@ -0,0 +1,40 @@
+! { dg-additional-options "-Ofast" }
+MODULE module_ra_gfdleta
+ INTEGER, PARAMETER :: NBLY=15
+ REAL , SAVE :: EM1(28,180),EM1WDE(28,180),TABLE1(28,180), &
+ TABLE2(28,180),TABLE3(28,180),EM3(28,180), &
+ SOURCE(28,NBLY), DSRCE(28,NBLY)
+CONTAINS
+ SUBROUTINE TABLE
+ INTEGER, PARAMETER :: NBLX=47
+ INTEGER , PARAMETER:: NBLW = 163
+ REAL :: &
+ SUM(28,180),PERTSM(28,180),SUM3(28,180), &
+ SUMWDE(28,180),SRCWD(28,NBLX),SRC1NB(28,NBLW), &
+ DBDTNB(28,NBLW)
+ REAL :: &
+ ZMASS(181),ZROOT(181),SC(28),DSC(28),XTEMV(28), &
+ TFOUR(28),FORTCU(28),X(28),X1(28),X2(180),SRCS(28), &
+ R1T(28),R2(28),S2(28),T3(28),R1WD(28)
+ REAL :: EXPO(180),FAC(180)
+ I = 0
+ DO 417 J=121,180
+ FAC(J)=ZMASS(J)*(ONE-(ONE+X2(J))*EXPO(J))/(X2(J)*X2(J))
+417 CONTINUE
+ DO 421 J=121,180
+ SUM3(I,J)=SUM3(I,J)+DBDTNB(I,N)*FAC(J)
+421 CONTINUE
+ IF (CENT.GT.160. .AND. CENT.LT.560.) THEN
+ DO 420 J=1,180
+ DO 420 I=1,28
+ SUMWDE(I,J)=SUMWDE(I,J)+SRC1NB(I,N)*EXPO(J)
+420 CONTINUE
+ ENDIF
+ DO 433 J=121,180
+ EM3(I,J)=SUM3(I,J)/FORTCU(I)
+433 CONTINUE
+ DO 501 I=1,28
+ EM1WDE(I,J)=SUMWDE(I,J)/TFOUR(I)
+501 CONTINUE
+ END SUBROUTINE TABLE
+ END MODULE module_RA_GFDLETA
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-28.f90 b/gcc/testsuite/gfortran.dg/graphite/id-28.f90
new file mode 100644
index 00000000000..d66cb12006e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-28.f90
@@ -0,0 +1,15 @@
+! Verify we elide modulo operations we cannot represent
+module OPMATRIX_MODULE
+ implicit none
+ type opmatrix_type
+ real(kind=kind(1.0d0)), dimension(:,:), pointer :: restricted
+ end type
+ interface zero_
+ module procedure zero
+ end interface
+contains
+ subroutine zero(self)
+ type(opmatrix_type) :: self
+ self%restricted = 0.0d0
+ end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr82449.f b/gcc/testsuite/gfortran.dg/graphite/pr82449.f
new file mode 100644
index 00000000000..974ea206d41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr82449.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2 -floop-nest-optimize" }
+
+ SUBROUTINE JDFIDX(MKL,KGSH)
+ DIMENSION MKL(6,6)
+ NKL=0
+ 400 DO 40 KG = 1,KGSH
+ DO 40 LG = 1,KG
+ NKL = NKL + 1
+ 40 MKL(LG,KG) = NKL
+ END
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr82451.f b/gcc/testsuite/gfortran.dg/graphite/pr82451.f
new file mode 100644
index 00000000000..88ff85b1a99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr82451.f
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-O2 -floop-nest-optimize" }
+ MODULE LES3D_DATA
+ PARAMETER ( NSCHEME = 4, ICHEM = 0, ISGSK = 0, IVISC = 1 )
+ DOUBLE PRECISION DT, TIME, STATTIME, CFL, RELNO, TSTND, ALREF
+ INTEGER IDYN, IMAX, JMAX, KMAX
+ PARAMETER( RUNIV = 8.3145D3,
+ > TPRANDLT = 0.91D0)
+ DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:) ::
+ > U, V, W, P, T, H, EK,
+ > UAV, VAV, WAV, PAV, TAV, HAV, EKAV
+ DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:) ::
+ > CONC, HF, QAV, COAV, HFAV, DU
+ DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:,:) ::
+ > Q
+ END MODULE LES3D_DATA
+ SUBROUTINE FLUXJ()
+ USE LES3D_DATA
+ ALLOCATABLE QS(:), FSJ(:,:,:)
+ ALLOCATABLE DWDX(:),DWDY(:),DWDZ(:)
+ ALLOCATABLE DHDY(:), DKDY(:)
+ PARAMETER ( R12I = 1.0D0 / 12.0D0,
+ > TWO3 = 2.0D0 / 3.0D0 )
+ ALLOCATE( QS(IMAX-1), FSJ(IMAX-1,0:JMAX-1,ND))
+ ALLOCATE( DWDX(IMAX-1),DWDY(IMAX-1),DWDZ(IMAX-1))
+ I1 = 1
+ DO K = K1,K2
+ DO J = J1,J2
+ DO I = I1, I2
+ FSJ(I,J,5) = FSJ(I,J,5) + PAV(I,J,K) * QS(I)
+ END DO
+ DO I = I1, I2
+ DWDX(I) = DXI * R12I * (WAV(I-2,J,K) - WAV(I+2,J,K) +
+ > 8.0D0 * (WAV(I+1,J,K) - WAV(I-1,J,K)))
+ END DO
+ END DO
+ END DO
+ DEALLOCATE( QS, FSJ, DHDY, DKDY)
+ END
diff --git a/gcc/testsuite/gfortran.dg/illegal_char.f90 b/gcc/testsuite/gfortran.dg/illegal_char.f90
new file mode 100644
index 00000000000..597c7b98ddd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/illegal_char.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 82372 - show hexcode of illegal, non-printable characters
+program main
+ tmp =È 1.0 ! { dg-error "Invalid character 0xC8" }
+ print *,tmp
+end
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-15 14:25:39 +0000