[Patches, Fortran] ALLOCATE & CAF library.

[Tobias Burnus]

On 07/21/2011 01:09 PM, Daniel Carrera wrote:
> This patch now fixes an existing bug in GFortran whereby the ALLOCATE 
> statement only gets error checking if you are allocating a scalar.

Somehow that does not seem to work. I just tried a vanilla trunk with 
just your patch applied. For the following, I do not get a single 
"goto". That's different to your dumps, where you get two (though, in 
your case, you had a scalar and a scalar coarray).

integer, allocatable :: A(:), B[:]
integer :: stat
character(len=33) :: str
allocate(A(1), B[*], stat=stat)!, errmsg=str)
end

Thus, I wonder whether you have send the correct patch, if not, the 
question is really why we see those large differences.

That also fits with the code:
-      if (!gfc_array_allocate (&se, expr, pstat))
+      if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen))
         {
...
           if (code->expr1 || code->expr2)
             {
-             tmp = build1_v (GOTO_EXPR, error_label);
+             /* The coarray library already sets the errmsg.  */
+             if (gfc_option.coarray == GFC_FCOARRAY_LIB
+ && gfc_expr_attr (expr).codimension)
+               tmp = build1_v (GOTO_EXPR, label_finish);
+             else
+               tmp = build1_v (GOTO_EXPR, label_errmsg);
...
         }

Where the code is still in the scalar-allocation loop.


  * * *

To the patch itself:

   /* Either STAT= and/or ERRMSG is present.  */
   if (code->expr1 || code->expr2)
> @@ -4709,9 +4712,23 @@ gfc_trans_allocate (gfc_code * code)
>       {
> +      /* STAT=  */
>         tree gfc_int4_type_node = gfc_get_int_type (4)

Can you change the "if ()" into "if(code->expr1)", i.e. only checking 
whether STAT= is present? There is no point of generating code for 
ERRMSG= if STAT= is not present.

Assuming you had:  ALLOCATE(A, ERRMSG=str).
a) Everything goes fine. Result: "str" remains unmodified.
b) There is an error: As there is no STAT=, a run-time error is 
generated and there is no process left, which an make use of the error 
string.

Thus, using "if (code->expr1)" is sufficient.

> +      /* ERRMSG=  */
> +      errmsg = null_pointer_node;
> +      errlen = build_int_cst (gfc_charlen_type_node, 0);
> +      if (code->expr2)
> +	{
> +	  gfc_init_se (&se, NULL);
> +	  gfc_conv_expr_lhs (&se, code->expr2);
> +
> +	  errlen = gfc_get_expr_charlen (code->expr2);
> +	  errmsg = gfc_build_addr_expr (pchar_type_node, se.expr);
> +	}

As said in previous review: Use:
    else
      {

       errmsg = null_pointer_node;
       errlen = build_int_cst (gfc_charlen_type_node, 0);

      }


That avoids evaluating uselessly build_int_cst, which is cheap but 
changing the code comes for free.

> -  /* STAT block.  */
> -  if (code->expr1)
> +  /* STAT or ERRMSG.  */
> +  if (code->expr1 || code->expr2)

I believe here applies the same: The code will be unreachable if there 
is no STAT=.

> +  /* STAT or ERRMSG.  */
> +  if (code->expr1 || code->expr2)
Ditto.

Tobias