re PR fortran/30865 ([4.1, 4.2 only] optional argument passed on to size(...,dim=))

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.


Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>

From-SVN: r122342

4 files changed, 67 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 777f926..4de2fb8 100644
--- 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
--- 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
--- 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
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