re PR fortran/23060 (%VAL, %REF and %DESCR constructs not implemented)

2006-12-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23060
	* intrinsic.c (compare_actual_formal ): Distinguish argument
	list functions from keywords.
	* intrinsic.c (sort_actual): If formal is NULL, the presence of
	an argument list function actual is an error.
	* trans-expr.c (conv_arglist_function) : New function to
	implement argument list functions %VAL, %REF and %LOC.
	(gfc_conv_function_call): Call it.
	* resolve.c (resolve_actual_arglist): Add arg ptype and check
	argument list functions.
	(resolve_function, resolve_call): Set value of ptype before
	calls to resolve_actual_arglist.
	* primary.c (match_arg_list_function): New function.
	(gfc_match_actual_arglist): Call it before trying for a
	keyword argument.

2006-12-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23060
	* gfortran.dg/c_by_val.c: Called by c_by_val_1.f.
	* gfortran.dg/c_by_val_1.f: New test.
	* gfortran.dg/c_by_val_2.f: New test.
	* gfortran.dg/c_by_val_3.f: New test.

From-SVN: r120295

6 files changed, 116 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4874ec7..5ba52ba 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23060
+	* gfortran.dg/c_by_val.c: Called by c_by_val_1.f.
+	* gfortran.dg/c_by_val_1.f: New test.
+	* gfortran.dg/c_by_val_2.f: New test.
+	* gfortran.dg/c_by_val_3.f: New test.
+
 2006-12-30  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	PR libfortran/30321
diff --git a/gcc/testsuite/gfortran.dg/c_by_val.c b/gcc/testsuite/gfortran.dg/c_by_val.c
new file mode 100644
index 0000000..daba6d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val.c
@@ -0,0 +1,41 @@
+/*  Passing from fortran to C by value, using %VAL.  */
+
+typedef struct { float r, i; } complex;
+extern void f_to_f__ (float*, float, float*, float**);
+extern void i_to_i__ (int*, int, int*, int**);
+extern void c_to_c__ (complex*, complex, complex*, complex**);
+extern void abort (void);
+
+void
+f_to_f__(float *retval, float a1, float *a2, float **a3)
+{
+  if ( a1 != *a2 ) abort();
+  if ( a1 != **a3 ) abort();
+  a1 = 0.0;
+  *retval = *a2 * 2.0;
+  return;
+}
+
+void
+i_to_i__(int *retval, int i1, int *i2, int **i3)
+{
+  if ( i1 != *i2 ) abort();
+  if ( i1 != **i3 ) abort();
+  i1 = 0;
+  *retval = *i2 * 3;
+  return;
+}
+
+void
+c_to_c__(complex *retval, complex c1, complex *c2, complex **c3)
+{
+  if ( c1.r != c2->r ) abort();
+  if ( c1.i != c2->i ) abort();
+  if ( c1.r != (*c3)->r ) abort();
+  if ( c1.i != (*c3)->i ) abort();
+  c1.r = 0.0;
+  c1.i = 0.0;
+  retval->r = c2->r * 4.0;
+  retval->i = c2->i * 4.0;
+  return;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_1.f b/gcc/testsuite/gfortran.dg/c_by_val_1.f
new file mode 100644
index 0000000..133cc55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_1.f
@@ -0,0 +1,31 @@
+C { dg-do run }
+C { dg-additional-sources c_by_val.c }
+C { dg-options "-ff2c -w -O0" }
+
+      program c_by_val_1
+      external   f_to_f, i_to_i, c_to_c
+      real       a, b, c
+      integer*4  i, j, k
+      complex    u, v, w, c_to_c
+
+      a = 42.0
+      b = 0.0
+      c = a
+      call  f_to_f (b, %VAL (a), %REF (c), %LOC (c))
+      if ((2.0 * a).ne.b) call abort ()
+
+      i = 99
+      j = 0
+      k = i
+      call i_to_i (j, %VAL (i), %REF (k), %LOC (k))
+      if ((3 * i).ne.j) call abort ()
+
+      u = (-1.0, 2.0)
+      v = (1.0, -2.0)
+      w = u
+      v = c_to_c (%VAL (u), %REF (w), %LOC (w))
+      if ((4.0 * u).ne.v) call abort ()
+
+      stop
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_2.f90 b/gcc/testsuite/gfortran.dg/c_by_val_2.f90
new file mode 100644
index 0000000..6aadd98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_2.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-w" }
+
+program c_by_val_2
+  external bar
+  real (4) :: bar, ar(2) = (/1.0,2.0/)
+  type     :: mytype
+    integer  :: i
+  end type mytype
+  type(mytype)  :: z
+  character(8)  :: c = "blooey"
+  print *, sin (%VAL(2.0))   ! { dg-error "not allowed in this context" }
+  print *, foo (%VAL(1.0))   ! { dg-error "not allowed in this context" }
+  call  foobar (%VAL(0.5))   ! { dg-error "not allowed in this context" }
+  print *, bar (%VAL(z))     ! { dg-error "not of numeric type" }
+  print *, bar (%VAL(c))     ! { dg-error "not of numeric type" }
+  print *, bar (%VAL(ar))    ! { dg-error "cannot be an array" }
+  print *, bar (%VAL(0.0))
+contains
+  function foo (a)
+    real(4) :: a, foo
+    foo = cos (a)
+  end function foo
+  subroutine foobar (a)
+    real(4) :: a
+    print *, a
+  end subroutine foobar
+end program c_by_val_2
+
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_3.f90 b/gcc/testsuite/gfortran.dg/c_by_val_3.f90
new file mode 100644
index 0000000..bf7aedf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_3.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+program c_by_val_3
+  external bar
+  real (4) :: bar
+  print *, bar (%VAL(0.0)) ! { dg-error "argument list function" }
+end program c_by_val_3
diff --git a/gcc/testsuite/gfortran.dg/char_length_1.f90 b/gcc/testsuite/gfortran.dg/char_length_1.f90
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_1.f90