diff options
Diffstat (limited to 'gcc/testsuite')
| -rw-r--r-- | gcc/testsuite/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90 | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90 | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/fgetc_1.f90 | 39 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/fgetc_2.f90 | 39 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/fgetc_3.f90 | 34 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ftell_1.f90 | 13 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ftell_2.f90 | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gnu_logical_1.F | 91 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gnu_logical_2.f90 | 29 |
10 files changed, 277 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 805aa20..ae3265f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2005-11-13 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * gfortran.dg/complex_intrinsic_1.f90: New test. + * gfortran.dg/complex_intrinsic_2.f90: New test. + * gfortran.dg/fgetc_1.f90: New test. + * gfortran.dg/fgetc_2.f90: New test. + * gfortran.dg/fgetc_3.f90: New test. + * gfortran.dg/ftell_1.f90: New test. + * gfortran.dg/ftell_2.f90: New test. + * gfortran.dg/gnu_logical_1.F: New test. + * gfortran.dg/gnu_logical_2.f90: New test. + 2005-11-13 Andrew Pinski <pinskia@physics.uc.edu> PR middle-end/24820 diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90 new file mode 100644 index 0000000..3c29915 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90 @@ -0,0 +1,5 @@ +! Testcase for the COMPLEX intrinsic +! { dg-do run } + if (complex(1_1, -1_2) /= complex(1.0_4, -1.0_8)) call abort + if (complex(1_4, -1.0) /= complex(1.0_4, -1_8)) call abort + end diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90 new file mode 100644 index 0000000..1327e4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90 @@ -0,0 +1,7 @@ +! Testcase for the COMPLEX intrinsic +! { dg-do compile } + complex c + c = complex(.true.,1.0) ! { dg-error "must be INTEGER or REAL" } + c = complex(1) ! { dg-error "Missing actual argument" } + c = complex(1,c) ! { dg-error "must be INTEGER or REAL" } + end diff --git a/gcc/testsuite/gfortran.dg/fgetc_1.f90 b/gcc/testsuite/gfortran.dg/fgetc_1.f90 new file mode 100644 index 0000000..966e15a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fgetc_1.f90 @@ -0,0 +1,39 @@ +! Testcase for the FGETC and FPUTC intrinsics +! { dg-do run } + character(len=5) s + integer st + + s = "12345" + open(10,status="scratch") + write(10,"(A)") "abcde" + rewind(10) + call fgetc(10,s,st) + if ((st /= 0) .or. (s /= "a ")) call abort + call fgetc(10,s,st) + close(10) + + open(10,status="scratch") + s = "12345" + call fputc(10,s,st) + if (st /= 0) call abort + call fputc(10,"2",st) + if (st /= 0) call abort + call fputc(10,"3 ",st) + if (st /= 0) call abort + rewind(10) + call fgetc(10,s) + if (s(1:1) /= "1") call abort + call fgetc(10,s) + if (s(1:1) /= "2") call abort + call fgetc(10,s,st) + if ((s(1:1) /= "3") .or. (st /= 0)) call abort + call fgetc(10,s,st) + if (st /= -1) call abort + close (10) + +! FGETC and FPUTC on units not opened should not work + call fgetc(12,s,st) + if (st /= -1) call abort + call fputc(12,s,st) + if (st /= -1) call abort + end diff --git a/gcc/testsuite/gfortran.dg/fgetc_2.f90 b/gcc/testsuite/gfortran.dg/fgetc_2.f90 new file mode 100644 index 0000000..6dd12c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fgetc_2.f90 @@ -0,0 +1,39 @@ +! Testcase for the FGETC and FPUTC intrinsics +! { dg-do run } + character(len=5) s + integer st + + s = "12345" + open(10,status="scratch") + write(10,"(A)") "abcde" + rewind(10) + st = fgetc(10,s) + if ((st /= 0) .or. (s /= "a ")) call abort + st = fgetc(10,s) + close(10) + + open(10,status="scratch") + s = "12345" + st = fputc(10,s) + if (st /= 0) call abort + st = fputc(10,"2") + if (st /= 0) call abort + st = fputc(10,"3 ") + if (st /= 0) call abort + rewind(10) + st = fgetc(10,s) + if (s(1:1) /= "1") call abort + st = fgetc(10,s) + if (s(1:1) /= "2") call abort + st = fgetc(10,s) + if ((s(1:1) /= "3") .or. (st /= 0)) call abort + st = fgetc(10,s) + if (st /= -1) call abort + close (10) + +! FGETC and FPUTC on units not opened should not work + st = fgetc(12,s) + if (st /= -1) call abort + st = fputc(12,s) + if (st /= -1) call abort + end diff --git a/gcc/testsuite/gfortran.dg/fgetc_3.f90 b/gcc/testsuite/gfortran.dg/fgetc_3.f90 new file mode 100644 index 0000000..3706b67a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fgetc_3.f90 @@ -0,0 +1,34 @@ +! Testcase for the FGETC and FPUTC intrinsics +! { dg-do compile } + character(len=5) s + integer st + + s = "12345" + open(status="scratch") + write(*,"(A)") "abcde" + rewind(10) + st = fget(s) + if ((st /= 0) .or. (s /= "a ")) call abort + st = fget(s) + close(10) + + open(status="scratch") + s = "12345" + st = fput(s) + if (st /= 0) call abort + st = fput("2") + if (st /= 0) call abort + st = fput("3 ") + if (st /= 0) call abort + rewind(10) + st = fget(s) + if (s(1:1) /= "1") call abort + st = fget(s) + if (s(1:1) /= "2") call abort + st = fget(s) + if ((s(1:1) /= "3") .or. (st /= 0)) call abort + st = fget(s) + if (st /= -1) call abort + close (10) + + end diff --git a/gcc/testsuite/gfortran.dg/ftell_1.f90 b/gcc/testsuite/gfortran.dg/ftell_1.f90 new file mode 100644 index 0000000..bd154f1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ftell_1.f90 @@ -0,0 +1,13 @@ +! { dg-do run } + integer*8 o + + open (10, status="scratch") + call ftell (10, o) + if (o /= 0) call abort + write (10,"(A)") "1234567" + call ftell (10, o) + if (o /= 8) call abort + close (10) + call ftell (10, o) + if (o /= -1) call abort + end diff --git a/gcc/testsuite/gfortran.dg/ftell_2.f90 b/gcc/testsuite/gfortran.dg/ftell_2.f90 new file mode 100644 index 0000000..1dda1fb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ftell_2.f90 @@ -0,0 +1,8 @@ +! { dg-do run } + open (10, status="scratch") + if (ftell(10) /= 0) call abort + write (10,"(A)") "1234567" + if (ftell(10) /= 8) call abort + close (10) + if (ftell(10) /= -1) call abort + end diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_1.F b/gcc/testsuite/gfortran.dg/gnu_logical_1.F new file mode 100644 index 0000000..3b6d607 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gnu_logical_1.F @@ -0,0 +1,91 @@ +! Testcases for the AND, OR and XOR functions (GNU intrinsics). +! { dg-do run } +! { dg-options "-ffixed-line-length-none" } + integer*1 i1, j1 + integer*2 i2, j2 + integer*4 i4, j4 + integer*8 i8, j8 + logical*1 l1, k1 + logical*2 l2, k2 + logical*4 l4, k4 + logical*8 l8, k8 + +#define TEST_INTEGER(u,ukind,v,vkind) \ + ukind = u;\ + vkind = v;\ + if (iand(u,v) /= and(ukind, vkind)) call abort;\ + if (iand(u,v) /= and(vkind, ukind)) call abort;\ + if (ieor(u,v) /= xor(ukind, vkind)) call abort;\ + if (ieor(u,v) /= xor(vkind, ukind)) call abort;\ + if (ior(u,v) /= or(ukind, vkind)) call abort;\ + if (ior(u,v) /= or(vkind, ukind)) call abort + + TEST_INTEGER(19,i1,6,j1) + TEST_INTEGER(19,i1,6,j2) + TEST_INTEGER(19,i1,6,j4) + TEST_INTEGER(19,i1,6,j8) + + TEST_INTEGER(19,i2,6,j1) + TEST_INTEGER(19,i2,6,j2) + TEST_INTEGER(19,i2,6,j4) + TEST_INTEGER(19,i2,6,j8) + + TEST_INTEGER(19,i4,6,j1) + TEST_INTEGER(19,i4,6,j2) + TEST_INTEGER(19,i4,6,j4) + TEST_INTEGER(19,i4,6,j8) + + TEST_INTEGER(19,i8,6,j1) + TEST_INTEGER(19,i8,6,j2) + TEST_INTEGER(19,i8,6,j4) + TEST_INTEGER(19,i8,6,j8) + + + +#define TEST_LOGICAL(u,ukind,v,vkind) \ + ukind = u;\ + vkind = v;\ + if ((u .and. v) .neqv. and(ukind, vkind)) call abort;\ + if ((u .and. v) .neqv. and(vkind, ukind)) call abort;\ + if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(ukind, vkind)) call abort;\ + if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(vkind, ukind)) call abort;\ + if ((u .or. v) .neqv. or(ukind, vkind)) call abort;\ + if ((u .or. v) .neqv. or(vkind, ukind)) call abort + + TEST_LOGICAL(.true.,l1,.false.,k1) + TEST_LOGICAL(.true.,l1,.true.,k1) + TEST_LOGICAL(.true.,l1,.false.,k2) + TEST_LOGICAL(.true.,l1,.true.,k2) + TEST_LOGICAL(.true.,l1,.false.,k4) + TEST_LOGICAL(.true.,l1,.true.,k4) + TEST_LOGICAL(.true.,l1,.false.,k8) + TEST_LOGICAL(.true.,l1,.true.,k8) + + TEST_LOGICAL(.true.,l2,.false.,k1) + TEST_LOGICAL(.true.,l2,.true.,k1) + TEST_LOGICAL(.true.,l2,.false.,k2) + TEST_LOGICAL(.true.,l2,.true.,k2) + TEST_LOGICAL(.true.,l2,.false.,k4) + TEST_LOGICAL(.true.,l2,.true.,k4) + TEST_LOGICAL(.true.,l2,.false.,k8) + TEST_LOGICAL(.true.,l2,.true.,k8) + + TEST_LOGICAL(.true.,l4,.false.,k1) + TEST_LOGICAL(.true.,l4,.true.,k1) + TEST_LOGICAL(.true.,l4,.false.,k2) + TEST_LOGICAL(.true.,l4,.true.,k2) + TEST_LOGICAL(.true.,l4,.false.,k4) + TEST_LOGICAL(.true.,l4,.true.,k4) + TEST_LOGICAL(.true.,l4,.false.,k8) + TEST_LOGICAL(.true.,l4,.true.,k8) + + TEST_LOGICAL(.true.,l8,.false.,k1) + TEST_LOGICAL(.true.,l8,.true.,k1) + TEST_LOGICAL(.true.,l8,.false.,k2) + TEST_LOGICAL(.true.,l8,.true.,k2) + TEST_LOGICAL(.true.,l8,.false.,k4) + TEST_LOGICAL(.true.,l8,.true.,k4) + TEST_LOGICAL(.true.,l8,.false.,k8) + TEST_LOGICAL(.true.,l8,.true.,k8) + + end diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 new file mode 100644 index 0000000..4ff70fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 @@ -0,0 +1,29 @@ +! Testcases for the AND, OR and XOR functions (GNU intrinsics). +! { dg-do compile } + integer i + logical l + real r + complex c + + print *, and(i,i) + print *, and(l,l) + print *, and(i,r) ! { dg-error "must be INTEGER or LOGICAL" } + print *, and(c,l) ! { dg-error "must be INTEGER or LOGICAL" } + print *, and(i,l) ! { dg-error "must have the same type" } + print *, and(l,i) ! { dg-error "must have the same type" } + + print *, or(i,i) + print *, or(l,l) + print *, or(i,r) ! { dg-error "must be INTEGER or LOGICAL" } + print *, or(c,l) ! { dg-error "must be INTEGER or LOGICAL" } + print *, or(i,l) ! { dg-error "must have the same type" } + print *, or(l,i) ! { dg-error "must have the same type" } + + print *, xor(i,i) + print *, xor(l,l) + print *, xor(i,r) ! { dg-error "must be INTEGER or LOGICAL" } + print *, xor(c,l) ! { dg-error "must be INTEGER or LOGICAL" } + print *, xor(i,l) ! { dg-error "must have the same type" } + print *, xor(l,i) ! { dg-error "must have the same type" } + + end |