9 files changed, 265 insertions, 0 deletions
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