Bug 31608

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 :-)

(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

(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).

(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

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 :)

> 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.

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.

(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

The patch in http://gcc.gnu.org/ml/gcc-patches/2007-04/msg01075.html makes the
testcase ICE because of the type mismatch.

(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

It's not blocking me atm as a different patch got accepted which doesn't expose
this problem.

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

I think this was fixed with http://gcc.gnu.org/ml/gcc-patches/2007-06/msg01471.html

aka PR32140.

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.

FYI, testcase is standard conforming code AFAICT.

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.

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.

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.

(In reply to comment #16)
> Trying to reduce the testcase, the following ICEs:

PR 31610 ?

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

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. 

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

(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

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.

(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

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.

(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)

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;

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.

(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

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?

(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

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

Sure! I have filled PR33759

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

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

Sorry I took a bit of time to do it - fixed on trunk.

Cheers

Paul

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

Subject: Re:  wrong types in character array/scalar binop

Tree dump attached.

Dave

Created attachment 14410 [details]
char_cast_1.f90.003t.original

(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.

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

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?

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.

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

(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?!?

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

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();
}

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

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

Note that I still see achar_4.f90 fail with type-checking and there are now some
more testcases that also fail.

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

Subject: Re:  wrong types in character array/scalar binop

Fixed on PA.

Dave

> 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?

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.

(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

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

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.

> 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.

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

(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

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

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.

I suppose that, after all, I should reassign myself.

Paul

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

Well, I think that it's fixed on trunk now.....

Go on, make my day and find another!

Cheers

Paul

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

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