public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [patch, fortran] Fix character length in constructors
@ 2018-02-19 22:41 Thomas Koenig
  2018-02-19 22:51 ` Steve Kargl
  2018-02-20  7:51 ` Janne Blomqvist
  0 siblings, 2 replies; 7+ messages in thread
From: Thomas Koenig @ 2018-02-19 22:41 UTC (permalink / raw)
  To: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 789 bytes --]

Hello world,

when putting in a seemingly innocent simplification for PR 56342,
I caused a regression in PR 82823, in PACK. The root cause of
this one turned out to be PR 48890, in which structure
constructors containing characters were not handled correctly
if the lengths did not match.

The attached patch fixes that.

Regression-tested. OK for trunk?

Regards

	Thomas

2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/48890
         PR fortran/83823
         * primary.c (gfc_convert_to_structure_constructor):
         For a constant string constructor, make sure the length
         is correct.

2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/48890
         PR fortran/83823
         * gfortran.dg/structure_constructor_14.f90: New test.

[-- Attachment #2: structure_constructor_14.f90 --]
[-- Type: text/x-fortran, Size: 741 bytes --]

! { dg-do  run }
! PR 48890, PR 83823
! Test fix for wrong length in parameters. Original test cases
! by mhp77 (a) gmx.at and Harald Anlauf.

program gfcbug145
  implicit none
  type t_obstyp
    character(len=8) :: name
  end type t_obstyp
  type (t_obstyp) ,parameter :: obstyp(*)= &
     [ t_obstyp ('SYNOP' ), &
       t_obstyp ('DRIBU' ), &
       t_obstyp ('TEMP'  ), &
       t_obstyp ('RADAR' )  ]
  logical :: mask(size(obstyp)) = .true.
  character(len=100) :: line
  type (t_obstyp), parameter :: x = t_obstyp('asdf')

  write(line,'(20(a8,:,"|"))') pack (obstyp% name, mask)
  if (line /= 'SYNOP   |DRIBU   |TEMP    |RADAR') call abort
  write (line,'("|",A,"|")') x
  if (line /= "|asdf    |") call abort
end program gfcbug145

[-- Attachment #3: p2.diff --]
[-- Type: text/x-patch, Size: 1373 bytes --]

Index: primary.c
===================================================================
--- primary.c	(Revision 257788)
+++ primary.c	(Arbeitskopie)
@@ -2879,6 +2879,38 @@ gfc_convert_to_structure_constructor (gfc_expr *e,
       if (!this_comp)
 	goto cleanup;
 
+      /* For a constant string constructor, make sure the length is correct;
+	 truncate of fill with blanks if needed.  */
+      if (this_comp->ts.type == BT_CHARACTER && !this_comp->attr.allocatable
+	  && this_comp->ts.u.cl && this_comp->ts.u.cl->length
+	  && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && actual->expr->expr_type == EXPR_CONSTANT)
+	{
+	  ptrdiff_t c, e;
+	  c = mpz_get_si (this_comp->ts.u.cl->length->value.integer);
+	  e = actual->expr->value.character.length;
+
+	  if (c != e)
+	    {
+	      ptrdiff_t i, to;
+	      gfc_char_t *dest;
+	      dest = gfc_get_wide_string (c + 1);
+
+	      to = e < c ? e : c;
+	      for (i = 0; i < to; i++)
+		dest[i] = actual->expr->value.character.string[i];
+	      
+	      for (i = e; i < c; i++)
+		dest[i] = ' ';
+
+	      dest[c] = '\0';
+	      free (actual->expr->value.character.string);
+
+	      actual->expr->value.character.length = c;
+	      actual->expr->value.character.string = dest;
+	    }
+	}
+
       comp_tail->val = actual->expr;
       if (actual->expr != NULL)
 	comp_tail->where = actual->expr->where;

^ permalink raw reply	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2018-02-20 19:54 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-02-19 22:41 [patch, fortran] Fix character length in constructors Thomas Koenig
2018-02-19 22:51 ` Steve Kargl
2018-02-20  7:51 ` Janne Blomqvist
2018-02-20 15:29   ` Steve Kargl
2018-02-20 18:59   ` Thomas Koenig
2018-02-20 19:10     ` Janne Blomqvist
2018-02-20 19:54       ` Thomas Koenig

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).