diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
21 files changed, 428 insertions, 21 deletions
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 index abcc46e7e39..2d6726af8ba 100644 --- a/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 +++ b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 @@ -81,24 +81,24 @@ end subroutine sub6NoIso ! The subroutines (including entry) should have ! only a char-length parameter if they are not bind(C). ! -! { dg-final { scan-tree-dump "sub1noiso .a, b, _a, _b\\)" "original" } } -! { dg-final { scan-tree-dump "sub2 .a, b\\)" "original" } } -! { dg-final { scan-tree-dump "sub3noiso .a, b, _a, _b\\)" "original" } } -! { dg-final { scan-tree-dump "sub3noisoentry .x, y, z, _x, _z\\)" "original" } } -! { dg-final { scan-tree-dump "sub4iso .a, b\\)" "original" } } -! { dg-final { scan-tree-dump "sub4isoentry .x, y, z, _x, _z\\)" "original" } } -! { dg-final { scan-tree-dump "sub5iso .a, b\\)" "original" } } -! { dg-final { scan-tree-dump "sub5noisoentry .x, y, z, _x, _z\\)" "original" } } -! { dg-final { scan-tree-dump "sub6noiso .a, b, _a, _b\\)" "original" } } -! { dg-final { scan-tree-dump "sub6isoentry .x, y, z, _x, _z\\)" "original" } } +! { dg-final { scan-tree-dump "sub1noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } } +! { dg-final { scan-tree-dump "sub2 \\(\[^.\]*a, \[^.\]*b\\)" "original" } } +! { dg-final { scan-tree-dump "sub3noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } } +! { dg-final { scan-tree-dump "sub3noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } } +! { dg-final { scan-tree-dump "sub4iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } } +! { dg-final { scan-tree-dump "sub4isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } } +! { dg-final { scan-tree-dump "sub5iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } } +! { dg-final { scan-tree-dump "sub5noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } } +! { dg-final { scan-tree-dump "sub6noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } } +! { dg-final { scan-tree-dump "sub6isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } } ! The master functions should have always a length parameter ! to ensure sharing a parameter between bind(C) and non-bind(C) works ! -! { dg-final { scan-tree-dump "master.0.sub3noiso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } } -! { dg-final { scan-tree-dump "master.1.sub4iso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } } -! { dg-final { scan-tree-dump "master.2.sub5iso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } } -! { dg-final { scan-tree-dump "master.3.sub6noiso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } } +! { dg-final { scan-tree-dump "master.0.sub3noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } } +! { dg-final { scan-tree-dump "master.1.sub4iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } } +! { dg-final { scan-tree-dump "master.2.sub5iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } } +! { dg-final { scan-tree-dump "master.3.sub6noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } } ! Thus, the master functions need to be called with length arguments ! present diff --git a/gcc/testsuite/gfortran.dg/continuation_10.f90 b/gcc/testsuite/gfortran.dg/continuation_10.f90 new file mode 100644 index 00000000000..8071dd7b695 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/continuation_10.f90 @@ -0,0 +1,55 @@ +! { dg-do compile } +! { dg-options -std=f95 } +! PR35882 Miscounted continuation lines when interspersed with data +program test_mod + implicit none + + integer, dimension(50) :: array + + array = 1 + + print "(a, i8)", & + "Line 1", & + array(2), & + "Line 3", & + array(4), & + "Line 5", & + array(6), & + "Line 7", & + array(8), & + "Line 9", & + array(10), & + "Line 11", & + array(12), & + "Line 13", & + array(14), & + "Line 15", & + array(16), & + "Line 17", & + array(18), & + "Line 19", & + array(20), & + "Line 21", & + array(22), & + "Line 23", & + array(24), & + "Line 25", & + array(26), & + "Line 27", & + array(28), & + "Line 29", & + array(30), & + "Line 31", & + array(32), & + "Line 33", & + array(34), & + "Line 35", & + array(36), & + "Line 37", & + array(38), & + "Line 39", & + array(40), & ! { dg-warning "Limit of 39 continuations exceeded" } + "Line 41", & + array(42), & + "Line 43" +end program diff --git a/gcc/testsuite/gfortran.dg/continuation_3.f90 b/gcc/testsuite/gfortran.dg/continuation_3.f90 index a7f0d1d1dd1..238f8cc7b8f 100644 --- a/gcc/testsuite/gfortran.dg/continuation_3.f90 +++ b/gcc/testsuite/gfortran.dg/continuation_3.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options -pedantic } +! { dg-options -std=f95 } ! PR 19262 Test limit on line continuations. Test case derived form case in PR ! by Steve Kargl. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> print *, & diff --git a/gcc/testsuite/gfortran.dg/continuation_5.f b/gcc/testsuite/gfortran.dg/continuation_5.f index b0ecd706390..15e06077ff3 100644 --- a/gcc/testsuite/gfortran.dg/continuation_5.f +++ b/gcc/testsuite/gfortran.dg/continuation_5.f @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options -pedantic } +! { dg-options -std=f95 } ! PR 19262 Test limit on line continuations. Test case derived form case in PR ! by Steve Kargl. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org> print *, diff --git a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 new file mode 100644 index 00000000000..6ec14aa053f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 @@ -0,0 +1,37 @@ +! { dg-do run } +! { dg-options "-std=gnu" } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +real :: a(4), b(4) +real :: c +integer :: istat, j +character(25) :: msg + +a = 23.45 +b = 0.0 +open(10, file='mydata', asynchronous="yes", blank="null") + +write(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=j) a +rewind(10) +read(10,'(10f8.3)', asynchronous="yes", decimal="comma", blank="zero") b +if (any(b.ne.23.45)) call abort + +c = 3.14 +write(msg, *, decimal="comma") c +if (msg(1:7).ne." 3,14") call abort + +b = 0.0 +rewind(10) +write(10,'(10f8.3)', asynchronous="yes", decimal="point") a +rewind(10) +read(10,'(10f8.3)', asynchronous="yes", decimal="point") b +if (any(b.ne.23.45)) call abort + +wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=j) + +! do some stuff with a +25 continue + +35 continue + +close(10, status="delete") +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_2.f03 b/gcc/testsuite/gfortran.dg/f2003_io_2.f03 new file mode 100644 index 00000000000..54c0516dfed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_2.f03 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> + +integer :: istat, idvar +character(25) :: msg +real, dimension(10) :: a, b + +a = 43.21 +open(10, file='mydata', asynchronous="yes") +write(10,'(10f8.3)', asynchronous="yes", decimal="comma") a +rewind(10) +read(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=idvar) b +istat = 123456 +wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=idvar) + +print *, istat + +25 continue + +35 continue +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_3.f03 b/gcc/testsuite/gfortran.dg/f2003_io_3.f03 new file mode 100644 index 00000000000..5b3fb59b0d7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_3.f03 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> + +integer :: istat +character(25) :: msg +real, dimension(10) :: a, b +namelist /mynml/ a, b +msg = "null" +a = 43.21 +WRITE(99,'(10f8.3)',decimal="comma") a +rewind(99) +read(99,'(dc,10f8.3)',blank=msg) b +write(99,'(dp,10f8.3)',round="up") ! { dg-error "not implemented" } +rewind(99) +read(99,'(10f8.3)',pad="yes") +msg="suppress" +write(99,'(10f8.3)',sign=msg) +write(99,delim="apostrophe", fmt=*) +write(99,nml=mynml,delim="none") +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 new file mode 100644 index 00000000000..d253a81bb64 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 @@ -0,0 +1,33 @@ +! { dg-do run } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +! Test of decimal= feature + +integer :: istat +character(80) :: msg +real, dimension(4) :: a, b, c +namelist /mynml/ a, b +msg = "yes" +a = 43.21 +b = 3.131 +c = 5.432 +open(99, decimal="comma") +write(99,'(10f8.3)') a +a = 0.0 +rewind(99) +read(99,'(10f8.3)') a +if (any(a.ne.43.21)) call abort + +write(msg,'(dp,f8.3,dc,f8.2,dp,f8.3)', decimal="comma") a(1), b(1), c(1) +if (trim(msg).ne." 43.210 3,13 5.432") call abort + +close(99, status="delete") +open(99, decimal="comma") +write(99,nml=mynml) +a = 0.0 +b = 0.0 +rewind(99) +read(99,nml=mynml) +if (any(a.ne.43.21)) call abort +if (any(b.ne.3.131)) call abort +close(99, status="delete") +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 new file mode 100644 index 00000000000..b816ded69c5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 @@ -0,0 +1,26 @@ +! { dg-do run } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +! Test of decimal="comma" in namelist and complex +integer :: i +real :: a(10) = [ (i*1.3, i=1,10) ] +real :: b(10) +complex :: c +character(34) :: complex +namelist /nm/ a + +open(99,file="mynml",form="formatted",decimal="point",status="replace") +write(99,nml=nm,decimal="comma") +a = 5.55 +rewind(99) +read(99,nml=nm,decimal="comma") +if (any (a /= [ (i*1.3, i=1,10) ])) call abort +close(99, status="delete") + +c = (3.123,4.456) +write(complex,*,decimal="comma") c +if (complex.ne." ( 3,1229999 ; 4,4559999 )") call abort +c = (0.0, 0.0) +read(complex,*,decimal="comma") c +if (complex.ne." ( 3,1229999 ; 4,4559999 )") call abort + +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_6.f03 b/gcc/testsuite/gfortran.dg/f2003_io_6.f03 new file mode 100644 index 00000000000..40758e2232d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_6.f03 @@ -0,0 +1,11 @@ +! { dg-do run } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +! Test of decimal="comma" in namelist, checks separators +implicit none +integer :: i +real :: a(6) = 0.0 +character(len=30) :: str = '&nm a = 1,3; 4, 5; 5; 7; /' +namelist /nm/ a +read(str,nml=nm,decimal='comma') +if (any(a.ne.[ 1.3, 4.0, 5.0, 5.0, 7.0, 0.0 ])) call abort +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_7.f03 b/gcc/testsuite/gfortran.dg/f2003_io_7.f03 new file mode 100644 index 00000000000..6d2c11dfcbe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_7.f03 @@ -0,0 +1,27 @@ +! { dg-do run } +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +! Test of sign=, decimal=, and blank= . +program iotests + implicit none + character(len=45) :: a + character(len=4) :: mode = "what" + real, parameter :: pi = 3.14159265358979323846 + real(kind=8), dimension(3) :: b + ! + write(a,'(f10.3,s,f10.3,sp,f10.3,ss,f10.3)',SIGN='PLUS') pi, pi, pi, pi + if (a /= " +3.142 3.142 +3.142 3.142") call abort + ! + open(8,sign="plus") + write(8,'(f10.3,dc,f10.3,dp,f10.3)',DECIMAL='COMMA',& + & sign="suppress") pi, pi, pi + rewind(8) + read(8,'(a)') a + if (a /= " 3,142 3,142 3.142") call abort + close(8,status="delete") + ! + ! "123456789 123456789 12345678901 + write(a,'(a)') "53 256.84, 2 2 2. ; 33.3 3 1 " + read(a, '(f9.2,1x,f8.2,2x,f11.7)', blank="zero") b(1),b(2),b(3) + if (any(abs(b - [530256.84, 20202.00, 33.3030001]) > .03)) call abort +end program iotests + diff --git a/gcc/testsuite/gfortran.dg/f2003_io_8.f03 b/gcc/testsuite/gfortran.dg/f2003_io_8.f03 new file mode 100644 index 00000000000..2362697c6bb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_io_8.f03 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-std=gnu" } +! +real :: a(4), b(4) +real :: c +integer :: istat, j +character(25) :: msg + +open(10, file='mydata', asynchronous="yes", blank="null") +write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" } +read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" } +read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "must be an initialization expression" } +end diff --git a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 b/gcc/testsuite/gfortran.dg/internal_pack_1.f90 index 6c3781ba9b2..aded78dc26a 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_1.f90 @@ -11,6 +11,11 @@ program main real(kind=8), dimension(3) :: r8 complex(kind=4), dimension(3) :: c4 complex(kind=8), dimension(3) :: c8 + type i8_t + sequence + integer(kind=8) :: v + end type i8_t + type(i8_t), dimension(3) :: d_i8 i1 = (/ -1, 1, -3 /) call sub_i1(i1(1:3:2)) @@ -46,6 +51,10 @@ program main if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort if (any(aimag(c8) /= 0._4)) call abort + d_i8%v = (/ -1, 1, -3 /) + call sub_d_i8(d_i8(1:3:2)) + if (any(d_i8%v /= (/ 3, 1, 2 /))) call abort + end program main subroutine sub_i1(i) @@ -113,3 +122,15 @@ subroutine sub_c4(r) r(1) = 3._4 r(2) = 2._4 end subroutine sub_c4 + +subroutine sub_d_i8(i) + type i8_t + sequence + integer(kind=8) :: v + end type i8_t + type(i8_t), dimension(2) :: i + if (i(1)%v /= -1) call abort + if (i(2)%v /= -3) call abort + i(1)%v = 3 + i(2)%v = 2 +end subroutine sub_d_i8 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 index e464503c963..22d110ba77c 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 @@ -29,6 +29,34 @@ program main integer(kind=8), dimension(9) :: vi8 integer(kind=8), dimension(9) :: ri8 + type i1_t + integer(kind=1) :: v + end type i1_t + type(i1_t), dimension(3,3) :: d_i1 + type(i1_t), dimension(9) :: d_vi1 + type(i1_t), dimension(9) :: d_ri1 + + type i4_t + integer(kind=4) :: v + end type i4_t + type(i4_t), dimension(3,3) :: d_i4 + type(i4_t), dimension(9) :: d_vi4 + type(i4_t), dimension(9) :: d_ri4 + + d_vi1%v = (/(i+10,i=1,9)/) + d_i1%v = reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, & + & -4_1, 5_1/), shape(i1)) + d_ri1 = pack(d_i1,d_i1%v>0,d_vi1) + if (any(d_ri1%v /= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) & + & call abort + + d_vi4%v = (/(i+10,i=1,9)/) + d_i4%v = reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, & + & -4_4, 5_4/), shape(d_i4)) + d_ri4 = pack(d_i4,d_i4%v>0,d_vi4) + if (any(d_ri4%v /= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) & + & call abort + vr4 = (/(i+10,i=1,9)/) r4 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, & & -7.1_4, -9.9_4, 0.3_4 /), shape(r4)) diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 index 1fe09d478bb..04e4c577ac6 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 @@ -25,6 +25,14 @@ program foo complex(kind=8), dimension (10) :: c_8 complex(kind=8), dimension (2, 3) :: ac_8 complex(kind=8), dimension (2, 2, 3) :: bc_8 + type i4_t + integer(kind=4) :: v + end type i4_t + type(i4_t), dimension (10) :: it_4 + type(i4_t), dimension (2, 3) :: at_4 + type(i4_t), dimension (2, 2, 3) :: bt_4 + type(i4_t) :: iv_4 + character (len=200) line1, line2, line3 a_1 = reshape ((/1_1, 2_1, 3_1, 4_1, 5_1, 6_1/), (/2, 3/)) @@ -159,6 +167,17 @@ program foo c_8 = spread((1._8,-1._8),1,10) if (any(c_8 /= (1._8,-1._8))) call abort + + at_4%v = reshape ((/1_4, 2_4, 3_4, 4_4, 5_4, 6_4/), (/2, 3/)) + bt_4 = spread (at_4, 1, 2) + if (any (bt_4%v .ne. reshape ((/1_4, 1_4, 2_4, 2_4, 3_4, 3_4, 4_4, & + & 4_4, 5_4, 5_4, 6_4, 6_4/), (/2, 2, 3/)))) & + call abort + iv_4%v = 123_4 + it_4 = spread(iv_4,1,10) + if (any(it_4%v /= 123_4)) call abort + + 9000 format(12I3) 9010 format(12F7.3) 9020 format(25F7.3) diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 index 71cce798ca5..47b9aef2e3f 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 @@ -10,6 +10,12 @@ program intrinsic_unpack real(kind=8), dimension(3,3) :: ar8, br8 complex(kind=4), dimension(3,3) :: ac4, bc4 complex(kind=8), dimension(3,3) :: ac8, bc8 + type i4_t + integer(kind=4) :: v + end type i4_t + type(i4_t), dimension(3,3) :: at4, bt4 + type(i4_t), dimension(3) :: vt4 + logical, dimension(3, 3) :: mask character(len=500) line1, line2 integer i @@ -116,4 +122,14 @@ program intrinsic_unpack mask, ac8) if (line1 .ne. line2) call abort + at4%v = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/)); + vt4%v = (/2_4, 3_4, 4_4/) + bt4 = unpack (vt4, mask, at4) + if (any (bt4%v .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) & + call abort + bt4%v = -1 + bt4 = unpack (vt4, mask, i4_t(0_4)) + if (any (bt4%v .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) & + call abort + end program diff --git a/gcc/testsuite/gfortran.dg/io_constraints_1.f90 b/gcc/testsuite/gfortran.dg/io_constraints_1.f90 index 05f52faae76..5f2c776b128 100644 --- a/gcc/testsuite/gfortran.dg/io_constraints_1.f90 +++ b/gcc/testsuite/gfortran.dg/io_constraints_1.f90 @@ -62,7 +62,7 @@ end module global !Was correctly picked up before patch. write(1, fmt='(i6)', eor = 100) a ! { dg-error "EOR tag" } !Was correctly picked up before patch. - write(1, fmt='(i6)', size = b) a ! { dg-error "SIZE=specifier not allowed" } + write(1, fmt='(i6)', size = b) a ! { dg-error "SIZE= specifier not allowed" } READ(1, fmt='(i6)', end = 900) a ! { dg-error "not defined" } diff --git a/gcc/testsuite/gfortran.dg/io_constraints_2.f90 b/gcc/testsuite/gfortran.dg/io_constraints_2.f90 index fa6cbdbca6b..8bf48d72ff2 100644 --- a/gcc/testsuite/gfortran.dg/io_constraints_2.f90 +++ b/gcc/testsuite/gfortran.dg/io_constraints_2.f90 @@ -66,7 +66,7 @@ end module global READ(1, fmt='(i6)', advance='NO', size = buffer) a ! { dg-error "INTEGER" } !Was correctly picked up before patch. -correct syntax error - READ(1, fmt='(i6)', advance='YES', size = 10) a ! { dg-error "Syntax error" } + READ(1, fmt='(i6)', advance='YES', size = 10) a ! { dg-error "Invalid value for SIZE specification" } READ(1, fmt='(i6)', advance='MAYBE') ! { dg-error "YES or NO" } diff --git a/gcc/testsuite/gfortran.dg/namelist_47.f90 b/gcc/testsuite/gfortran.dg/namelist_47.f90 new file mode 100644 index 00000000000..bc9110fa3cd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_47.f90 @@ -0,0 +1,52 @@ +! { dg-do run } + +module nml_47 + type :: mt + character(len=2) :: c012345678901234567890123456789012345678901234567890123456789h(2) = (/"aa","bb"/) + end type mt + type :: bt + integer :: i(2) = (/1,2/) + type(mt) :: m(2) + end type bt +end module nml_47 + +program namelist_47 + use nml_47 + type(bt) :: x(2) + character(140) :: teststring + namelist /mynml/ x + + teststring = " x(2)%m%c012345678901234567890123456789012345678901234567890123456789h(:)(2:2) = 'z','z'," + call writenml (teststring) + teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(:)(2) = 'z','z'," + call writenml (teststring) + teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(:)(:3) = 'z','z'," + call writenml (teststring) + teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(1:2)(k:) = 'z','z'," + call writenml (teststring) + +contains + +subroutine writenml (astring) + character(140), intent(in) :: astring + character(300) :: errmessage + integer :: ierror + + open (10, status="scratch", delim='apostrophe') + write (10, '(A)') "&MYNML" + write (10, '(A)') astring + write (10, '(A)') "/" + rewind (10) + read (10, nml = mynml, iostat=ierror, iomsg=errmessage) + if (ierror == 0) call abort + print '(a)', trim(errmessage) + close (10) + +end subroutine writenml + +end program namelist_47 +! { dg-output "Multiple sub-objects with non-zero rank in namelist object x(\n|\r\n|\r)" } +! { dg-output "Missing colon in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" } +! { dg-output "Substring out of range for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" } +! { dg-output "Bad character in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" } +! { dg-final { cleanup-modules "nml_47" } } diff --git a/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 new file mode 100644 index 00000000000..933b1f32af7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! Tests the fix for PR35780, in which the assignment for C was not +! scalarized in expr.c. +! +! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com> +! +MODULE MODS + integer, parameter :: N = 10 + INTEGER, PARAMETER, DIMENSION(N) :: A = [(i, i = 1, N)] + INTEGER, PARAMETER, DIMENSION(N) :: B = [(i - 5, i = 1, N)] + INTEGER, PARAMETER, DIMENSION(N) :: C = ISHFTC(3, B, 5) !ICE + INTEGER, PARAMETER, DIMENSION(N) :: D = ISHFTC(A, 3, 5) ! OK + INTEGER, PARAMETER, DIMENSION(N) :: E = ISHFTC(A, B, 5) ! OK + +END MODULE MODS + + use mods + integer, dimension(N) :: X = A + integer, dimension(N) :: Y = B + +! Check the simplifed expressions against the library + if (any (ISHFTC(3, Y, 5) /= C)) call abort () + if (any (ISHFTC(X, 3, 5) /= D)) call abort () + if (any (ISHFTC(X, Y, 5) /= E)) call abort () +end +! { dg-final { cleanup-modules "mods" } } diff --git a/gcc/testsuite/gfortran.dg/write_check2.f90 b/gcc/testsuite/gfortran.dg/write_check2.f90 index 52f32bb121c..1447f8d14f9 100644 --- a/gcc/testsuite/gfortran.dg/write_check2.f90 +++ b/gcc/testsuite/gfortran.dg/write_check2.f90 @@ -4,7 +4,7 @@ character(len=20) :: str write(13,'(a)',advance='yes') 'Hello:' write(13,'(a)',advance='no') 'Hello:' - write(13,'(a)',advance='y') 'Hello:' ! { dg-error "ADVANCE=specifier at \\(1\\) must have value = YES or NO." } - write(13,'(a)',advance='yet') 'Hello:' ! { dg-error "ADVANCE=specifier at \\(1\\) must have value = YES or NO." } - write(13,'(a)',advance='yess') 'Hello:' ! { dg-error "ADVANCE=specifier at \\(1\\) must have value = YES or NO." } + write(13,'(a)',advance='y') 'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." } + write(13,'(a)',advance='yet') 'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." } + write(13,'(a)',advance='yess') 'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." } end |