scalar character pointer functions - ideas, anyone?

[Paul Thomas]

I have been working my way through the character related PRs.  I have made a
lot of headway but have become a bit stuck with functions returning
character pointers.

I enclose below a development version of a patch that fixes some of the PRs
by correcting the dereferencing in gfc_conv_variable.  The macros will be
expanded again when I submit - this was the only way that I could get my
head around the logic!

Functions returning character array pointers were broken because the
direct_byref branch in gfc_conv_function_call did not insert the string
length.  This was easily fixed.

Now all that remains is the scalar case (and character pointers in derived 
types but I am saving up that treat):

program red6
  character*4, pointer       :: c1, c2
  allocate (c2)
  c2 = "abcd"
  c1 => cfoo (c2)     ! result is incorrectly referenced see code below
  print *, c1
  deallocate (c2)
contains
  function cfoo (fc2) result (fc1)
    character*4, pointer       :: fc1, fc2
    fc1 => fc2
  end function cfoo
end program red6

which produces the following code:

cfoo (__result, .__result, fc2, _fc2)
{
  *__result = *fc2;                         /* Fixed by patch below.  */


MAIN__ ()
{
  char[1:4] * c2;
  char[1:4] * c1;
  static void cfoo (char[1:4] * &, int4, char[1:4] * &, int4);

  {
    void * * ptr.0;

    ptr.0 = (void * *) &c2;
    _gfortran_allocate (ptr.0, 4, 0);
  }
  _gfortran_copy_string (4, c2, 4, "abcd");
  {
    char str.1[4];

    cfoo ((char[1:4] *) &str.1, 4, &c2, 4);   /* This is wrong - assigns
char** to char*.  */
    c1 = (char[1:4] *) &str.1;
  }
  _gfortran_filename = "red6.f90";
  _gfortran_line = 6;
  _gfortran_ioparm.unit = 6;
  _gfortran_ioparm.list_format = 1;
  _gfortran_st_write ();
  _gfortran_transfer_character (c1, 4);
  _gfortran_st_write_done ();
  {
    char[1:4] * * ptr.2;

    ptr.2 = &c2;
    _gfortran_deallocate (ptr.2, 0);
  }
}

The function call should also be direct_byref should it not; ie.     cfoo
(&c1, 4, &c2, 4)?

My attempts to bring this about have resulted in segmentation faults in
gfc_trans_pointer_assign at the gfc_add_modify_expr.  Can anyone give me a
hint as to how to fix this, please?  I can slog my way through but I think
the process would be accelerated if somebody could point out where I should 
be
applying myself.

Paul Thomas


Index: gcc/gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.44
diff -p -c -3 -w -r1.44 trans-expr.c
*** gcc/gcc/fortran/trans-expr.c        11 May 2005 14:52:27 -0000      1.44
--- gcc/gcc/fortran/trans-expr.c        21 May 2005 05:27:18 -0000
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 356,382 ****
          return;
        }

!       /* Dereference scalar dummy variables.  */
!       if (sym->attr.dummy
!         && sym->ts.type != BT_CHARACTER
!         && !sym->attr.dimension)
!       se->expr = gfc_build_indirect_ref (se->expr);

!       /* Dereference scalar hidden result.  */
!       if (gfc_option.flag_f2c
!         && (sym->attr.function || sym->attr.result)
!         && sym->ts.type == BT_COMPLEX
!         && !sym->attr.dimension)
!       se->expr = gfc_build_indirect_ref (se->expr);

!       /* Dereference pointer variables.  */
!       if ((sym->attr.pointer || sym->attr.allocatable)
!         && (sym->attr.dummy
!             || sym->attr.result
!             || sym->attr.function
!             || !sym->attr.dimension)
$
!       se->expr = gfc_build_indirect_ref (se->expr);

        ref = expr->ref;
      }
--- 356,385 ----
          return;
        }

! #define gDUMMY (sym->attr.dummy)
! #define gSCALAR (!sym->attr.dimension)
! #define gPOINTER (sym->attr.pointer || sym->attr.allocatable)
! #define gRESULT (sym->attr.function || sym->attr.result)
! #define gF2CCOMPLEX (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX)
! #define gDEREF se->expr = gfc_build_indirect_ref (se->expr)

!       if (sym->ts.type == BT_CHARACTER)
!       {
!         if (gPOINTER && (gDUMMY || gRESULT)) gDEREF;
!       }
!       else
!       {
!         if (gDUMMY && gSCALAR) gDEREF;
!         if (gF2CCOMPLEX && gRESULT && gSCALAR) gDEREF;
!         if (gPOINTER && (gDUMMY || gRESULT || gSCALAR)) gDEREF;
!       }

! #undef gDUMMY
! #undef gSCALAR
! #undef gPOINTER
! #undef gRESULT
! #undef gF2CCOMPLEX
! #undef gDEREF

        ref = expr->ref;
      }