Bug 30964 - optional arguments to random_seed
Summary: optional arguments to random_seed
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.3.0
: P3 major
Target Milestone: ---
Assignee: Francois-Xavier Coudert
URL: http://gcc.gnu.org/ml/gcc-patches/200...
Keywords: patch, rejects-valid, wrong-code
Depends on:
Blocks: 32834
  Show dependency treegraph
 
Reported: 2007-02-25 21:16 UTC by Thomas Koenig
Modified: 2007-08-12 20:46 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2007-03-03 10:36:07


Attachments
Patch for that issue; not tested yet (528 bytes, patch)
2007-05-21 15:21 UTC, Francois-Xavier Coudert
Details | Diff

Note You need to log in before you can comment on or make changes to this bug.
Description Thomas Koenig 2007-02-25 21:16:36 UTC
This is similar to PR 30865.  Any of the
arguments to random_seed may be specified if they
are optional arguments to the subroutine that is called.
The following is legal:

program trs
  implicit none
  integer :: size, ierr
  integer, allocatable, dimension(:) :: seed
  call test_random_seed(size)
  allocate(seed(size), stat=ierr)
  if (ierr /= 0) stop
  call test_random_seed(get=seed)
  call test_random_seed(put=seed)
contains
  subroutine test_random_seed(size, put, get)
    integer, optional :: size
    integer, dimension(:), optional :: put
    integer, dimension(:), optional :: get
    call random_seed(size, put, get)
  end subroutine test_random_seed
end program trs
Comment 1 kargl 2007-02-26 00:14:42 UTC
I have a patch to permit gfc_check_random_seed to deal with arguments
with the optional attribute set.  I was waiting on pault's size0/size1
patch to hit the tree to see if it does the right thing.
Comment 2 Thomas Koenig 2007-02-26 19:53:42 UTC
(In reply to comment #1)
> I have a patch to permit gfc_check_random_seed to deal with arguments
> with the optional attribute set.  I was waiting on pault's size0/size1
> patch to hit the tree to see if it does the right thing.

In case you missed it, I submitted pault's patch (without changes),
to http://gcc.gnu.org/ml/gcc-patches/2007-02/msg01956.html .  You could
also attach your patch to this PR, I'll have a look at it then.

Comment 3 Francois-Xavier Coudert 2007-03-15 12:59:12 UTC
(In reply to comment #1)
> I have a patch to permit gfc_check_random_seed to deal with arguments
> with the optional attribute set.  I was waiting on pault's size0/size1
> patch to hit the tree to see if it does the right thing.

I think it was commited.
Comment 4 Francois-Xavier Coudert 2007-05-21 15:21:26 UTC
Created attachment 13595 [details]
Patch for that issue; not tested yet
Comment 5 Francois-Xavier Coudert 2007-05-22 09:23:56 UTC
There's more to it. When generate wrong-code for optional arguments, as shown by the following code:

$ cat b.f90 
program trs
  implicit none
  integer :: size, ierr
  integer, allocatable, dimension(:) :: seed
  call random_seed(size)
  allocate(seed(size), stat=ierr)
  if (ierr /= 0) stop
  call test_random_seed()
contains
  subroutine test_random_seed(get)
    integer, dimension(:), optional :: get
    call random_seed(get=get)
  end subroutine test_random_seed
end program trs
$ gfortran b.f90 && ./a.out
Segmentation fault
Comment 6 Francois-Xavier Coudert 2007-05-28 20:48:37 UTC
The following two codes are handled differently:

$ cat u.f90
  call foo()
contains
  subroutine foo(x)
    integer, dimension(:), optional :: x
    interface
      subroutine bar(x)
        integer, dimension(:), optional :: x
      end subroutine bar
    end interface

    call bar(x)
  end subroutine foo
end
$ cat v.f90
  call foo()
contains
  subroutine foo(x)
    integer, dimension(:), optional :: x

    call random_seed(get=x)
  end subroutine foo
end


For the first one, gfc_conv_missing_dummy() is called, which leads to correct code. For the second one, gfc_conv_missing_dummy() is not called, leading to wrong-code.
Comment 7 Francois-Xavier Coudert 2007-08-11 23:22:34 UTC
(In reply to comment #6)
> For the first one, gfc_conv_missing_dummy() is called, which leads to correct
> code. For the second one, gfc_conv_missing_dummy() is not called, leading to
> wrong-code.

The reason for that is in gfc_trans_call, around line 2316 (the call to gfc_conv_missing_dummy): when we come here, we check both the list of actual args and the list of formal args for optional args. This is need, because we need the type of the formal arg. Problem is that apparently intrinsic subroutines don't have a list of formal args when we come up here.
Comment 8 Francois-Xavier Coudert 2007-08-11 23:33:16 UTC
(In reply to comment #7)
> The reason for that is in gfc_trans_call

This should be: gfc_conv_function_call
Comment 9 Francois-Xavier Coudert 2007-08-12 00:16:11 UTC
Haven't yet had time to regtest this patch, but it should fix the bug:

Index: trans-expr.c
===================================================================
--- trans-expr.c        (revision 127363)
+++ trans-expr.c        (working copy)
@@ -2303,36 +2303,38 @@ gfc_conv_function_call (gfc_se * se, gfc
            } 
        }
 
-      if (fsym)
-       {
-         if (e)
+      /* The case with fsym->attr.optional is that of a user subroutine
+        with an interface indicating an optional argument.  When we call
+        an intrinsic subroutine, however, fsym is NULL, but we might still
+        have an optional argument, so we proceed to the substitution
+        just in case.  */
+      if (e && (fsym == NULL || fsym->attr.optional))
+       {
+         /* If an optional argument is itself an optional dummy argument,
+            check its presence and substitute a null if absent.  */
+         if (e->expr_type == EXPR_VARIABLE
+             && e->symtree->n.sym->attr.optional)
+           gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts);
+       }
+
+      if (fsym && e)
+       {
+         /* Obtain the character length of an assumed character length
+            length procedure from the typespec.  */
+         if (fsym->ts.type == BT_CHARACTER
+             && parmse.string_length == NULL_TREE
+             && e->ts.type == BT_PROCEDURE
+             && e->symtree->n.sym->ts.type == BT_CHARACTER
+             && e->symtree->n.sym->ts.cl->length != NULL)
            {
-             /* If an optional argument is itself an optional dummy
-                argument, check its presence and substitute a null
-                if absent.  */
-             if (e->expr_type == EXPR_VARIABLE
-                   && e->symtree->n.sym->attr.optional
-                   && fsym->attr.optional)
-               gfc_conv_missing_dummy (&parmse, e, fsym->ts);
-
-             /* Obtain the character length of an assumed character
-                length procedure from the typespec.  */
-             if (fsym->ts.type == BT_CHARACTER
-                   && parmse.string_length == NULL_TREE
-                   && e->ts.type == BT_PROCEDURE
-                   && e->symtree->n.sym->ts.type == BT_CHARACTER
-                   && e->symtree->n.sym->ts.cl->length != NULL)
-               {
-                 gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
-                 parmse.string_length
-                       = e->symtree->n.sym->ts.cl->backend_decl;
-               }
+             gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
+             parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
            }
-
-         if (need_interface_mapping)
-           gfc_add_interface_mapping (&mapping, fsym, &parmse);
        }
 
+      if (fsym && need_interface_mapping)
+       gfc_add_interface_mapping (&mapping, fsym, &parmse);
+
       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&post, &parmse.post);
 
Comment 10 Francois-Xavier Coudert 2007-08-12 16:41:15 UTC
Complete patch submitted: http://gcc.gnu.org/ml/gcc-patches/2007-08/msg00782.html
Comment 11 Francois-Xavier Coudert 2007-08-12 20:45:43 UTC
Subject: Bug 30964

Author: fxcoudert
Date: Sun Aug 12 20:45:29 2007
New Revision: 127383

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=127383
Log:
	PR fortran/30964
	PR fortran/33054

	* trans-expr.c (gfc_conv_function_call): When no formal argument
	list is available, we still substitute missing optional arguments.
	* check.c (gfc_check_random_seed): Correct the check on the
	number of arguments to RANDOM_SEED.
	* intrinsic.c (add_subroutines): Add a resolution function to
	RANDOM_SEED.
	* iresolve.c (gfc_resolve_random_seed): New function.
	* intrinsic.h (gfc_resolve_random_seed): New prototype.

	* intrinsics/random.c (random_seed): Rename into random_seed_i4.
	(random_seed_i8): New function.
	* gfortran.map (GFORTRAN_1.0): Remove _gfortran_random_seed,
	add _gfortran_random_seed_i4 and _gfortran_random_seed_i8.
	* libgfortran.h (iexport_proto): Replace random_seed by
	random_seed_i4 and random_seed_i8.
	* runtime/main.c (init): Call the new random_seed_i4.

	* gfortran.dg/random_4.f90: New test.
	* gfortran.dg/random_5.f90: New test.
	* gfortran.dg/random_6.f90: New test.
	* gfortran.dg/random_7.f90: New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/random_4.f90
    trunk/gcc/testsuite/gfortran.dg/random_5.f90
    trunk/gcc/testsuite/gfortran.dg/random_6.f90
    trunk/gcc/testsuite/gfortran.dg/random_7.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/check.c
    trunk/gcc/fortran/intrinsic.c
    trunk/gcc/fortran/intrinsic.h
    trunk/gcc/fortran/iresolve.c
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog
    trunk/libgfortran/ChangeLog
    trunk/libgfortran/gfortran.map
    trunk/libgfortran/intrinsics/random.c
    trunk/libgfortran/libgfortran.h
    trunk/libgfortran/runtime/main.c

Comment 12 Francois-Xavier Coudert 2007-08-12 20:46:39 UTC
Fixed.