[Patch/gfortran] Fix for PR16939

[Tobias Schlüter]

Tobias Schlüter wrote:
> THOMAS Paul Richard 169137 wrote:
>>program testch
>>  print *, ch()
>>contains
>>  function ch result(str)
>>    character(len = 10)  :: str
>>    str ="hello"
>>  end function ch
>>end program testch
>>
>>now fails.  The pointer case does too!
> 
> 
> "now" as in "it didn't fail before the f2c patch, but now it fails on a
> vanilla mainline"???
> 
> /me starts to look for anything that's not guarded by BT_COMPLEX || BT_REAL in
> the patch.

I committed the following under the obviously correct rule to fix the breakage
which was due to an oversight.  I'm amazed something as fundamental as this
was not exercised by the testsuite.  I'll now start looking for bits of code
that can be simplified with the correct attributes being set on the function
symbol, I remember a few places where this was important.

Bubblestrapped and tested on i686-pc-linux.

- Tobi

Index: fortran/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/ChangeLog,v
retrieving revision 1.419
diff -u -p -r1.419 ChangeLog
--- fortran/ChangeLog   10 May 2005 22:06:43 -0000      1.419
+++ fortran/ChangeLog   11 May 2005 14:25:54 -0000
@@ -1,3 +1,8 @@
+2005-05-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * resolve.c (resolve_symbol): Copy 'pointer' and 'dimension'
+       attribute from result symbol to function symbol.
+
 2005-05-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>

        PR fortran/20178
Index: fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.42
diff -u -p -r1.42 resolve.c
--- fortran/resolve.c   29 Apr 2005 15:31:34 -0000      1.42
+++ fortran/resolve.c   11 May 2005 14:25:55 -0000
@@ -4061,6 +4061,8 @@ resolve_symbol (gfc_symbol * sym)

              sym->ts = sym->result->ts;
              sym->as = gfc_copy_array_spec (sym->result->as);
+             sym->attr.dimension = sym->result->attr.dimension;
+             sym->attr.pointer = sym->result->attr.pointer;
            }
        }
     }
Index: fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.43
diff -u -p -r1.43 trans-expr.c
--- fortran/trans-expr.c        10 May 2005 22:06:43 -0000      1.43
+++ fortran/trans-expr.c        11 May 2005 14:25:55 -0000
@@ -1288,7 +1288,7 @@ gfc_conv_function_call (gfc_se * se, gfc

       if (!se->direct_byref)
        {
-         if (sym->result->attr.dimension)
+         if (sym->attr.dimension)
            {
              if (flag_bounds_check)
                {
Index: testsuite/ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/ChangeLog,v
retrieving revision 1.5466
diff -u -p -r1.5466 ChangeLog
--- testsuite/ChangeLog 11 May 2005 10:33:53 -0000      1.5466
+++ testsuite/ChangeLog 11 May 2005 14:26:01 -0000
@@ -1,3 +1,7 @@
+2005-05-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * gfortran.dg/func_result_2.f90: New test.
+
 2005-05-11  Bud Davis  <bdavis@gfortran.org>

        * gfortran.dg/dev_null.f90: New test.
Index: testsuite/gfortran.dg/func_result_2.f90
===================================================================
RCS file: testsuite/gfortran.dg/func_result_2.f90
diff -N testsuite/gfortran.dg/func_result_2.f90
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ testsuite/gfortran.dg/func_result_2.f90     11 May 2005 14:26:06 -0000
@@ -0,0 +1,10 @@
+! { dg-do run }
+! Character functions with a result clause were broken
+program testch
+  if (ch().ne."hello     ") call abort()
+contains
+  function ch result(str)
+    character(len = 10)  :: str
+    str ="hello"
+  end function ch
+end program testch