2009-01-04 Tobias Burnus <burnus@net-b.de>

        PR fortran/41872
        * trans-expr.c (gfc_conv_procedure_call): Add indirect ref
        for functions returning allocatable scalars.
        * trans-stmt.c (gfc_trans_allocate): Emmit error when
        reallocating an allocatable scalar.
        * trans.c (gfc_allocate_with_status): Fix pseudocode syntax
        in comment.
        * trans-decl.c (gfc_trans_deferred_vars): Nullify local
        allocatable scalars.
        (gfc_generate_function_code): Nullify result variable for
        allocatable scalars.
        
        PR fortran/40849
        * module.c (gfc_use_module): Fix warning string to allow
        for translation.

        PR fortran/42517
        * invoke.texi (-fcheck=recursion): Mention that the checking
        is also disabled for -frecursive.
        * trans-decl.c (gfc_generate_function_code): Disable
        -fcheck=recursion when -frecursive is used.

        * intrinsic.texi (iso_c_binding): Improve wording.

2009-01-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41872
        * gfortran.dg/allocatable_scalar_5.f90: New test.
        * gfortran.dg/allocatable_scalar_6.f90: New test.



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

1 files changed, 26 insertions, 1 deletions

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 32c6efc0c3c..5159f429d02 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4059,7 +4059,32 @@ gfc_trans_allocate (gfc_code * code)
 	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
 	    memsz = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
+	  /* Allocate - for non-pointers with re-alloc checking.  */
+	  {
+	    gfc_ref *ref;
+	    bool allocatable;
+
+	    ref = expr->ref;
+
+	    /* Find the last reference in the chain.  */
+	    while (ref && ref->next != NULL)
+	      {
+	        gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT);
+	        ref = ref->next;
+	      }
+
+	    if (!ref)
+	      allocatable = expr->symtree->n.sym->attr.allocatable;
+	    else
+	      allocatable = ref->u.c.component->attr.allocatable;
+
+	    if (allocatable)
+	      tmp = gfc_allocate_array_with_status (&se.pre, se.expr, memsz,
+						    pstat, expr);
+	    else
+	      tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
+	  }
+
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);