re PR fortran/51869 (Realloc on assignment wrongly assumes that MALLOC returnes ...

2012-01-17  Tobias Burnus  <burnus@net-b.de>
            Janne Blomqvist  <jb@gcc.gnu.org>

        PR fortran/51869
        * trans-expr.c (alloc_scalar_allocatable_for_assignment): Nullify
        LHS after allocation, if it has allocatable components.
        * f95-lang.c (gfc_init_builtin_functions): Add BUILT_IN_CALLOC.

2012-01-17  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51869
        * gfortran.dg/realloc_on_assign_9.f90: New.

Co-Authored-By: Janne Blomqvist <jb@gcc.gnu.org>
From-SVN: r183247

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a4838ab63315c675e4a72b533519ed7173200f1b..f53576085f9f56c0e3aaf06b538090793f194473 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2012-01-17  Tobias Burnus  <burnus@net-b.de>
+           Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR fortran/51869
+       * trans-expr.c (alloc_scalar_allocatable_for_assignment): Nullify
+       LHS after allocation, if it has allocatable components.
+       * f95-lang.c (gfc_init_builtin_functions): Add BUILT_IN_CALLOC.
+
 2012-01-16  Mikael Morin  <mikael@gcc.gnu.org>
            Tobias Burnus  <burnus@net-b.de>
 

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 57c01148fffc7f5e983c6962bde191f3ed665d6b..a68d2fc8382a85b04648986f8de6bfd5b591ae01 100644 (file)
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -1007,6 +1007,12 @@ gfc_init_builtin_functions (void)
                      "malloc", ATTR_NOTHROW_LEAF_LIST);
   DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_MALLOC)) = 1;
 
+  ftype = build_function_type_list (pvoid_type_node, size_type_node,
+                                   size_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
+                     "calloc", ATTR_NOTHROW_LEAF_LIST);
+  DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
+
   ftype = build_function_type_list (pvoid_type_node,
                                     size_type_node, pvoid_type_node,
                                     NULL_TREE);

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 14411e05cdee647a7965c6f6a2f418248bc6da23..b41935add47e48e981d96f752ca45a7b4987b355 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6585,11 +6585,24 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
       size_in_bytes = size;
     }
 
-  tmp = build_call_expr_loc (input_location,
-                            builtin_decl_explicit (BUILT_IN_MALLOC),
-                            1, size_in_bytes);
-  tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
-  gfc_add_modify (block, lse.expr, tmp);
+  if (expr1->ts.type == BT_DERIVED && expr1->ts.u.derived->attr.alloc_comp)
+    {
+      tmp = build_call_expr_loc (input_location,
+                                builtin_decl_explicit (BUILT_IN_CALLOC),
+                                2, build_one_cst (size_type_node),
+                                size_in_bytes);
+      tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
+      gfc_add_modify (block, lse.expr, tmp);
+    }
+  else
+    {
+      tmp = build_call_expr_loc (input_location,
+                                builtin_decl_explicit (BUILT_IN_MALLOC),
+                                1, size_in_bytes);
+      tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
+      gfc_add_modify (block, lse.expr, tmp);
+    }
+
   if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
     {
       /* Deferred characters need checking for lhs and rhs string

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f00f2d558b40af914da8c0b29b5b623f90113443..8507039f46faa92a3b359c2a4883fd9de5920b8e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-17  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/51869
+       * gfortran.dg/realloc_on_assign_9.f90: New.
+
 2012-01-17  Aldy Hernandez  <aldyh@redhat.com>
 
        PR other/51165

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_9.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_9.f90
new file mode 100644 (file)
index 0000000..d03db32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_9.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR fortran/51869
+!
+module soop_stars_class
+  implicit none
+  type soop_stars
+    real ,dimension(:,:) ,allocatable :: position
+  end type
+  type show
+    type(soop_stars) :: rocket
+  end type
+contains
+  function new_show(boom)
+    type(soop_stars) ,intent(in) :: boom
+    type(show) :: new_show
+    new_show%rocket = boom
+  end function
+end module
+
+program main
+  use soop_stars_class
+  implicit none
+
+  type(soop_stars) :: fireworks
+  type(show), allocatable :: july4
+
+  allocate (fireworks%position(2,2))
+  fireworks%position = 33.0
+
+  july4 = new_show(boom=fireworks)
+end program
+
+! { dg-final { cleanup-modules "soop_stars_class" } }