2007-07-29 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/31211
	* trans-expr.c (gfc_conv_expr_reference): Add block for case of
	scalar pointer functions so that NULL result is correctly
	handled.

	PR fortran/32682
	*trans-array.c (gfc_trans_array_constructor): On detecting a
	multi-dimensional parameter array, set the loop limits.

2007-07-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31211
	* gfortran.dg/actual_pointer_function_1.f90: New test.

	PR fortran/32682
	* gfortran.dg/scalarize_parameter_array_1.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 671f99ead372d71c719fbe350d0050dfd2641dbf..5f90ebc83cff7269009030bc2dc0c4dc863b4a8c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2007-07-29  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31211
+       * trans-expr.c (gfc_conv_expr_reference): Add block for case of
+       scalar pointer functions so that NULL result is correctly
+       handled.
+
+       PR fortran/32682
+       *trans-array.c (gfc_trans_array_constructor): On detecting a
+       multi-dimensional parameter array, set the loop limits.
+
 2007-07-29  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/32906

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 16f95777ee7ee3a021633ed362487dbb625a9b74..63a1ea08fbcf866d19fbc93df797f72005297ec9 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1656,6 +1656,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
 
   /* See if the constructor determines the loop bounds.  */
   dynamic = false;
+
+  if (ss->expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+    {
+      /* We have a multidimensional parameter.  */
+      int n;
+      for (n = 0; n < ss->expr->rank; n++)
+      {
+       loop->from[n] = gfc_index_zero_node;
+       loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n],
+                                           gfc_index_integer_kind);
+       loop->to[n] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                                  loop->to[n], gfc_index_one_node);
+      }
+    }
+
   if (loop->to[0] == NULL_TREE)
     {
       mpz_t size;

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 528bf39dbe6706f5b302814b59b650558af185a1..20ccdcc92d23216032d339fc1be8c13d693ee8c5 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3342,6 +3342,19 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
       return;
     }
 
+  if (expr->expr_type == EXPR_FUNCTION
+       && expr->symtree->n.sym->attr.pointer
+       && !expr->symtree->n.sym->attr.dimension)
+    {
+      se->want_pointer = 1;
+      gfc_conv_expr (se, expr);
+      var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+      gfc_add_modify_expr (&se->pre, var, se->expr);
+      se->expr = var;
+      return;
+    }
+
+
   gfc_conv_expr (se, expr);
 
   /* Create a temporary var to hold the value.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 388c72127ec2b69ccbfdbb3916ec43e8a5a283f8..1954fb0de5f244149b39cb6b5a1425c7902a2488 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-29  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31211
+       * gfortran.dg/actual_pointer_function_1.f90: New test.
+
+       PR fortran/32682
+       * gfortran.dg/scalarize_parameter_array_1.f90: New test.
+
 2007-07-29  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/32906

diff --git a/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90 b/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90
new file mode 100644 (file)
index 0000000..8fa882d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }\r
+! Tests the fix for PR31211, in which the value of the result for\r
+! cp_get_default_logger was stored as a temporary, rather than the\r
+! pointer itself.  This caused a segfault when the result was\r
+! nullified.\r
+!\r
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>\r
+!\r
+  TYPE cp_logger_type\r
+    INTEGER :: a\r
+  END TYPE cp_logger_type\r
+\r
+  if (cp_logger_log(cp_get_default_logger (0))) call abort ()\r
+  if (.not. cp_logger_log(cp_get_default_logger (42))) call abort ()\r
+\r
+CONTAINS\r
+\r
+  logical function cp_logger_log(logger)\r
+    TYPE(cp_logger_type), POINTER ::logger\r
+    cp_logger_log = associated (logger) .and. (logger%a .eq. 42)\r
+  END function\r
+\r
+  FUNCTION cp_get_default_logger(v) RESULT(res)\r
+    TYPE(cp_logger_type), POINTER ::res\r
+    integer :: v\r
+    if (v .eq. 0) then\r
+      NULLIFY(RES)\r
+    else\r
+      allocate(RES)\r
+      res%a = v\r
+    end if\r
+  END FUNCTION cp_get_default_logger\r
+END\r

diff --git a/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90 b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90
new file mode 100644 (file)
index 0000000..86bc92d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Tests the fix for pr32682, in which the scalarization loop variables
+! were not being determined when 'c' came first in an expression.
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+program matrix
+
+  implicit none
+  real,dimension(2,2),parameter::c=reshape((/1,2,3,4/),(/2,2/))
+  real,dimension(2,2)::m, n
+
+  m=f()+c
+  if (any (m .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  m=c+f()
+  if (any (m .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  call sub(m+f())
+  if (any (n .ne. reshape((/3,4,5,6/),(/2,2/)))) call abort ()
+  call sub(c+m)
+  if (any (n .ne. reshape((/3,5,7,9/),(/2,2/)))) call abort ()
+  call sub(f()+c)
+  if (any (n .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  call sub(c+f())
+  if (any (n .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+
+contains
+
+  function f()    
+    implicit none
+    real, dimension(2,2)::f
+    f=1
+  end function f
+
+  subroutine sub(a)
+    implicit none
+    real, dimension(2,2)::a
+    n = a
+  end subroutine sub
+
+end program matrix