gfortran.h (gfc_actual_arglist): New field missing_arg_type.

fortran/
* gfortran.h (gfc_actual_arglist): New field missing_arg_type.
* interface.c (compare_actual_formal): Keep type of omitted
optional arguments.
* trans-expr.c (gfc_conv_function_call): Add string length
argument for omitted string argument.

testsuite/
* gfortran.fortran-torture/execute/optstring_1.f90: New testcase.

From-SVN: r82608

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3cb938c36af3a4fa931de9d0e5984064ee6b9813..75168d8e49dc29497fef1de390a969be9de27bc4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,12 @@
-2004-05-03  Paul Brook  <paul@codesourcery.com>
+2004-06-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * gfortran.h (gfc_actual_arglist): New field missing_arg_type.
+       * interface.c (compare_actual_formal): Keep type of omitted
+       optional arguments.
+       * trans-expr.c (gfc_conv_function_call): Add string length
+       argument for omitted string argument.
+
+2004-06-03  Paul Brook  <paul@codesourcery.com>
 
        * trans.c (gfc_finish_block, gfc_add_expr_to_block): Build statement
        lists instead of compound expr chains.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 74596f4417dea92a248d4327d163f62c771b9040..c82483e985185195cc34a20968565ef30e558cee 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -538,6 +538,11 @@ typedef struct gfc_actual_arglist
   /* Alternate return label when the expr member is null.  */
   struct gfc_st_label *label;
 
+  /* This is set to the type of an eventual omitted optional
+     argument. This is used to determine if a hidden string length
+     argument has to be added to a function call.  */
+  bt missing_arg_type;
+
   struct gfc_expr *expr;
   struct gfc_actual_arglist *next;
 }

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a3c3acc9fa82ebcebd94a0224310440b0d7a15fc..30706d413d5eaab34395c251971f15f910c9c4ac 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1096,7 +1096,8 @@ compare_parameter (gfc_symbol * formal, gfc_expr * actual,
       return compare_interfaces (formal, actual->symtree->n.sym, 0);
     }
 
-  if (!gfc_compare_types (&formal->ts, &actual->ts))
+  if (actual->expr_type != EXPR_NULL
+      && !gfc_compare_types (&formal->ts, &actual->ts))
     return 0;
 
   if (symbol_rank (formal) == actual->rank)
@@ -1235,7 +1236,8 @@ compare_actual_formal (gfc_actual_arglist ** ap,
          return 0;
        }
 
-      if (compare_pointer (f->sym, a->expr) == 0)
+      if (a->expr->expr_type != EXPR_NULL
+         && compare_pointer (f->sym, a->expr) == 0)
        {
          if (where)
            gfc_error ("Actual argument for '%s' must be a pointer at %L",
@@ -1291,6 +1293,11 @@ compare_actual_formal (gfc_actual_arglist ** ap,
   if (*ap == NULL && n > 0)
     *ap = new[0];
 
+  /* Note the types of omitted optional arguments.  */
+  for (a = actual, f = formal; a; a = a->next, f = f->next)
+    if (a->expr == NULL && a->label == NULL)
+      a->missing_arg_type = f->sym->ts.type;
+
   return 1;
 }
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a1a8d4691326152c99a650958a0699f7168e4861..dda08bbed81b42f07ee95af7be63fd222eda85db 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1077,7 +1077,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
              /* Pass a NULL pointer for an absent arg.  */
              gfc_init_se (&parmse, NULL);
              parmse.expr = null_pointer_node;
-              if (formal && formal->sym->ts.type == BT_CHARACTER)
+              if (arg->missing_arg_type == BT_CHARACTER)
                 {
                   stringargs = gfc_chainon_list (stringargs,
                       convert (gfc_strlen_type_node, integer_zero_node));

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1bf6dd468c188ee7d678e0425cb3b49b0568ad18..14252999c6bbe1dcebe8383305016d12852a3368 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2004-06-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * gfortran.fortran-torture/execute/optstring_1.f90: New testcase.
+
 2004-06-02  Ziemowit Laski  <zlaski@apple.com>
 
        * lib/objc.exp (objc_target_compile): When running tests on

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/optstring_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/optstring_1.f90
new file mode 100644 (file)
index 0000000..58c397d
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/optstring_1.f90
@@ -0,0 +1,21 @@
+! Test optional character arguments.  We still need to pass a string
+! length for the absent arguments
+program optional_string_1
+  implicit none
+
+  call test(1, "test");
+  call test(2, c=42, b="Hello World")
+contains
+subroutine test(i, a, b, c)
+  integer ::  i
+  character(len=4), optional :: a
+  character(len=*), optional :: b
+  integer, optional :: c
+  if (i .eq. 1) then
+    if (a .ne. "test") call abort
+  else
+    if (b .ne. "Hello World") call abort
+    if (c .ne. 42) call abort
+  end if
+end subroutine
+end program