User account creation filtered due to spam.

Bug 31608 - wrong types in character array/scalar binop
Summary: wrong types in character array/scalar binop
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.3.0
: P3 normal
Target Milestone: ---
Assignee: Paul Thomas
URL:
Keywords: ice-on-valid-code, wrong-code
Depends on:
Blocks: 31237 32834 22368 31610
  Show dependency treegraph
 
Reported: 2007-04-17 17:22 UTC by Richard Biener
Modified: 2007-11-18 17:16 UTC (History)
6 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2007-11-16 17:01:51


Attachments
Patch for 4 testcases of this PR (1.46 KB, patch)
2007-10-05 21:59 UTC, Francois-Xavier Coudert
Details | Diff
char_cast_1.f90.003t.original (2.91 KB, text/plain)
2007-10-25 02:39 UTC, dave
Details

Note You need to log in before you can comment on or make changes to this bug.
Description Richard Biener 2007-04-17 17:22:45 UTC
gfortran.dg/achar_4.f90 generates the following snippet of original trees:

    {
      int8 S.5;

      S.5 = 0;
      while (1)
        {
          if (S.5 > (D.1394 + 0) - 1) goto L.1;
          {
            char char.6;

            char.6 = (*(char[0:][1:1] *) atmp.0.data)[S.5][1]{lb: 1 sz: 1} + 224;
            (*(char[0:][1:1] *) atmp.4.data)[S.5] = *(_gfortran_compare_string (D.1384, &(*(char[0:][1:1] *) atmp.2.data)[S.5], 1, "a") >= 0 && _gfortran_compare_string (D.1393, &(*(char[0:][1:1] *) atmp.3.data)[S.5], 1, "z") <= 0 ? &char.6 : &(*(char[0:][1:1] *) atmp.1.data)[S.5]);
          }
          S.5 = S.5 + 1;
        }
      L.1:;
    }

which clearly has mismatched types in the two arms of the COND_EXPR

  .... = .... ? &char.6 : &(*(char[0:][1:1] *) atmp.1.data)[S.5])

the then arm is of type char* while the else arm has pointer to array type.

This confuses the middle-end.
Comment 1 Tobias Schlüter 2007-04-17 17:27:43 UTC
Adding pault, as he's the likely culprit :)

Paul, I'm wondering if the testcase is really valid Fortran:
<snip>
  if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) call abort ()
contains
  Character (len=20) Function Up (string)
</snip>
It looks like it's comparing a CHARACTER*20 (= Up's result) to an array of characters (= the array constructor).

I don't see how I could confirm "confusion" of the middle-end :-)
Comment 2 Paul Thomas 2007-04-18 09:36:15 UTC
(In reply to comment #1)
> Adding pault, as he's the likely culprit :)
>

Richard and Tobi,

I am a bit trapped right now, as chairman of a review meeting; I'll try to look at it this evening.

On the face of it, character*(20) .ne. array of character*(1) should not be allowed!

Paul

Comment 3 Tobias Burnus 2007-04-18 10:21:38 UTC
(In reply to comment #1)
> <snip>
>   if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) call abort ()
> contains
>   Character (len=20) Function Up (string)
> </snip>
>
> It looks like it's comparing a CHARACTER*20 (= Up's result) to an array of
> characters (= the array constructor).

I think this is not allowed in Fortran 95 mode, but I'm not 100% sure about Fortran 2003; I think it is also not allowed, but one has to check the standard (cf. PR30940).
Comment 4 Paul Thomas 2007-04-18 10:44:38 UTC
(In reply to comment #2)

Changing the comparison to
 
  if (Up ("AbCdEfGhIjKlM") .ne. "ABCDEFGHIJKLM") call abort ()

gets rid of the problem.

I have clearly exposed something extremely unpleasant in ANY or the comparison that needs to be stopped by the front-end.

I will test and commit the modified testcase, under the "obvious" rule, tonight.  In addition, I will pin down the frontend bug and transmute this PR to reflect that.

Paul
Comment 5 Tobias Schlüter 2007-04-18 23:56:14 UTC
For the record, the problem Richard is pointing out is in the body of the function Up, namely in the expression for MERGE, probably caused by TRANSFER.  Nevertheless, the accepts-invalid is also an embarassing problem (unless we collectively misunderstand Fortran rules :)
Comment 6 Tobias Burnus 2007-04-19 07:44:34 UTC
> Nevertheless, the accepts-invalid is also an embarassing problem (unless we
> collectively misunderstand Fortran rules :)

Well, we do.
  if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) stop 'ERROR'
compiles with
- NAG f95 5.1(346)
- g95 -std=f95 -W -Wall -Wextra -pedantic   4.0.3 (g95 0.91!) Feb 23 2007
- ifort -stand f95 -warn all  (9.1.040, 10.0.017beta)
- sunf95 -w4  8.3 Build35_2 2006/12/04

And, of cause, it does not have anything to do with Fortran 2003 (The following would be: up("abcdef") -> function up(string); character(len=1), dimension(:) :: string).

What we have here is:

7.1.5 Conformability rules for elemental operations
[...]
For all elemental binary operations, the two operands shall be in shape conformance. In the case where one is a scalar and the other an array, the scalar is treated as if it were an array of the same shape as the array operand with every element, if any, of the array equal to the value of the scalar.
Comment 7 Tobias Schlüter 2007-04-19 09:08:07 UTC
Subject: Re:  wrong types in array transfer

burnus at gcc dot gnu dot org wrote:
> ------- Comment #6 from burnus at gcc dot gnu dot org  2007-04-19 07:44 -------
>> Nevertheless, the accepts-invalid is also an embarassing problem (unless we
>> collectively misunderstand Fortran rules :)
> 
> Well, we do.

That doesn't make it any less embarassing :)  But indeed this is the 
same as "1 .eq. (/1,2/)" which evaluates to (/.true.,.false./), should 
have thought of this earlier.

Comment 8 Paul Thomas 2007-04-19 10:37:56 UTC
(In reply to comment #7)

I am completely trapped by the workshop that I am running and have not even managed to do what I promised last night.  Realistically, it might have to wait until the weekend.  If you can develop a description of what the real PR should be, I would be grateful.

BTW - thanks to Richard for noticing it...... might I ask how you came across it?

Paul
Comment 9 Richard Biener 2007-04-19 12:08:11 UTC
The patch in http://gcc.gnu.org/ml/gcc-patches/2007-04/msg01075.html makes the
testcase ICE because of the type mismatch.
Comment 10 Paul Thomas 2007-04-19 15:20:52 UTC
(In reply to comment #5)
> For the record, the problem Richard is pointing out is in the body of the
> function Up, namely in the expression for MERGE, probably caused by TRANSFER. 

Duuh! You are right about where the problem is.  Look, I am not in a position to usefully contribute right now.  Please take such action as you see fit; eg. withdraw the testcase and restore the PR, so that Richard can get going.

Paul
Comment 11 Richard Biener 2007-04-19 15:55:59 UTC
It's not blocking me atm as a different patch got accepted which doesn't expose
this problem.
Comment 12 Paul Thomas 2007-05-31 20:40:14 UTC
I am not at all convinced that this is the fault of gfc_trans_array_transfer.  It is quite correctly producing &(*(char[0:][1:1] as the output type.  The problem is the comaprison between an array of character(1)'s and the scalar character.  Some sorting out is needed in the binary operator that has a character array on one side and a character scalar on the other.

I have changed the title to reflect this but this does not mean that I will ignore it.

Paul
Comment 13 Andrew Pinski 2007-07-10 23:36:15 UTC
I think this was fixed with http://gcc.gnu.org/ml/gcc-patches/2007-06/msg01471.html

aka PR32140.

Comment 14 rguenther@suse.de 2007-07-11 08:36:26 UTC
Subject: Re:  wrong types in character array/scalar binop

On Wed, 10 Jul 2007, pinskia at gcc dot gnu dot org wrote:

> ------- Comment #13 from pinskia at gcc dot gnu dot org  2007-07-10 23:36 -------
> I think this was fixed with
> http://gcc.gnu.org/ml/gcc-patches/2007-06/msg01471.html
> 
> aka PR32140.

No, it's still there.

Richard.
Comment 15 Joost VandeVondele 2007-07-11 08:52:37 UTC
FYI, testcase is standard conforming code AFAICT.
Comment 16 Richard Biener 2007-07-11 09:55:00 UTC
Trying to reduce the testcase, the following ICEs:

contains
  Character (len=20) Function Up (string)
    Character(len=*) string
    Up =                                                                &
     transfer(merge(transfer(string,"x",len(string)),    &
       string, .true.), "x")
    return
  end function Up
end


./f951 -quiet achar_4.f90
achar_4.f90: In function 'up':
achar_4.f90:9: internal compiler error: in gfc_conv_expr_descriptor, at fortran/trans-array.c:4525
Please submit a full bug report,
with preprocessed source if appropriate.
See <URL:http://gcc.gnu.org/bugs.html> for instructions.
Comment 17 Richard Biener 2007-07-11 10:00:55 UTC
Reduced testcase:

contains
  Character (len=20) Function Up (string)
    Character(len=*) string
    Up = transfer(achar(iachar(transfer(string,"x",1))), "x")
    return
  end function Up
end


            char.3 = (*(char[0:][1:1] *) atmp.0.data)[S.2][1]{lb: 1 sz: 1};
            (*(char[0:][1:1] *) atmp.1.data)[S.2] = char.3;

the first line is correct, the second is not.
Comment 18 Richard Biener 2007-07-11 10:13:49 UTC
Built from

#0  build4_stat (code=ARRAY_REF, tt=0x2b468e0df750, arg0=0x2b468e0e4880, 
    arg1=0x2b468e0e7000, arg2=0x0, arg3=0x0)
    at /space/rguenther/src/svn/pointer_plus/gcc/tree.c:3170
#1  0x0000000000497ae4 in gfc_build_array_ref (base=0x2b468e0e4880, 
    offset=0x2b468e0e7000)
    at /space/rguenther/src/svn/pointer_plus/gcc/fortran/trans.c:317
#2  0x000000000049eab7 in gfc_conv_scalarized_array_ref (se=0x7fff1d4d8400, 
    ar=0x0)
    at /space/rguenther/src/svn/pointer_plus/gcc/fortran/trans-array.c:2227
#3  0x00000000004a5b0c in gfc_conv_expr_descriptor (se=0x7fff1d4d8860, 
    expr=0x1395c70, ss=0x1397540)
    at /space/rguenther/src/svn/pointer_plus/gcc/fortran/trans-array.c:4583
#4  0x00000000004a703e in gfc_conv_array_parameter (se=0x7fff1d4d8860, 
    expr=0x1395c70, ss=0x1397540, g77=1)
    at /space/rguenther/src/svn/pointer_plus/gcc/fortran/trans-array.c:4887
#5  0x00000000004d0cd2 in gfc_conv_intrinsic_transfer (se=0x7fff1d4d8be0, 
    expr=0x1395a10)
    at /space/rguenther/src/svn/pointer_plus/gcc/fortran/trans-intrinsic.c:3195

but I'm lost where to fix this up.  Fortran FE functions are poorly documented.
It's unclear whether the descriptors are wrong or not.
Comment 19 Joost VandeVondele 2007-07-11 10:25:17 UTC
(In reply to comment #16)
> Trying to reduce the testcase, the following ICEs:

PR 31610 ?
Comment 20 Francois-Xavier Coudert 2007-10-03 08:08:50 UTC
Further reduced testcase:

  integer i(1)
  print *, transfer(achar(i), "x")
  end

The type mismatch disappears if you change the transfer statement into transfer(["x"]), "x", so this is a problem in the return type of achar in trans-intrinsic.c, I think.

Also, there are an interesting number of ICEs for testcases differing only slightly with the one reported here, including:

  integer i(1)
  print *, transfer(char(i), "x")
  end

and

  character(len=1) :: string
  print *, transfer(((transfer(string,"x",1))), "x")
  end
Comment 21 Francois-Xavier Coudert 2007-10-05 17:41:42 UTC
Yet another one:

  print *, transfer(achar([0]), 0_1)
  end

Reducing this testcase has opened Pandora's box, I'll try to fix them one after another. 
Comment 22 Francois-Xavier Coudert 2007-10-05 21:59:46 UTC
Created attachment 14307 [details]
Patch for 4 testcases of this PR

The following three cases are fixed by the patch attached (fix resolution of CHAR by factoring code with ACHAR, and prevent too agressive simplification of TRANSFER; I also factored the code for simplification of CHAR and ACHAR, even though it's not required to fix the bug):

  integer i(1)
  print *, transfer(achar(i), "x")
  end
-------------------------------
  integer i(1)
  print *, transfer(char(i), "x")
  end
-------------------------------
  print *, transfer(achar([0]), 0_1)
  end
Comment 23 Francois-Xavier Coudert 2007-10-05 22:02:15 UTC
(In reply to comment #22)
> Created an attachment (id=14307) [edit]
> Patch for 4 testcases of this PR

It also fixes that one:

contains
  Character (len=20) Function Up (string)
    Character(len=*) string
    Up = transfer(achar(iachar(transfer(string,"x",1))), "x")
    return
  end function Up
end

But the original achar_4.f90 still generates mismatched types and the following stills ICEs:

contains
  Character (len=20) Function Up (string)
    Character(len=*) string
    Up =                                                                &
     transfer(merge(transfer(string,"x",len(string)),    &
       string, .true.), "x")
    return
  end function Up
end
Comment 24 Dominique d'Humieres 2007-10-06 21:47:10 UTC
The patch in comment #22 fixes the 3 PR's, but cause a quite massive regression on my tests, for instance:

INTEGER :: I
CHARACTER(LEN=100) :: data="1.0 3.0"
REAL :: C,D
READ(data,*) C,D
I=TRANSFER(C/D,I)
SELECT CASE(I)
CASE (TRANSFER(1.0/3.0,1))
CASE DEFAULT
 CALL ABORT()
END SELECT
END

now gives

pr31216.f90:5: internal compiler error: Segmentation Fault

and so on. I did not have the time to comb the regressions, but for 3 ICE's fixed I have15 new ones.

Comment 25 Paul Thomas 2007-10-07 12:49:32 UTC
(In reply to comment #17)

> 
> the first line is correct, the second is not.
>

Richard, does this do it for you?

  {
    char char.3[1:1];

    char.3[1]{lb: 1 sz: 1} = (*(char[0:][1:1] *) atmp.0.data)[S.2][1]{lb: 1 sz: 1};
    (*(char[0:][1:1] *) atmp.1.data)[S.2] = char.3;
  }


Paul
Comment 26 rguenther@suse.de 2007-10-08 08:47:05 UTC
Subject: Re:  wrong types in character array/scalar binop

On Sun, 7 Oct 2007, pault at gcc dot gnu dot org wrote:

> 
> 
> ------- Comment #25 from pault at gcc dot gnu dot org  2007-10-07 12:49 -------
> (In reply to comment #17)
> 
> > 
> > the first line is correct, the second is not.
> >
> 
> Richard, does this do it for you?
> 
>   {
>     char char.3[1:1];
> 
>     char.3[1]{lb: 1 sz: 1} = (*(char[0:][1:1] *) atmp.0.data)[S.2][1]{lb: 1 sz:
> 1};
>     (*(char[0:][1:1] *) atmp.1.data)[S.2] = char.3;
>   }

The first line looks good, the second line not, as I think the middle-end
does not allow assignments of arrays - you have

  char[1:1] = char[1:1]

here, so I think this should be

  (*(char[0:][1:1] *) atmp.1.data)[S.2][1] = char.3[1];

instead.  But the type checker should have complained (though it might
be imperfect there).

Richard.
Comment 27 Paul Thomas 2007-10-10 07:05:53 UTC
(In reply to comment #17)
>             char.3 = (*(char[0:][1:1] *) atmp.0.data)[S.2][1]{lb: 1 sz: 1};
>             (*(char[0:][1:1] *) atmp.1.data)[S.2] = char.3;
> the first line is correct, the second is not.

For the record, the patch at the end produces:

            char char.3[1:1];
            char.3[1]{lb: 1 sz: 1} = (*(char[0:][1:1] *) atmp.0.data)[S.2][1]{lb
: 1 sz: 1};
            (*(char[0:][1:1] *) atmp.1.data)[S.2] = char.3[1]{lb: 1 sz: 1};

which is nearly there.  The lhs of the bottom line now needs to be the first element of the string; ie. (*(char[0:][1:1] *) atmp.1.data)[S.2][1] and we will be there.  The problem is that I cannot figure out yet where the assignment occurs, in order to do anything with the lhs!

Paul

Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c	(révision 129121)
--- gcc/fortran/trans-intrinsic.c	(copie de travail)
*************** gfc_conv_intrinsic_char (gfc_se * se, gf
*** 1278,1297 ****
    tree arg;
    tree var;
    tree type;
  
    gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
  
    /* We currently don't support character types != 1.  */
    gcc_assert (expr->ts.kind == 1);
!   type = gfc_character1_type_node;
    var = gfc_create_var (type, "char");
  
!   arg = convert (type, arg);
!   gfc_add_modify_expr (&se->pre, var, arg);
!   se->expr = gfc_build_addr_expr (build_pointer_type (type), var);
    se->string_length = integer_one_node;
  }
- 
  
  static void
  gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
--- 1278,1298 ----
    tree arg;
    tree var;
    tree type;
+   tree elem;
  
    gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
  
    /* We currently don't support character types != 1.  */
    gcc_assert (expr->ts.kind == 1);
!   type = gfc_typenode_for_spec (&expr->ts);
    var = gfc_create_var (type, "char");
  
!   arg = convert (gfc_character1_type_node, arg);
!   elem = gfc_build_array_ref (var, gfc_index_one_node, NULL);
!   gfc_add_modify_expr (&se->pre, elem, arg);
!   se->expr = gfc_build_addr_expr (pchar_type_node, elem);
    se->string_length = integer_one_node;
  }
  
  static void
  gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)


Comment 28 Paul Thomas 2007-10-10 15:44:59 UTC
The patch below fixes the lot.  It was not necessary in the end to touch trans-intrinsic.c.  Once the appropriate, offending bit of trans-array.c was fixed, all the casting occurred correctly.  The fixes to iresolve.c deal with the various ICEing testcases in the comments below and are partially based on FX's input.

This now compiles an runs correctly.

  character(len=1) :: string = "z"
  integer :: i(1) = (/100/)
  print *, Up("abc")
  print *, transfer(((transfer(string,"x",1))), "x",1)
  print *, transfer(char(i), "x")
  print *, Upper ("abcdefg")
 contains
  Character (len=20) Function Up (string)
    Character(len=*) string
    character(1) :: chr
    Up = transfer(achar(iachar(transfer(string,chr,1))), "x")
    return
  end function Up
  Character (len=20) Function Upper (string)
    Character(len=*) string
    Upper =                                                                &
     transfer(merge(transfer(string,"x",len(string)),    &
       string, .true.), "x")
    return
  end function Upper
end

and the code in achar, which Richard flagged up has become:

            char char.6;

            char.6 = (*(char[0:][1:1] *) atmp.3.data)[S.5][1]{lb: 1 sz: 1};
            (*(char[0:][1:1] *) atmp.4.data)[S.5][1]{lb: 1 sz: 1} = char.6;

The patch even regtests but I will check tonto and cp2k before submitting.

Cheers

Paul

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c   (révision 129121)
--- gcc/fortran/trans-array.c   (copie de travail)
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4711,4717 ****
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);

!       gfc_add_modify_expr (&block, lse.expr, rse.expr);

        /* Finish the copying loops.  */
        gfc_trans_scalarizing_loops (&loop, &block);
--- 4711,4725 ----
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);

!       if (TREE_CODE (rse.expr) != INDIRECT_REF)
!       {
!         lse.string_length = rse.string_length;
!         tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
!                                 expr->expr_type == EXPR_VARIABLE);
!         gfc_add_expr_to_block (&block, tmp);
!       }
!       else
!       gfc_add_modify_expr (&block, lse.expr, rse.expr);

        /* Finish the copying loops.  */
        gfc_trans_scalarizing_loops (&loop, &block);
Index: gcc/fortran/iresolve.c
===================================================================
*** gcc/fortran/iresolve.c      (révision 129121)
--- gcc/fortran/iresolve.c      (copie de travail)
*************** gfc_get_string (const char *format, ...)
*** 62,75 ****
  static void
  check_charlen_present (gfc_expr *source)
  {
!   if (source->expr_type == EXPR_CONSTANT && source->ts.cl == NULL)
      {
        source->ts.cl = gfc_get_charlen ();
        source->ts.cl->next = gfc_current_ns->cl_list;
        gfc_current_ns->cl_list = source->ts.cl;
        source->ts.cl->length = gfc_int_expr (source->value.character.length);
        source->rank = 0;
      }
  }

  /* Helper function for resolving the "mask" argument.  */
--- 62,85 ----
  static void
  check_charlen_present (gfc_expr *source)
  {
!   if (source->ts.cl == NULL)
      {
        source->ts.cl = gfc_get_charlen ();
        source->ts.cl->next = gfc_current_ns->cl_list;
        gfc_current_ns->cl_list = source->ts.cl;
+     }
+
+   if (source->expr_type == EXPR_CONSTANT)
+     {
        source->ts.cl->length = gfc_int_expr (source->value.character.length);
        source->rank = 0;
      }
+   else if (source->expr_type == EXPR_ARRAY)
+     {
+       source->ts.cl->length =
+       gfc_int_expr (source->value.constructor->expr->value.character.length);
+       source->rank = 1;
+     }
  }

  /* Helper function for resolving the "mask" argument.  */
*************** gfc_resolve_access (gfc_expr *f, gfc_exp
*** 132,139 ****
  }


! void
! gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind)
  {
    f->ts.type = BT_CHARACTER;
    f->ts.kind = (kind == NULL)
--- 142,150 ----
  }


! static void
! gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
!                       const char *name)
  {
    f->ts.type = BT_CHARACTER;
    f->ts.kind = (kind == NULL)
*************** gfc_resolve_achar (gfc_expr *f, gfc_expr
*** 143,155 ****
    gfc_current_ns->cl_list = f->ts.cl;
    f->ts.cl->length = gfc_int_expr (1);

!   f->value.function.name = gfc_get_string ("__achar_%d_%c%d", f->ts.kind,
                                           gfc_type_letter (x->ts.type),
                                           x->ts.kind);
  }


  void
  gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
  {
    f->ts = x->ts;
--- 154,173 ----
    gfc_current_ns->cl_list = f->ts.cl;
    f->ts.cl->length = gfc_int_expr (1);

!   f->value.function.name = gfc_get_string (name, f->ts.kind,
                                           gfc_type_letter (x->ts.type),
                                           x->ts.kind);
  }


  void
+ gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind)
+ {
+   gfc_resolve_char_achar (f, x, kind, "__achar_%d_%c%d");
+ }
+
+
+ void
  gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
  {
    f->ts = x->ts;
*************** gfc_resolve_ceiling (gfc_expr *f, gfc_ex
*** 379,390 ****
  void
  gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
  {
!   f->ts.type = BT_CHARACTER;
!   f->ts.kind = (kind == NULL)
!            ? gfc_default_character_kind : mpz_get_si (kind->value.integer);
!   f->value.function.name
!     = gfc_get_string ("__char_%d_%c%d", f->ts.kind,
!                     gfc_type_letter (a->ts.type), a->ts.kind);
  }


--- 397,403 ----
  void
  gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
  {
!   gfc_resolve_char_achar (f, a, kind, "__char_%d_%c%d");
  }


*************** gfc_resolve_transfer (gfc_expr *f, gfc_e
*** 2269,2274 ****
--- 2282,2290 ----
  {
    /* TODO: Make this do something meaningful.  */
    static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
+
+   if (mold->ts.type == BT_CHARACTER && !mold->ts.cl->length)
+     mold->ts.cl->length = gfc_int_expr (mold->value.character.length);

    f->ts = mold->ts;

Comment 29 rguenther@suse.de 2007-10-10 15:47:04 UTC
Subject: Re:  wrong types in character array/scalar binop

On Wed, 10 Oct 2007, pault at gcc dot gnu dot org wrote:

> ------- Comment #28 from pault at gcc dot gnu dot org  2007-10-10 15:44 -------
> The patch below fixes the lot.  It was not necessary in the end to touch
> trans-intrinsic.c.  Once the appropriate, offending bit of trans-array.c was
> fixed, all the casting occurred correctly.  The fixes to iresolve.c deal with
> the various ICEing testcases in the comments below and are partially based on
> FX's input.
> 
> This now compiles an runs correctly.
> 
>   character(len=1) :: string = "z"
>   integer :: i(1) = (/100/)
>   print *, Up("abc")
>   print *, transfer(((transfer(string,"x",1))), "x",1)
>   print *, transfer(char(i), "x")
>   print *, Upper ("abcdefg")
>  contains
>   Character (len=20) Function Up (string)
>     Character(len=*) string
>     character(1) :: chr
>     Up = transfer(achar(iachar(transfer(string,chr,1))), "x")
>     return
>   end function Up
>   Character (len=20) Function Upper (string)
>     Character(len=*) string
>     Upper =                                                                &
>      transfer(merge(transfer(string,"x",len(string)),    &
>        string, .true.), "x")
>     return
>   end function Upper
> end
> 
> and the code in achar, which Richard flagged up has become:
> 
>             char char.6;
> 
>             char.6 = (*(char[0:][1:1] *) atmp.3.data)[S.5][1]{lb: 1 sz: 1};
>             (*(char[0:][1:1] *) atmp.4.data)[S.5][1]{lb: 1 sz: 1} = char.6;

nice.

> The patch even regtests but I will check tonto and cp2k before submitting.

Thanks for the efforts!

Richard.
Comment 30 Paul Thomas 2007-10-11 05:17:32 UTC
(In reply to comment #21)
>   print *, transfer(achar([0]), 0_1)
>   end
> Reducing this testcase has opened Pandora's box, I'll try to fix them one after
> another. 

FX,

This one is highly unpleasant and seems to occur in simplify_transfer.
This also fails:

  print *, transfer(sqrt([100.]), 0_1)

Cheers

Paul
Comment 31 Dominique d'Humieres 2007-10-11 10:17:26 UTC
Works as advertised without regression so far (PPC Darwin, 32 bit mode close to complete), but for the codelets in #30.

I wonder if the code in #28 is valid: the line(s)

merge(transfer(string,"x",len(string)), string, .true.)

does not seems to obey:

13.7.75 MERGE (TSOURCE, FSOURCE, MASK)

...
FSOURCE shall be of the same type and type parameters as TSOURCE.

If I am not mistaken transfer(string,"x",len(string)) is an array of characters of rank one, size len(string), of character(1), while string is a scalar character(20) (13.7.121 TRANSFER (SOURCE, MOLD [, SIZE]) ... Case (iii): If SIZE is present, the result is an array of rank one and size SIZE.).

The patched gfortran, Intel, and g95 accept the code and give the same result; xlf accept the code, but gives some garbage in the first and fourth lines of the output; Portland Group compiler rejects the code with:

PGF90-S-0074-Illegal number or type of arguments to merge - keyword argument fsource (pr31608_4.f90: 16)

Should I fill another PR?
Comment 32 Paul Thomas 2007-10-12 17:32:03 UTC
(In reply to comment #31)
> Works as advertised without regression so far (PPC Darwin, 32 bit mode close to
> complete), but for the codelets in #30.
> 
> I wonder if the code in #28 is valid: the line(s)
> 
> merge(transfer(string,"x",len(string)), string, .true.)
> 
> does not seems to obey:
> 
> 13.7.75 MERGE (TSOURCE, FSOURCE, MASK)
> 
> ...
> FSOURCE shall be of the same type and type parameters as TSOURCE.
> 
> If I am not mistaken transfer(string,"x",len(string)) is an array of characters
> of rank one, size len(string), of character(1), while string is a scalar
> character(20) (13.7.121 TRANSFER (SOURCE, MOLD [, SIZE]) ... Case (iii): If
> SIZE is present, the result is an array of rank one and size SIZE.).
> 
> The patched gfortran, Intel, and g95 accept the code and give the same result;
> xlf accept the code, but gives some garbage in the first and fourth lines of
> the output; Portland Group compiler rejects the code with:
> 
> PGF90-S-0074-Illegal number or type of arguments to merge - keyword argument
> fsource (pr31608_4.f90: 16)
> 
> Should I fill another PR?
> 

Yes, please

It's an easy fix but let's do one thing at a time:-)

Paul
Comment 33 Dominique d'Humieres 2007-10-12 20:31:38 UTC
> It's an easy fix but let's do one thing at a time:-)

Sure! I have filled PR33759

Comment 34 patchapp@dberlin.org 2007-10-20 04:22:11 UTC
Subject: Bug number PR31608

A patch for this bug has been added to the patch tracker.
The mailing list url for the patch is http://gcc.gnu.org/ml/gcc-patches/2007-10/msg01072.html
Comment 35 Paul Thomas 2007-10-20 09:27:20 UTC
Subject: Bug 31608

Author: pault
Date: Sat Oct 20 09:27:09 2007
New Revision: 129505

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=129505
Log:
2007-10-20  Paul Thomas  <pault@gcc.gnu.org>
	    FX Coudert <fxcoudert@gcc.gnu.org>

	PR fortran/31608
	* trans-array.c (gfc_conv_expr_descriptor): For all except
	indirect references, use gfc_trans_scalar_assign instead of
	gfc_add_modify_expr.
	* iresolve.c (check_charlen_present): Separate creation of cl
	if necessary and add code to treat an EXPR_ARRAY.
	(gfc_resolve_char_achar): New function.
	(gfc_resolve_achar, gfc_resolve_char): Call it.
	(gfc_resolve_transfer): If the MOLD expression does not have a
	character length expression, get it from a constant length.

2007-10-20  Paul Thomas  <pault@gcc.gnu.org>
	    FX Coudert <fxcoudert@gcc.gnu.org>

	PR fortran/31608
	* gfortran.dg/char_cast_1.f90: New test.


Added:
    trunk/gcc/testsuite/gfortran.dg/char_cast_1.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/iresolve.c
    trunk/gcc/fortran/trans-array.c
    trunk/gcc/testsuite/ChangeLog

Comment 36 Paul Thomas 2007-10-20 09:35:52 UTC
Sorry I took a bit of time to do it - fixed on trunk.

Cheers

Paul
Comment 37 John David Anglin 2007-10-25 02:31:10 UTC
Test is failing on hppa-unknown-linux-gnu:

Executing on host: /home/dave/gnu/gcc-4.3/objdir/gcc/testsuite/gfortran/../../gf
ortran -B/home/dave/gnu/gcc-4.3/objdir/gcc/testsuite/gfortran/../../ /home/dave/
gnu/gcc-4.3/gcc/gcc/testsuite/gfortran.dg/char_cast_1.f90   -O  -O2 -fdump-tree-
original -S  -o char_cast_1.s    (timeout = 300)
PASS: gfortran.dg/char_cast_1.f90  -O  (test for excess errors)
FAIL: gfortran.dg/char_cast_1.f90  -O  scan-tree-dump-times \[S.5\]\[1\] 2
Executing on host: /home/dave/gnu/gcc-4.3/objdir/gcc/testsuite/gfortran/../../gf
Comment 38 dave 2007-10-25 02:39:42 UTC
Subject: Re:  wrong types in character array/scalar binop

Tree dump attached.

Dave
Comment 39 dave 2007-10-25 02:39:42 UTC
Created attachment 14410 [details]
char_cast_1.f90.003t.original
Comment 40 Tobias Burnus 2007-10-25 06:36:21 UTC
(In reply to comment #37)
> Test is failing on hppa-unknown-linux-gnu:
> PASS: gfortran.dg/char_cast_1.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/char_cast_1.f90  -O  scan-tree-dump-times \[S.5\]\[1\] 2

While on x86_64-gnu-linux the dump has:
  int8 S.5;
the variable on hppa-unknown-linux-gnu is:
  int4 S___5;

Thus the following check fails:

! The sign that all is well is that [S.5][1] appears twice.
! { dg-final { scan-tree-dump-times "\\\[S\.5\\\]\\\[1\\\]" 2 "original" } }

The tree (dump) itself seems to be ok.
Comment 41 dave 2007-10-25 15:41:49 UTC
Subject: Re:  wrong types in character array/scalar binop

> While on x86_64-gnu-linux the dump has:
>   int8 S.5;
> the variable on hppa-unknown-linux-gnu is:
>   int4 S___5;

I wonder why the variables names differ.  I'm not aware of any
backend feature that controls this.

Obviously, the check could be adjusted to handle both.

Dave
Comment 42 Tobias Schlüter 2007-10-25 15:48:21 UTC
Subject: Re:  wrong types in character array/scalar binop

dave at hiauly1 dot hia dot nrc dot ca wrote:
> ------- Comment #41 from dave at hiauly1 dot hia dot nrc dot ca  2007-10-25 15:41 -------
> Subject: Re:  wrong types in character array/scalar binop
> 
>> While on x86_64-gnu-linux the dump has:
>>   int8 S.5;
>> the variable on hppa-unknown-linux-gnu is:
>>   int4 S___5;
> 
> I wonder why the variables names differ.  I'm not aware of any
> backend feature that controls this.

Maybe (random shot in the dark) hp's assembler doesn't allow for dots in 
symbol names, and gcc, when generating the name for the symbol takes 
this into account even though this is on Linux?

Comment 43 rguenther@suse.de 2007-10-25 16:01:46 UTC
Subject: Re:  wrong types in character array/scalar binop

On Thu, 25 Oct 2007, Tobias dot Schlueter at physik dot uni-muenchen dot de wrote:

> 
> 
> ------- Comment #42 from Tobias dot Schlueter at physik dot uni-muenchen dot de  2007-10-25 15:48 -------
> Subject: Re:  wrong types in character array/scalar binop
> 
> dave at hiauly1 dot hia dot nrc dot ca wrote:
> > ------- Comment #41 from dave at hiauly1 dot hia dot nrc dot ca  2007-10-25 15:41 -------
> > Subject: Re:  wrong types in character array/scalar binop
> > 
> >> While on x86_64-gnu-linux the dump has:
> >>   int8 S.5;
> >> the variable on hppa-unknown-linux-gnu is:
> >>   int4 S___5;
> > 
> > I wonder why the variables names differ.  I'm not aware of any
> > backend feature that controls this.
> 
> Maybe (random shot in the dark) hp's assembler doesn't allow for dots in 
> symbol names, and gcc, when generating the name for the symbol takes 
> this into account even though this is on Linux?

gimplify.c:

tree
create_tmp_var_name (const char *prefix)
{
  char *tmp_name;

  if (prefix)
    {
      char *preftmp = ASTRDUP (prefix);

      remove_suffix (preftmp, strlen (preftmp));
      prefix = preftmp;
    }
  
  ASM_FORMAT_PRIVATE_NAME (tmp_name, prefix ? prefix : "T", 
tmp_var_id_num++);
  return get_identifier (tmp_name);
}

yes indeed.
Comment 44 dave 2007-10-25 18:03:22 UTC
Subject: Re:  wrong types in character array/scalar binop

>   ASM_FORMAT_PRIVATE_NAME (tmp_name, prefix ? prefix : "T", 

I'm still don't understand how we get underscores.  We have in defaults.h:

#ifndef ASM_FORMAT_PRIVATE_NAME
# define ASM_FORMAT_PRIVATE_NAME(OUTPUT, NAME, LABELNO) \
  do { const char *const name_ = (NAME); \
       char *const output_ = (OUTPUT) = \
         (char *) alloca (strlen (name_) + 32); \
       sprintf (output_, ASM_PN_FORMAT, name_, (unsigned long)(LABELNO)); \
} while (0)
#endif

#ifndef ASM_PN_FORMAT
# ifndef NO_DOT_IN_LABEL
#  define ASM_PN_FORMAT "%s.%lu"
# else
#  ifndef NO_DOLLAR_IN_LABEL
#   define ASM_PN_FORMAT "%s$%lu"
#  else
#   define ASM_PN_FORMAT "__%s_%lu"
#  endif
# endif
#endif /* ! ASM_PN_FORMAT */

To the best of my knowledge, we don't define either  ASM_FORMAT_PRIVATE_NAME
or NO_DOT_IN_LABEL.  I believe NO_DOLLAR_IN_LABEL is defined on those PA
targets that include elfos.h.

In any case, the test should support the three formats in ASM_PN_FORMAT.

Dave
Comment 45 Tobias Burnus 2007-10-25 18:17:23 UTC
(In reply to comment #44)
> #  define ASM_PN_FORMAT "%s.%lu"
> #   define ASM_PN_FORMAT "%s$%lu"
> #   define ASM_PN_FORMAT "__%s_%lu"
> 
> In any case, the test should support the three formats in ASM_PN_FORMAT.

Well, I think there are four:
S.5, S$5, and __S_5 as defined above and S___5 as found in the dump?!?
Comment 46 Tobias Schlüter 2007-10-25 19:50:53 UTC
Subject: Re:  wrong types in character array/scalar binop

dave at hiauly1 dot hia dot nrc dot ca wrote:
> Subject: Re:  wrong types in character array/scalar binop
> 
>>   ASM_FORMAT_PRIVATE_NAME (tmp_name, prefix ? prefix : "T", 
> 
> I'm still don't understand how we get underscores.  We have in defaults.h:
> 
> #ifndef ASM_FORMAT_PRIVATE_NAME
> # define ASM_FORMAT_PRIVATE_NAME(OUTPUT, NAME, LABELNO) \
>   do { const char *const name_ = (NAME); \
>        char *const output_ = (OUTPUT) = \
>          (char *) alloca (strlen (name_) + 32); \
>        sprintf (output_, ASM_PN_FORMAT, name_, (unsigned long)(LABELNO)); \
> } while (0)
> #endif
> 
> #ifndef ASM_PN_FORMAT
> # ifndef NO_DOT_IN_LABEL
> #  define ASM_PN_FORMAT "%s.%lu"
> # else
> #  ifndef NO_DOLLAR_IN_LABEL
> #   define ASM_PN_FORMAT "%s$%lu"
> #  else
> #   define ASM_PN_FORMAT "__%s_%lu"
> #  endif
> # endif
> #endif /* ! ASM_PN_FORMAT */
> 
> To the best of my knowledge, we don't define either  ASM_FORMAT_PRIVATE_NAME
> or NO_DOT_IN_LABEL.  I believe NO_DOLLAR_IN_LABEL is defined on those PA
> targets that include elfos.h.

~/src/hggcc/gcc/config tobi$ find . | xargs grep ASM_PN
./alpha/vms.h:#define ASM_PN_FORMAT "%s___%lu"
./h8300/h8300.h:#define ASM_PN_FORMAT "%s___%lu"
./ia64/ia64.h:#define ASM_PN_FORMAT (TARGET_GNU_AS ? "%s.%lu" : "%s?%lu")
./mmix/mmix.h:#define ASM_PN_FORMAT "%s::%lu"
./mn10300/mn10300.h:#define ASM_PN_FORMAT "%s___%lu"
./pa/pa.h:#define ASM_PN_FORMAT "%s___%lu"
./v850/v850.h:#define ASM_PN_FORMAT "%s___%lu"

It looks like you do :-)

I wonder why this name-mangling is necessary, it's not like these names 
are going to appear in the assembly, is it?

Cheers,
- Tobi
Comment 47 pinskia@gmail.com 2007-10-25 20:45:34 UTC
Subject: Re:  wrong types in character array/scalar binop

On 25 Oct 2007 19:50:54 -0000, Tobias dot Schlueter at physik dot
uni-muenchen dot de <gcc-bugzilla@gcc.gnu.org> wrote:
> I wonder why this name-mangling is necessary, it's not like these names
> are going to appear in the assembly, is it?

Those will not but other will like:

void f(void)
{
  void g(void) {
  }
  g();
}
Comment 48 dave 2007-10-25 20:57:50 UTC
Subject: Re:  wrong types in character array/scalar binop

> ./pa/pa.h:#define ASM_PN_FORMAT "%s___%lu"
> ./v850/v850.h:#define ASM_PN_FORMAT "%s___%lu"
> 
> It looks like you do :-)

Yes, I found this after my last mail.  I need to review this.  The define
is definitely not needed on linux.

Dave
Comment 49 dave 2007-10-25 23:17:06 UTC
Subject: Re:  wrong types in character array/scalar binop

> Yes, I found this after my last mail.  I need to review this.  The define
> is definitely not needed on linux.

The HP assembler allows dots in symbols as long as the dot isn't
the first character.  Thus, the define appears unnecessary on the PA.
I think deleting the define won't affect the ABI since it is only
supposed to be used for internal static variables.  I'm going to
do some testing.

Dave
Comment 50 Richard Biener 2007-10-26 22:17:15 UTC
Note that I still see achar_4.f90 fail with type-checking and there are now some
more testcases that also fail.
Comment 51 John David Anglin 2007-10-27 00:21:15 UTC
Subject: Bug 31608

Author: danglin
Date: Sat Oct 27 00:21:02 2007
New Revision: 129671

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=129671
Log:
	PR fortran/31608
	* pa.h (ASM_PN_FORMAT): Delete define.


Modified:
    trunk/gcc/ChangeLog
    trunk/gcc/config/pa/pa.h

Comment 52 dave 2007-10-27 00:29:50 UTC
Subject: Re:  wrong types in character array/scalar binop

Fixed on PA.

Dave
Comment 53 Tobias Burnus 2007-10-27 19:57:50 UTC
> Note that I still see achar_4.f90 fail with type-checking and there are now
> some more testcases that also fail.

Reopened based on this comment to make sure we won't forget about this PR.

To recap:

a) We need to fix the test "gfortran.dg/char_cast_1.f90" to allow for
   "S$5", "__S_5", "S___5" besides "S.5".

b) We need to fix get the types right. Richard, can you pin-point where the types are still wrong?
How did you check for the miss-matched types?
Comment 54 rguenther@suse.de 2007-10-27 20:03:03 UTC
Subject: Re:  wrong types in character array/scalar binop

On Sat, 27 Oct 2007, burnus at gcc dot gnu dot org wrote:

> ------- Comment #53 from burnus at gcc dot gnu dot org  2007-10-27 19:57 -------
> > Note that I still see achar_4.f90 fail with type-checking and there are now
> > some more testcases that also fail.
> 
> Reopened based on this comment to make sure we won't forget about this PR.
> 
> To recap:
> 
> a) We need to fix the test "gfortran.dg/char_cast_1.f90" to allow for
>    "S$5", "__S_5", "S___5" besides "S.5".
> 
> b) We need to fix get the types right. Richard, can you pin-point where the
> types are still wrong?
> How did you check for the miss-matched types?

If you run the testsuite for a stage1 compiler (or if you enable
type-checking with --enable-checking=yes,types) you'll get gfortran
failures (ICE due to wrong types).

For example

/space/rguenther/src/svn/pointer_plus/gcc/testsuite/gfortran.dg/achar_4.f90:8: 
internal compiler error: verify_gimple failed^M
Please submit a full bug report,^M
with preprocessed source if appropriate.^M
See <http://gcc.gnu.org/bugs.html> for instructions.^M
compiler exited with status 1
output is:
/space/rguenther/src/svn/pointer_plus/gcc/testsuite/gfortran.dg/achar_4.f90: 
In function 'up':^M
/space/rguenther/src/svn/pointer_plus/gcc/testsuite/gfortran.dg/achar_4.f90:8: 
error: non-trivial conversion at assignment^M
char[1:1]^M
char^M
(*D.1000)[S.24] = D.1018^M

Richard.
Comment 55 Paul Thomas 2007-11-12 14:04:56 UTC
(In reply to comment #40)

> ! { dg-final { scan-tree-dump-times "\\\[S\.5\\\]\\\[1\\\]" 2 "original" } }
> The tree (dump) itself seems to be ok.

I hadn't noticed that this one had come back over the horizon.  I do not feel up to this continuing part of the problem and so have unassigned myself.

However, I would like to point out that the immediate problem could be fixed by counting the occurrences of "5\\\]\\\[1\\\]" in the testcase.

Cheers

Paul
Comment 56 Jerry DeLisle 2007-11-13 03:46:26 UTC
On x86-64-linux-gnu the only failure I could find using --enable-checking=yes,types was achar_4.f90.

achar_4.f90: In function ‘up’:
achar_4.f90:8: error: non-trivial conversion at assignment
char[1:1]
char
(*D.1000)[S.24] = D.1018
achar_4.f90:8: internal compiler error: verify_gimple failed
Comment 57 Jerry DeLisle 2007-11-13 06:34:05 UTC
Regarding the suggestion in comment #55, there is an instance of [S.15][1] in the dump.  It will match if we bump the count from 2 to 3 in the dg-final scan directive.

So either this:

! { dg-final { scan-tree-dump-times "5\\\]\\\[1\\\]" 3 "original" } }

or

! { dg-final { scan-tree-dump-times "\\\[S\\\.5\\\]\|\\\[S\\\$5\\\]\|\\\[S___5\\\]\|\\\[__S_5\\\]" 2 "original" } }

The latter being more precise.

Can those interested test this on char_cast_1.f90 please.
Comment 58 Dominique d'Humieres 2007-11-13 07:56:17 UTC
> Can those interested test this on char_cast_1.f90 please.

Both wok on PPC and Intel Darwin8. Note that if the first change is chosen, the comment:

! The sign that all is well is that [S.5][1] appears twice.

should be changed to explain the 3.
Comment 59 Jerry DeLisle 2007-11-14 01:35:29 UTC
Subject: Bug 31608

Author: jvdelisle
Date: Wed Nov 14 01:35:09 2007
New Revision: 130173

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=130173
Log:
2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/31608
	*gfortran.dg/char_cast_1.f90: Modify regex in scan-tree-dump-times
	to match known variations in symbol format. Document in comments.

Modified:
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/char_cast_1.f90

Comment 60 Paul Thomas 2007-11-14 10:37:12 UTC
(In reply to comment #59)

> 2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

Jerry,

I see that you have spent much more time diddling with your regex than I have!

Thanks

Paul
Comment 61 Paul Thomas 2007-11-16 09:23:49 UTC
Richard,

I believe that this is the right outcome for achar_4?

            (*(char[0:][1:1] *) atmp.4.data)[S.5][1]{lb: 1 sz: 1} = *(_gfortran_
compare_string (D.529, &(*(char[0:][1:1] *) atmp.2.data)[S.5][1]{lb: 1 sz: 1}, 1
, &"a"[1]{lb: 1 sz: 1}) >= 0 && _gfortran_compare_string (D.541, &(*(char[0:][1:
1] *) atmp.3.data)[S.5][1]{lb: 1 sz: 1}, 1, &"z"[1]{lb: 1 sz: 1}) <= 0 ? &char.6
 : &(*(char[0:][1:1] *) atmp.1.data)[S.5][1]{lb: 1 sz: 1});

Obtained with the following, not yet regtested, patch:

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c   (révision 130174)
--- gcc/fortran/trans-array.c   (copie de travail)
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4734,4748 ****
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);

!       if (TREE_CODE (rse.expr) != INDIRECT_REF)
!       {
!         lse.string_length = rse.string_length;
!         tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
!                                 expr->expr_type == EXPR_VARIABLE);
!         gfc_add_expr_to_block (&block, tmp);
!       }
!       else
!       gfc_add_modify_expr (&block, lse.expr, rse.expr);

        /* Finish the copying loops.  */
        gfc_trans_scalarizing_loops (&loop, &block);
--- 4734,4743 ----
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);

!       lse.string_length = rse.string_length;
!       tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
!                                    expr->expr_type == EXPR_VARIABLE);
!       gfc_add_expr_to_block (&block, tmp);

        /* Finish the copying loops.  */
        gfc_trans_scalarizing_loops (&loop, &block);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c    (révision 130174)
--- gcc/fortran/trans-expr.c    (copie de travail)
*************** gfc_conv_string_parameter (gfc_se * se)
*** 3597,3604 ****
    type = TREE_TYPE (se->expr);
    if (TYPE_STRING_FLAG (type))
      {
!       gcc_assert (TREE_CODE (se->expr) != INDIRECT_REF);
!       se->expr = gfc_build_addr_expr (pchar_type_node, se->expr);
      }

    gcc_assert (POINTER_TYPE_P (TREE_TYPE (se->expr)));
--- 3597,3611 ----
    type = TREE_TYPE (se->expr);
    if (TYPE_STRING_FLAG (type))
      {
!       if (TREE_CODE (se->expr) != INDIRECT_REF)
!         se->expr = gfc_build_addr_expr (pchar_type_node, se->expr);
!       else
!       {
!         type = gfc_get_character_type_len (gfc_default_character_kind,
!                                            se->string_length);
!         type = build_pointer_type (type);
!         se->expr = gfc_build_addr_expr (type, se->expr);
!       }
      }

    gcc_assert (POINTER_TYPE_P (TREE_TYPE (se->expr)));

I am just putting it on to regtest now.  I am rather convinced that it will cause some regressions but that it is the right way to go. We'll see!

Cheers

Paul
Comment 62 rguenther@suse.de 2007-11-16 09:50:35 UTC
Subject: Re:  wrong types in character array/scalar binop

On Fri, 16 Nov 2007, pault at gcc dot gnu dot org wrote:

> ------- Comment #61 from pault at gcc dot gnu dot org  2007-11-16 09:23 -------
> Richard,
> 
> I believe that this is the right outcome for achar_4?
> 
>             (*(char[0:][1:1] *) atmp.4.data)[S.5][1]{lb: 1 sz: 1} =
> *(_gfortran_compare_string (D.529, &(*(char[0:][1:1] *) atmp.2.data)[S.5][1]{lb: 1 sz: 1},
> 1
> , &"a"[1]{lb: 1 sz: 1}) >= 0 && _gfortran_compare_string (D.541,
> &(*(char[0:][1:
> 1] *) atmp.3.data)[S.5][1]{lb: 1 sz: 1}, 1, &"z"[1]{lb: 1 sz: 1}) <= 0 ?
> &char.6
>  : &(*(char[0:][1:1] *) atmp.1.data)[S.5][1]{lb: 1 sz: 1});

Twisted, but yes, this looks ok if char.6 is plain 'char'.

Richard.
Comment 63 Paul Thomas 2007-11-16 17:01:51 UTC
I suppose that, after all, I should reassign myself.

Paul
Comment 64 Paul Thomas 2007-11-18 17:14:51 UTC
Subject: Bug 31608

Author: pault
Date: Sun Nov 18 17:14:40 2007
New Revision: 130271

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=130271
Log:
2007-11-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31608
	* trans-array.c (gfc_conv_expr_descriptor): Remove exception
	for indirect references in the call to gfc_trans_scalar_assign.
	* trans-expr.c (gfc_conv_string_parameter): Instead of asserting
	that the expression is not an indirect reference, cast it to a
	pointer type of the length given by se->string_length.

2007-11-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31608
	* gfortran.dg/char_cast_2.f90: New test based on achar_4.f90.

Added:
    trunk/gcc/testsuite/gfortran.dg/char_cast_2.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/trans-array.c
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog

Comment 65 Paul Thomas 2007-11-18 17:16:37 UTC
Well, I think that it's fixed on trunk now.....

Go on, make my day and find another!

Cheers

Paul
Comment 66 patchapp@dberlin.org 2007-11-20 05:02:29 UTC
Subject: Bug number PR31608

A patch for this bug has been added to the patch tracker.
The mailing list url for the patch is http://gcc.gnu.org/ml/gcc-patches/2007-11/msg00898.html
Comment 67 patchapp@dberlin.org 2007-11-20 05:07:13 UTC
Subject: Bug number PR31608

A patch for this bug has been added to the patch tracker.
The mailing list url for the patch is http://gcc.gnu.org/ml/gcc-patches/2007-11/msg00898.html