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

gcc/fortran/ChangeLog

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

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;
 }

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;
 }
 

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));

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.fortran-torture/execute/optstring_1.f90

+! 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