2007-02-26 Thomas Koenig <Thomas.Koenig@online.de>

	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30865
	* trans-intrinsic.c (gfc_conv_intrinsic_size):
	If dim is an optional argument, check for its
	presence and call size0 or size1, respectively.

2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>

	PR fortran/30865
	* size_optional_dim_1.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@122342 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 777f926..4de2fb8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>
+           Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/30865
+       * trans-intrinsic.c (gfc_conv_intrinsic_size):
+       If dim is an optional argument, check for its
+       presence and call size0 or size1, respectively.
+
 2007-02-23  Paul Thomas <pault@gcc.gnu.org>
 
        PR fortran/30660

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c041b63..267d7a9 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2681,9 +2681,10 @@ static void
 gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
 {
   gfc_actual_arglist *actual;
-  tree args;
+  tree arg1;
   tree type;
-  tree fndecl;
+  tree fncall0;
+  tree fncall1;
   gfc_se argse;
   gfc_ss *ss;
 
@@ -2697,21 +2698,45 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
   gfc_conv_expr_descriptor (&argse, actual->expr, ss);
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
-  args = gfc_chainon_list (NULL_TREE, argse.expr);
+  arg1 = gfc_evaluate_now (argse.expr, &se->pre);
+
+  /* Build the call to size0.  */
+  fncall0 = build_call_expr (gfor_fndecl_size0, 1, arg1);
 
   actual = actual->next;
+
   if (actual->expr)
     {
       gfc_init_se (&argse, NULL);
-      gfc_conv_expr_type (&argse, actual->expr, gfc_array_index_type);
+      gfc_conv_expr_type (&argse, actual->expr,
+                         gfc_array_index_type);
       gfc_add_block_to_block (&se->pre, &argse.pre);
-      args = gfc_chainon_list (args, argse.expr);
-      fndecl = gfor_fndecl_size1;
+
+      /* Build the call to size1.  */
+      fncall1 = build_call_expr (gfor_fndecl_size1, 2,
+                                arg1, argse.expr);
+
+      /* Unusually, for an intrinsic, size does not exclude
+        an optional arg2, so we must test for it.  */  
+      if (actual->expr->expr_type == EXPR_VARIABLE
+           && actual->expr->symtree->n.sym->attr.dummy
+           && actual->expr->symtree->n.sym->attr.optional)
+       {
+         tree tmp;
+         tmp = gfc_build_addr_expr (pvoid_type_node,
+                                    argse.expr);
+         tmp = build2 (NE_EXPR, boolean_type_node, tmp, 
+                       build_int_cst (pvoid_type_node, 0));
+         tmp = gfc_evaluate_now (tmp, &se->pre);
+         se->expr = build3 (COND_EXPR, pvoid_type_node,
+                            tmp, fncall1, fncall0);
+       }
+      else
+       se->expr = fncall1;
     }
   else
-    fndecl = gfor_fndecl_size0;
+    se->expr = fncall0;
 
-  se->expr = build_function_call_expr (fndecl, args);
   type = gfc_typenode_for_spec (&expr->ts);
   se->expr = convert (type, se->expr);
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 23039a5..dc182f8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR fortran/30865
+       * size_optional_dim_1.f90:  New test.
+
 2007-02-25  Mark Mitchell  <mark@codesourcery.com>
 
        * gcc.dg/vxworks/vxworks.exp: New file.

diff --git a/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90 b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
new file mode 100644 (file)
index 0000000..de5a739
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! PR 30865 - passing a subroutine optional argument to size(dim=...)
+! used to segfault.
+program main
+  implicit none
+  integer :: a(2,3)
+  integer :: ires
+
+  call checkv (ires, a)
+  if (ires /= 6) call abort
+  call checkv (ires, a, 1)
+  if (ires /= 2) call abort
+contains
+  subroutine checkv(ires,a1,opt1)
+    integer, intent(out) :: ires
+    integer :: a1(:,:)
+    integer, optional :: opt1
+
+    ires = size (a1, dim=opt1)
+  end subroutine checkv
+end program main