diff mbox series

[fortran] PR115700 - comment 5: uninitialized string length in ASSOCIATE

Message ID CAGkQGiL57i6RpbAGus9k3cFvngaqMvML=5ag8Brbo3mYLD0EDw@mail.gmail.com
State New
Headers show
Series [fortran] PR115700 - comment 5: uninitialized string length in ASSOCIATE | expand

Commit Message

Paul Richard Thomas Oct. 30, 2024, 4:41 p.m. UTC 
This wrinkle to PR115700 came about because the associate-name string
length was not being initialized, when an array selector had a substring
reference with non-constant start or end. This, of course, caused
subsequent references to fail.

The ChangeLog provides an adequate explanation of the attached patch.

OK for mainline and backporting to 14-branch?

Paul

Comments

Steve Kargl Oct. 30, 2024, 4:58 p.m. UTC | #1 
On Wed, Oct 30, 2024 at 04:41:40PM +0000, Paul Richard Thomas wrote:
> This wrinkle to PR115700 came about because the associate-name string
> length was not being initialized, when an array selector had a substring
> reference with non-constant start or end. This, of course, caused
> subsequent references to fail.
> 
> The ChangeLog provides an adequate explanation of the attached patch.
> 
> OK for mainline and backporting to 14-branch?
> 

Yes.  Thanks for the patch.
Jerry D Oct. 30, 2024, 5:01 p.m. UTC | #2 
On 10/30/24 9:58 AM, Steve Kargl wrote:
> On Wed, Oct 30, 2024 at 04:41:40PM +0000, Paul Richard Thomas wrote:
>> This wrinkle to PR115700 came about because the associate-name string
>> length was not being initialized, when an array selector had a substring
>> reference with non-constant start or end. This, of course, caused
>> subsequent references to fail.
>>
>> The ChangeLog provides an adequate explanation of the attached patch.
>>
>> OK for mainline and backporting to 14-branch?
>>
> 
> Yes.  Thanks for the patch.
> 

The comment in the test case refers to a tmp4. There is no tmp4 
referenced in the test case.

Jerry
Paul Richard Thomas Oct. 30, 2024, 10:07 p.m. UTC | #3 
You see, Jerry, it's the tmp4 that might have been or, perhaps, was and is
no more :-) The comment will be changed.

Thanks for the review.

Paul


On Wed, 30 Oct 2024 at 17:01, Jerry D <jvdelisle2@gmail.com> wrote:

> On 10/30/24 9:58 AM, Steve Kargl wrote:
> > On Wed, Oct 30, 2024 at 04:41:40PM +0000, Paul Richard Thomas wrote:
> >> This wrinkle to PR115700 came about because the associate-name string
> >> length was not being initialized, when an array selector had a substring
> >> reference with non-constant start or end. This, of course, caused
> >> subsequent references to fail.
> >>
> >> The ChangeLog provides an adequate explanation of the attached patch.
> >>
> >> OK for mainline and backporting to 14-branch?
> >>
> >
> > Yes.  Thanks for the patch.
> >
>
> The comment in the test case refers to a tmp4. There is no tmp4
> referenced in the test case.
>
> Jerry
>
diff mbox series

Patch

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 565d4aa5fe9..8045deddd8a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6153,6 +6153,15 @@  resolve_variable (gfc_expr *e)
 	  e->ref = newref;
 	}
     }
+  else if (sym->assoc && sym->ts.type == BT_CHARACTER && sym->ts.deferred)
+    {
+      gfc_ref *ref;
+      for (ref = e->ref; ref; ref = ref->next)
+	if (ref->type == REF_SUBSTRING)
+	  break;
+      if (ref == NULL)
+	e->ts = sym->ts;
+    }
 
   if (e->ref && !gfc_resolve_ref (e))
     return false;
@@ -9871,6 +9880,15 @@  resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   /* Fix up the type-spec for CHARACTER types.  */
   if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
     {
+      gfc_ref *ref;
+      for (ref = target->ref; ref; ref = ref->next)
+	if (ref->type == REF_SUBSTRING
+	    && ((ref->u.ss.start
+		 && ref->u.ss.start->expr_type != EXPR_CONSTANT)
+		|| (ref->u.ss.end
+		    && ref->u.ss.end->expr_type != EXPR_CONSTANT)))
+	  break;
+
       if (!sym->ts.u.cl)
 	sym->ts.u.cl = target->ts.u.cl;
 
@@ -9889,9 +9907,10 @@  resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 		gfc_get_int_expr (gfc_charlen_int_kind, NULL,
 				  target->value.character.length);
 	}
-      else if ((!sym->ts.u.cl->length
-		|| sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+      else if (((!sym->ts.u.cl->length
+		 || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
 		&& target->expr_type != EXPR_VARIABLE)
+	       || ref)
 	{
 	  if (!sym->ts.deferred)
 	    {
@@ -9901,7 +9920,10 @@  resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 
 	  /* This is reset in trans-stmt.cc after the assignment
 	     of the target expression to the associate name.  */
-	  sym->attr.allocatable = 1;
+	  if (ref && sym->as)
+	    sym->attr.pointer = 1;
+	  else
+	    sym->attr.allocatable = 1;
 	}
     }
 
@@ -11508,8 +11530,9 @@  resolve_block_construct (gfc_code* code)
 {
   gfc_namespace *ns = code->ext.block.ns;
 
-  /* For an ASSOCIATE block, the associations (and their targets) are already
-     resolved during resolve_symbol. Resolve the BLOCK's namespace.  */
+  /* For an ASSOCIATE block, the associations (and their targets) will be
+     resolved by gfc_resolve_symbol, during resolution of the BLOCK's
+     namespace.  */
   gfc_resolve (ns);
 }
 
diff --git a/gcc/testsuite/gfortran.dg/associate_70.f90 b/gcc/testsuite/gfortran.dg/associate_70.f90
new file mode 100644
index 00000000000..397754c0b52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_70.f90
@@ -0,0 +1,40 @@ 
+! { dg-do run }
+! ( dg-options "-Wuninitialized" )
+!
+! Test fix for PR115700 comment 5, in which ‘.tmp4’ is used uninitialized and
+! both normal and scalarized array references did not work correctly.
+!
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+!
+  character(4), dimension(3) :: chr = ['abcd', 'efgh', 'ijkl']
+  call mvce (chr)
+  if (any (chr /= ['ABcd', 'EFgh', 'IJkl'])) stop 1
+contains
+  subroutine mvce(x)
+    implicit none
+    character(len=*), dimension(:), intent(inOUT), target :: x
+    integer :: i
+    i = len(x)
+
+! This was broken
+    associate (tmp1 => x(:)(1:i/2))
+      if (len (tmp1) /= i/2) stop 2
+      if (tmp1(2) /= 'ef') stop 3
+      if (any (tmp1 /= ['ab', 'ef', 'ij'])) stop 4
+      tmp1 = ['AB','EF','IJ']
+    end associate
+
+! Retest things that worked previously.
+    associate (tmp2 => x(:)(1:2))
+      if (len (tmp2) /= i/2) stop 5
+      if (tmp2(2) /= 'EF') stop 6
+      if (any (tmp2 /= ['AB','EF','IJ'])) stop 7
+    end associate
+
+    associate (tmp3 => x(3)(1:i/2))
+      if (len (tmp3) /= i/2) stop 8
+      if (tmp3 /= 'IJ') stop 9
+    end associate
+
+  end subroutine mvce
+end