Hi All, The ChangeLog and comment make it clear what this patch does and why.
OK for mainline and backporting after a week or so? Regards Paul
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 51e0af410c1..c54b3c85621 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12108,6 +12108,17 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
tmp->n.sym->attr.use_assoc = 0;
tmp->n.sym->attr.intent = INTENT_UNKNOWN;
+ /* A new charlen is required to ensure that the variable string length
+ is different to that of the original lhs for deferred fcn results. */
+ if (e->expr_type == EXPR_FUNCTION
+ && e->ts.type == BT_CHARACTER
+ && e->symtree->n.sym->result->ts.deferred)
+ {
+ tmp->n.sym->ts.u.cl = gfc_get_charlen();
+ tmp->n.sym->ts.deferred = 1;
+ tmp->n.sym->ts.u.cl->next = gfc_current_ns->cl_list;
+ gfc_current_ns->cl_list = tmp->n.sym->ts.u.cl;
+ }
if (as)
{
diff --git a/gcc/testsuite/gfortran.dg/ptr_func_assign_6.f08 b/gcc/testsuite/gfortran.dg/ptr_func_assign_6.f08
new file mode 100644
index 00000000000..1fc0d69616a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr_func_assign_6.f08
@@ -0,0 +1,89 @@
+! { dg-do run }
+!
+! Test the fix for PR105054.
+!
+! Contributed by Arjen Markus <arjen.markus...@gmail.com>
+!
+module string_pointers
+ implicit none
+ character(len=20), dimension(10), target :: array_strings
+ character(len=:), dimension(:), target, allocatable :: array_strings2
+
+contains
+
+function pointer_to_string( i , flag)
+ integer, intent(in) :: i, flag
+
+ character(len=:), pointer :: pointer_to_string
+
+ if (flag == 1) then
+ pointer_to_string => array_strings(i)
+ return
+ endif
+
+ if (.not.allocated (array_strings2)) allocate (array_strings2(4), &
+ mold = ' ')
+ pointer_to_string => array_strings2(i)
+end function pointer_to_string
+
+function pointer_to_string2( i , flag) result (res)
+ integer, intent(in) :: i, flag
+
+ character(len=:), pointer :: res
+
+ if (flag == 1) then
+ res => array_strings(i)
+ return
+ endif
+
+ if (.not.allocated (array_strings2)) allocate (array_strings2(4), &
+ mold = ' ')
+ res => array_strings2(i)
+end function pointer_to_string2
+
+end module string_pointers
+
+program chk_string_pointer
+ use string_pointers
+ implicit none
+ integer :: i
+ character(*), parameter :: chr(4) = ['1234 ','ABCDefgh ', &
+ '12345678 ',' ']
+
+ pointer_to_string(1, 1) = '1234567890'
+ pointer_to_string(2, 1) = '12345678901234567890'
+
+ if (len(pointer_to_string(3, 1)) /= 20) stop 1
+
+ array_strings(1) = array_strings(1)(1:4) // 'ABC'
+ if (pointer_to_string(1, 1) /= '1234ABC') stop 2
+
+ pointer_to_string(1, 2) = '1234'
+ pointer_to_string(2, 2) = 'ABCDefgh'
+ pointer_to_string(3, 2) = '12345678'
+
+ do i = 1, 3
+ if (trim (array_strings2(i)) /= trim(chr(i))) print *, i, trim(array_strings2(i)), ' xx ',trim (chr(i))
+ enddo
+
+! Clear the target arrays
+ array_strings = repeat (' ', 20)
+ deallocate (array_strings2)
+
+! Repeat with an explicit resul.
+ pointer_to_string2(1, 1) = '1234567890'
+ pointer_to_string2(2, 1) = '12345678901234567890'
+
+ if (len(pointer_to_string(3, 1)) /= 20) stop 1
+
+ array_strings(1) = array_strings(1)(1:4) // 'ABC'
+ if (pointer_to_string(1, 1) /= '1234ABC') stop 2
+
+ pointer_to_string2(1, 2) = '1234'
+ pointer_to_string2(2, 2) = 'ABCDefgh'
+ pointer_to_string2(3, 2) = '12345678'
+
+ do i = 1, 3
+ if (trim (array_strings2(i)) /= trim(chr(i))) print *, i, trim(array_strings2(i)), ' xx ',trim (chr(i))
+ enddo
+end program chk_string_pointer
Change.Logs
Description: Binary data
