fget.c: New file.

	* intrinsics/fget.c: New file.
	* intrinsics/ftell.c: New file.
	* io/unix.c (stream_offset): New function.
	* io/io.h: Add prototype for stream_offset.
	* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
	* Makefile.in: Regenerate.

	* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
	FPUTC, FPUT, AND, XOR and OR intrinsic functions.
	(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
	subroutines.
	* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
	GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
	GFC_ISYM_OR, GFC_ISYM_XOR.
	* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
	gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
	gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
	gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
	gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
	New functions.
	* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
	gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
	gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
	* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
	gfc_simplify_xor): New functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
	GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
	GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
	GFC_ISYM_XOR.
	* intrinsic.h: Add prototypes for all functions added to iresolve.c,
	simplify.c and check.c.

	* 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.

From-SVN: r106859

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