Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 223234)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5877,5882 ****
--- 5877,5896 ----
    fntype = TREE_TYPE (TREE_TYPE (se->expr));
    se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
  
+   /* Allocatable scalar function results must be freed and nullified
+      after use. This necessitates the creation of a temporary to
+      hold the result to prevent duplicate calls.  */
+   if (!byref && sym->ts.type != BT_CHARACTER
+       && sym->attr.allocatable && !sym->attr.dimension)
+     {
+       tmp = gfc_create_var (TREE_TYPE (se->expr), NULL);
+       gfc_add_modify (&se->pre, tmp, se->expr);
+       se->expr = tmp;
+       tmp = gfc_call_free (tmp);
+       gfc_add_expr_to_block (&post, tmp);
+       gfc_add_modify (&post, se->expr, build_int_cst (TREE_TYPE (se->expr), 0));
+     }
+ 
    /* If we have a pointer function, but we don't want a pointer, e.g.
       something like
          x = f()
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 223233)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5200,5206 ****
  		}
  	      /* else expr3 = NULL_TREE set above.  */
  	    }
! 	  else
  	    {
  	      /* In all other cases evaluate the expr3 and create a
  		 temporary.  */
--- 5200,5207 ----
  		}
  	      /* else expr3 = NULL_TREE set above.  */
  	    }
! 	  else if (!(code->expr3->ts.type == BT_DERIVED
! 		     && code->expr3->ts.u.derived->attr.alloc_comp))
  	    {
  	      /* In all other cases evaluate the expr3 and create a
  		 temporary.  */
*************** gfc_trans_allocate (gfc_code * code)
*** 5626,5631 ****
--- 5627,5633 ----
  			    fold_convert (TREE_TYPE (al_len),
  					  integer_zero_node));
  	}
+ 
        if (code->expr3 && !code->expr3->mold)
  	{
  	  /* Initialization via SOURCE block
*************** gfc_trans_allocate (gfc_code * code)
*** 5650,5655 ****
--- 5652,5669 ----
  			se.expr :
  			build_fold_indirect_ref_loc (input_location,
  						     se.expr);
+ 
+ 	      /* Fixed length allocatable results and dummies need further
+ 		 dereferencing.  */
+ 	      if (!expr->ts.deferred
+ 		  && TREE_CODE (se.expr) == PARM_DECL)
+ 		tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ 
+ 	      /* Fixed length allocations need this because al_len is
+ 		 never set.  */
+ 	      if (al_len == NULL_TREE)
+ 		al_len = memsz;
+ 
  	      gfc_trans_string_copy (&block, al_len, tmp,
  				     code->expr3->ts.kind,
  				     expr3_len, expr3,