public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/29067]  New: Internal Error: gfc_resolve_expr(): Bad expression type
@ 2006-09-13 20:10 mathieu dot courtois at free dot fr
  2006-09-13 20:17 ` [Bug fortran/29067] " kargl at gcc dot gnu dot org
                   ` (21 more replies)
  0 siblings, 22 replies; 23+ messages in thread
From: mathieu dot courtois at free dot fr @ 2006-09-13 20:10 UTC (permalink / raw)
  To: gcc-bugs

gfortran fails on the attached subroutine.

> gfortran -v -save-temps -c ircmva.f
Using built-in specs.
Target: i486-linux-gnu
Configured with: ../src/configure -v
--enable-languages=c,c++,fortran,objc,obj-c++,treelang --prefix=/usr
--enable-shared --with-system-zlib --libexecdir=/usr/lib
--without-included-gettext --enable-threads=posix --enable-nls
--program-suffix=-4.1 --enable-__cxa_atexit --enable-clocale=gnu
--enable-libstdcxx-debug --enable-mpfr --with-tune=i686
--enable-checking=release i486-linux-gnu
Thread model: posix
gcc version 4.1.2 20060901 (prerelease) (Debian 4.1.1-13)
 /usr/lib/gcc/i486-linux-gnu/4.1.2/f951 ircmva.f -ffixed-form -quiet -dumpbase
ircmva.f -mtune=i686 -auxbase ircmva -version -o ircmva.s
GNU F95 version 4.1.2 20060901 (prerelease) (Debian 4.1.1-13) (i486-linux-gnu)
        compiled by GNU C version 4.1.2 20060901 (prerelease) (Debian
4.1.1-13).
GGC heuristics: --param ggc-min-expand=99 --param ggc-min-heapsize=129579
 In file ircmva.f:91

      END
                                                                       1
 Internal Error at (1):
 gfc_resolve_expr(): Bad expression type



Source code :

      SUBROUTINE IRCMVA ( NUMCMP, NCMPVE, NCMPRF,
     >                    NVALEC, NBPG, NBSP, NOLOPG,
     >                    ADSV, ADSD, ADSL,
     >                    TYMAST, MODNUM, NUANOM,
     >                    VAL, PROFAS, IDEB, IFIN )
      IMPLICIT NONE
      INTEGER NTYMAX
      PARAMETER (NTYMAX = 48)
      INTEGER NCMPVE, NCMPRF, NVALEC, NBPG, NBSP
      INTEGER NUMCMP(NCMPRF)
      INTEGER ADSV, ADSD, ADSL
      INTEGER TYMAST
      INTEGER MODNUM(NTYMAX), NUANOM(NTYMAX,*)
      INTEGER PROFAS(*)
      INTEGER IDEB, IFIN
      REAL*8 VAL(NCMPVE,NBSP,NBPG,NVALEC)
      CHARACTER*32 NOLOPG
      REAL*8       ZR
      LOGICAL      ZL
      COMMON /RVARJE/ZR(1)
      COMMON /LVARJE/ZL(1)
      CHARACTER*6 NOMPRO
      PARAMETER ( NOMPRO = 'IRCMVA' )
      CHARACTER*32 EDELGA
      PARAMETER ( EDELGA='________ELNO____________________' )
      INTEGER IAUX, JAUX, KAUX
      INTEGER ADSVXX
      INTEGER INO, IMA, NRCMP, NRCMPR, NRPG, NRSP
      INTEGER IFM, NIVINF
      LOGICAL LOGAUX
      CALL INFNIV ( IFM, NIVINF )
      IF ( NIVINF.GT.1 ) THEN
        CALL UTMESS ( 'I', NOMPRO,
     > 'CREATION DES TABLEAUX DE VALEURS A ECRIRE AVEC :')
        WRITE (IFM,13001) NVALEC, NCMPVE, NBPG, NBSP
      ENDIF
13001 FORMAT('  NVALEC =',I8,', NCMPVE =',I8,
     >       ', NBPG   =',I8,', NBSP   =',I8,/)
      IF ( TYMAST.EQ.0 ) THEN
        DO 21 , NRCMP = 1 , NCMPVE
          ADSVXX = ADSV-1+NUMCMP(NRCMP)-NCMPRF
          JAUX = 0
          DO 211 , IAUX = IDEB, IFIN
            INO = PROFAS(IAUX)
            JAUX = JAUX + 1
            KAUX = INO*NCMPRF
            VAL(NRCMP,1,1,JAUX) = ZR(ADSVXX+KAUX)
  211     CONTINUE
   21   CONTINUE
      ELSE
        LOGAUX = .FALSE.
        IF ( NOLOPG(9:16).EQ.EDELGA(9:16) ) THEN
          IF ( MODNUM(TYMAST).EQ.1 ) THEN
            LOGAUX = .TRUE.
          ENDIF
        ENDIF
        IF ( LOGAUX ) THEN
          IF ( NBSP.GT.1 ) THEN
            WRITE (IFM,13001) NVALEC, NCMPVE, NBPG, NBSP
            CALL UTMESS ( 'F', NOMPRO,
     >     'RENUMEROTATION IMPOSSIBLE AVEC PLUS D''UN SOUS-POINT')
          ENDIF
        ENDIF
        DO 22 , NRCMP = 1 , NCMPVE
          NRCMPR = NUMCMP(NRCMP)
          JAUX = 0
          IF ( LOGAUX ) THEN
            NRSP = 1
            DO 221 , IAUX = IDEB, IFIN
              IMA = PROFAS(IAUX)
              JAUX = JAUX + 1
              DO 2211 , NRPG = 1 , NBPG
                CALL CESEXI ('C',ADSD,ADSL,IMA,NRPG,NRSP,NRCMPR,KAUX)
                VAL(NRCMP,NRSP,NUANOM(TYMAST,NRPG),JAUX)=ZR(ADSV-1+KAUX)
 2211         CONTINUE
  221       CONTINUE
          ELSE
            DO 222 , IAUX = IDEB, IFIN
              IMA = PROFAS(IAUX)
              JAUX = JAUX + 1
              DO 2221 , NRPG = 1 , NBPG
                DO 2222 , NRSP = 1 , NBSP
                  CALL CESEXI ('C',ADSD,ADSL,IMA,NRPG,NRSP,NRCMPR,KAUX)
                  VAL(NRCMP,NRSP,NRPG,JAUX) = ZR(ADSV-1+KAUX)
 2222           CONTINUE
 2221         CONTINUE
  222       CONTINUE
          ENDIF
   22   CONTINUE
      ENDIF
      END


-- 
           Summary: Internal Error: gfc_resolve_expr(): Bad expression type
           Product: gcc
           Version: 4.1.2
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: mathieu dot courtois at free dot fr
  GCC host triplet: debian testing
GCC target triplet: i486-linux-gnu


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
@ 2006-09-13 20:17 ` kargl at gcc dot gnu dot org
  2006-09-13 20:18 ` mathieu dot courtois at free dot fr
                   ` (20 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: kargl at gcc dot gnu dot org @ 2006-09-13 20:17 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #1 from kargl at gcc dot gnu dot org  2006-09-13 20:17 -------
This compiles with gfortran 4.2, so you may want to update to a
newer compiler.

Does this file contain any TAB characters?


-- 

kargl at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |kargl at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
  2006-09-13 20:17 ` [Bug fortran/29067] " kargl at gcc dot gnu dot org
@ 2006-09-13 20:18 ` mathieu dot courtois at free dot fr
  2006-09-13 21:42 ` kargl at gcc dot gnu dot org
                   ` (19 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: mathieu dot courtois at free dot fr @ 2006-09-13 20:18 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #2 from mathieu dot courtois at free dot fr  2006-09-13 20:18 -------
Created an attachment (id=12252)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=12252&action=view)
source code

add source file


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
  2006-09-13 20:17 ` [Bug fortran/29067] " kargl at gcc dot gnu dot org
  2006-09-13 20:18 ` mathieu dot courtois at free dot fr
@ 2006-09-13 21:42 ` kargl at gcc dot gnu dot org
  2006-09-13 21:44 ` kargl at gcc dot gnu dot org
                   ` (18 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: kargl at gcc dot gnu dot org @ 2006-09-13 21:42 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #3 from kargl at gcc dot gnu dot org  2006-09-13 21:42 -------
This compiles with both 

troutmask:sgk[265] gfc41 --version
GNU Fortran 95 (GCC) 4.1.2 20060913 (prerelease)
Copyright (C) 2006 Free Software Foundation, Inc.

troutmask:sgk[266] gfc4x --version
GNU Fortran 95 (GCC) 4.2.0 20060911 (experimental)
Copyright (C) 2006 Free Software Foundation, Inc.

Can you upgrade and confirm that the code compiles?


-- 

kargl at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |WAITING


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (2 preceding siblings ...)
  2006-09-13 21:42 ` kargl at gcc dot gnu dot org
@ 2006-09-13 21:44 ` kargl at gcc dot gnu dot org
  2006-09-14  9:05 ` mathieu dot courtois at free dot fr
                   ` (17 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: kargl at gcc dot gnu dot org @ 2006-09-13 21:44 UTC (permalink / raw)
  To: gcc-bugs



-- 

kargl at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |kargl at gcc dot gnu dot org
                   |dot org                     |
             Status|WAITING                     |ASSIGNED
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2006-09-13 21:44:02
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (3 preceding siblings ...)
  2006-09-13 21:44 ` kargl at gcc dot gnu dot org
@ 2006-09-14  9:05 ` mathieu dot courtois at free dot fr
  2006-09-14  9:08 ` mathieu dot courtois at free dot fr
                   ` (16 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: mathieu dot courtois at free dot fr @ 2006-09-14  9:05 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #4 from mathieu dot courtois at free dot fr  2006-09-14 09:05 -------
Created an attachment (id=12266)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=12266&action=view)
work around

With some "*1" added, compilation pass !?


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (4 preceding siblings ...)
  2006-09-14  9:05 ` mathieu dot courtois at free dot fr
@ 2006-09-14  9:08 ` mathieu dot courtois at free dot fr
  2006-10-12 12:18 ` pault at gcc dot gnu dot org
                   ` (15 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: mathieu dot courtois at free dot fr @ 2006-09-14  9:08 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #5 from mathieu dot courtois at free dot fr  2006-09-14 09:08 -------
I try as soon as possible.
Thanks for your help.

This subroutine is one of an open-source project which contains about 1.000.000
lines of fortran : http://www.code-aster.org.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (5 preceding siblings ...)
  2006-09-14  9:08 ` mathieu dot courtois at free dot fr
@ 2006-10-12 12:18 ` pault at gcc dot gnu dot org
  2006-10-12 14:13 ` sgk at troutmask dot apl dot washington dot edu
                   ` (14 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: pault at gcc dot gnu dot org @ 2006-10-12 12:18 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #6 from pault at gcc dot gnu dot org  2006-10-12 12:18 -------
(In reply to comment #5)
> I try as soon as possible.
> Thanks for your help.
> This subroutine is one of an open-source project which contains about 1.000.000
> lines of fortran : http://www.code-aster.org.

Mathieu,

Can I close this one, please?

Paul Thomas 


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (6 preceding siblings ...)
  2006-10-12 12:18 ` pault at gcc dot gnu dot org
@ 2006-10-12 14:13 ` sgk at troutmask dot apl dot washington dot edu
  2006-10-13  7:39 ` fxcoudert at gcc dot gnu dot org
                   ` (13 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: sgk at troutmask dot apl dot washington dot edu @ 2006-10-12 14:13 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #7 from sgk at troutmask dot apl dot washington dot edu  2006-10-12 14:13 -------
Subject: Re:  Internal Error: gfc_resolve_expr(): Bad expression type

On Thu, Oct 12, 2006 at 12:18:30PM -0000, pault at gcc dot gnu dot org wrote:
> 
> 
> ------- Comment #6 from pault at gcc dot gnu dot org  2006-10-12 12:18 -------
> (In reply to comment #5)
> > I try as soon as possible.
> > Thanks for your help.
> > This subroutine is one of an open-source project which contains about 1.000.000
> > lines of fortran : http://www.code-aster.org.
> 
> Mathieu,
> 
> Can I close this one, please?
> 

I think the anwser to this is "yes".


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (7 preceding siblings ...)
  2006-10-12 14:13 ` sgk at troutmask dot apl dot washington dot edu
@ 2006-10-13  7:39 ` fxcoudert at gcc dot gnu dot org
  2006-10-13  7:54 ` fxcoudert at gcc dot gnu dot org
                   ` (12 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-13  7:39 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #8 from fxcoudert at gcc dot gnu dot org  2006-10-13 07:38 -------
(In reply to comment #3)
> Can you upgrade and confirm that the code compiles?

No, Steve, it doesn't work for me either on i686-linux. I downloaded the code
from comment #2 (and to answer Paul: it doesn't contain any tab), and it fails
to compile with

$ gfortran -v
Using built-in specs.
Target: i686-pc-linux-gnu
Configured with: /home/fxcoudert/gfortran_nightbuild/trunk/configure
--prefix=/home/fxcoudert/gfortran_nightbuild/irun-20061012
--enable-languages=c,fortran
--with-gmp=/home/fxcoudert/gfortran_nightbuild/software
Thread model: posix
gcc version 4.2.0 20061012 (experimental)
$ gfortran -c ircmva.f 
 In file ircmva.f:91

      END                                                               
                                                                       1
 Internal Error at (1):
 gfc_resolve_expr(): Bad expression type

while the same file compiles fine on x86_64-unknown-linux-gnu. The backtrace of
the ICE is:

Breakpoint 2, gfc_internal_error (
    format=0x85d2f48 "gfc_resolve_expr(): Bad expression type")
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/error.c:667
667     /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/error.c: No such
file or directory.
        in /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/error.c
(gdb) where
#0  gfc_internal_error (
    format=0x85d2f48 "gfc_resolve_expr(): Bad expression type")
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/error.c:667
#1  0x0808e082 in gfc_resolve_expr (e=0x9407790)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:3107
#2  0x0809162b in resolve_code (code=0x9407588, ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:4864
#3  0x08093edd in gfc_resolve_blocks (b=0x9407548, ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:4796
#4  0x080915fa in resolve_code (code=0x9407678, ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:4853
#5  0x08093edd in gfc_resolve_blocks (b=0x94062f8, ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:4796
#6  0x080915fa in resolve_code (code=0x9404c68, ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:4853
#7  0x08092e83 in gfc_resolve (ns=0x94013a8)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/resolve.c:6919
#8  0x08087d39 in gfc_parse_file ()
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/parse.c:3212
#9  0x080a928d in gfc_be_parse_file (set_yydebug=0)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/fortran/f95-lang.c:303
#10 0x083a6dc5 in toplev_main (argc=14, argv=0xbfc6ba64)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/toplev.c:1033
#11 0x080de53f in main (argc=2, argv=0x0)
    at /home/fxcoudert/gfortran_nightbuild/trunk/gcc/main.c:35

gfc_internal_error is called in resolve.c because, in gfc_resolve_expr,
argument e has value:

(gdb) p *e
$2 = {expr_type = 0, ts = {type = BT_INTEGER, kind = 4, derived = 0x0, 
    cl = 0x0}, rank = 0, shape = 0x0, symtree = 0x96ae868, ref = 0x96d77e8, 
  where = {nextc = 0x96cc62b "NUMCMP(NRCMP)", ' ' <repeats 40 times>, 
    lb = 0x96cc608}, from_H = 0, inline_noncopying_intrinsic = 0, value = {
    logical = 0, integer = {{_mp_alloc = 0, _mp_size = 0, _mp_d = 0x0}}, 
    real = {{_mpfr_prec = 0, _mpfr_sign = 0, _mpfr_exp = 0, _mpfr_d = 0x0}}, 
    complex = {r = {{_mpfr_prec = 0, _mpfr_sign = 0, _mpfr_exp = 0, 
          _mpfr_d = 0x0}}, i = {{_mpfr_prec = 0, _mpfr_sign = 0, 
          _mpfr_exp = 0, _mpfr_d = 0x0}}}, op = {
      operator = GFC_INTRINSIC_BEGIN, uop = 0x0, op1 = 0x0, op2 = 0x0}, 
    function = {actual = 0x0, name = 0x0, isym = 0x0, esym = 0x0}, 
    character = {length = 0, string = 0x0}, constructor = 0x0}}

It has expr_type = 0, which should not happen. This happens for symbol numcmp:

(gdb) p *e->symtree
$3 = {priority = 15818, left = 0x0, right = 0x0, name = 0x96d07cd "numcmp", 
  ambiguous = 0, n = {sym = 0x96d20b8, uop = 0x96d20b8, common = 0x96d20b8}}
(gdb) p *e->symtree->n.sym
$4 = {name = 0x96d07cd "numcmp", module = 0x0, declared_at = {
    nextc = 0x96b1f20 ", NCMPVE, NCMPRF,", ' ' <repeats 23 times>, 
    lb = 0x96b1ef0}, ts = {type = BT_INTEGER, kind = 4, derived = 0x0, 
    cl = 0x0}, attr = {allocatable = 0, dimension = 1, external = 0, 
    intrinsic = 0, optional = 0, pointer = 0, save = 0, target = 0, dummy = 1, 
    result = 0, assign = 0, threadprivate = 0, data = 0, use_assoc = 0, 
    in_namelist = 0, in_common = 0, in_equivalence = 0, function = 0, 
    subroutine = 0, generic = 0, implicit_type = 0, untyped = 0, sequence = 0, 
    elemental = 0, pure = 0, recursive = 0, unmaskable = 0, masked = 0, 
    contained = 0, noreturn = 0, entry = 0, entry_master = 0, 
    mixed_entry_master = 0, always_explicit = 0, referenced = 1, 
    is_main_program = 0, access = ACCESS_UNKNOWN, intent = INTENT_UNKNOWN, 
    flavor = FL_VARIABLE, if_source = IFSRC_UNKNOWN, proc = PROC_UNKNOWN, 
    cray_pointer = 0, cray_pointee = 0, alloc_comp = 0}, generic = 0x0, 
  component_access = ACCESS_UNKNOWN, formal = 0x0, formal_ns = 0x0, 
  value = 0x0, as = 0x96d2850, result = 0x0, components = 0x0, 
  cp_pointer = 0x0, common_next = 0x0, common_head = 0x0, dummy_order = 8, 
  entry_id = 0, namelist = 0x0, namelist_tail = 0x0, old_symbol = 0x0, 
  tlink = 0x0, mark = 1, new = 0, equiv_built = 0, forall_index = 0, refs = 1, 
  ns = 0x96d13a8, backend_decl = 0x0}


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |fxcoudert at gcc dot gnu dot
                   |                            |org
   GCC host triplet|debian testing              |
           Keywords|                            |ice-on-valid-code


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (8 preceding siblings ...)
  2006-10-13  7:39 ` fxcoudert at gcc dot gnu dot org
@ 2006-10-13  7:54 ` fxcoudert at gcc dot gnu dot org
  2006-10-15  1:21 ` kargl at gcc dot gnu dot org
                   ` (11 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-13  7:54 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #9 from fxcoudert at gcc dot gnu dot org  2006-10-13 07:54 -------
I managed to trim it down to:

      implicit none
      integer :: n, i
      character(len=16),parameter :: s = ""

      if (s(9:16) == "90123456") then
      endif
      if (i > 0) then
        write (i,*) n
        call foo(0)
      endif
      do i = 1, n
      end do
      end


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (9 preceding siblings ...)
  2006-10-13  7:54 ` fxcoudert at gcc dot gnu dot org
@ 2006-10-15  1:21 ` kargl at gcc dot gnu dot org
  2006-10-15  1:53 ` kargl at gcc dot gnu dot org
                   ` (10 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: kargl at gcc dot gnu dot org @ 2006-10-15  1:21 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #10 from kargl at gcc dot gnu dot org  2006-10-15 01:20 -------
(In reply to comment #9)
> I managed to trim it down to:
> 
>       implicit none
>       integer :: n, i
>       character(len=16),parameter :: s = ""
> 
>       if (s(9:16) == "90123456") then
>       endif
>       if (i > 0) then
>         write (i,*) n
>         call foo(0)
>       endif
>       do i = 1, n
>       end do
>       end
> 

This trimmed down example is invalid code.  The "if (i>0)"
statement tries to use before it is defined.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (10 preceding siblings ...)
  2006-10-15  1:21 ` kargl at gcc dot gnu dot org
@ 2006-10-15  1:53 ` kargl at gcc dot gnu dot org
  2006-10-15  8:40 ` fxcoudert at gcc dot gnu dot org
                   ` (9 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: kargl at gcc dot gnu dot org @ 2006-10-15  1:53 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #11 from kargl at gcc dot gnu dot org  2006-10-15 01:53 -------
I can't reproduce this, so drop assign status.


-- 

kargl at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|kargl at gcc dot gnu dot org|unassigned at gcc dot gnu
                   |                            |dot org
             Status|ASSIGNED                    |NEW


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (11 preceding siblings ...)
  2006-10-15  1:53 ` kargl at gcc dot gnu dot org
@ 2006-10-15  8:40 ` fxcoudert at gcc dot gnu dot org
  2006-10-16 21:28 ` mathieu dot courtois at free dot fr
                   ` (8 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-15  8:40 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #12 from fxcoudert at gcc dot gnu dot org  2006-10-15 08:40 -------
(In reply to comment #10)
> This trimmed down example is invalid code.  The "if (i>0)"
> statement tries to use before it is defined.

Sorry about that: the following code is valid, and also fails to compile with
the same error.

      implicit none
      integer :: n, i
      character(len=16),parameter :: s = ""

      i = 0 ; n = 9
      if (s(9:16) == "90123456") then
      endif
      if (i > 0) then
        write (i,*) n
        call foo(0)
      endif
      do i = 1, n
      end do
      end


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (12 preceding siblings ...)
  2006-10-15  8:40 ` fxcoudert at gcc dot gnu dot org
@ 2006-10-16 21:28 ` mathieu dot courtois at free dot fr
  2006-10-17 12:43 ` pault at gcc dot gnu dot org
                   ` (7 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: mathieu dot courtois at free dot fr @ 2006-10-16 21:28 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #14 from mathieu dot courtois at free dot fr  2006-10-16 21:28 -------
Sorry for my silence...
I have the same error with source code of comment #12 always with :
gcc version 4.1.2 20060901 (prerelease) (Debian 4.1.1-13)

I'm downloading svn snapshot...


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (13 preceding siblings ...)
  2006-10-16 21:28 ` mathieu dot courtois at free dot fr
@ 2006-10-17 12:43 ` pault at gcc dot gnu dot org
  2006-10-17 13:01 ` fxcoudert at gcc dot gnu dot org
                   ` (6 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: pault at gcc dot gnu dot org @ 2006-10-17 12:43 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #15 from pault at gcc dot gnu dot org  2006-10-17 12:43 -------
I cannot persuade this to fault on any of the platforms to which I have access
either. 'tis an odd one.

Paul


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (14 preceding siblings ...)
  2006-10-17 12:43 ` pault at gcc dot gnu dot org
@ 2006-10-17 13:01 ` fxcoudert at gcc dot gnu dot org
  2006-10-30 16:46 ` fxcoudert at gcc dot gnu dot org
                   ` (5 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-17 13:01 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #16 from fxcoudert at gcc dot gnu dot org  2006-10-17 13:01 -------
Hurray! I can now also reproduce this on x86_64-linux with ElectricFence. Run
f951 inside gdb and preload ElectricFence (in gdb: set environment LD_PRELOAD
/usr/lib64/libefence.so). The segfault backtrace is:

Program received signal SIGSEGV, Segmentation fault.
0x0000003ff2471890 in memcpy () from /lib64/tls/libc.so.6
(gdb) where
#0  0x0000003ff2471890 in memcpy () from /lib64/tls/libc.so.6
#1  0x0000000000418ab7 in gfc_copy_expr (p=0x2a98d0cf68)
    at ../../trunk/gcc/fortran/expr.c:454
#2  0x0000000000442935 in gfc_match_rvalue (result=0x7fbfffea58)
    at ../../trunk/gcc/fortran/primary.c:2005
#3  0x00000000004356f4 in match_mult_operand (result=0x7fbfffeab0)
    at ../../trunk/gcc/fortran/matchexp.c:163
#4  0x000000000043594c in match_add_operand (result=0x7fbfffeb00)
    at ../../trunk/gcc/fortran/matchexp.c:382
#5  0x0000000000435bc3 in match_level_2 (result=0x7fbfffeb48)
    at ../../trunk/gcc/fortran/matchexp.c:501
#6  0x0000000000435cfa in match_level_3 (result=0x7fbfffeba8)
    at ../../trunk/gcc/fortran/matchexp.c:572
#7  0x0000000000435e0a in match_and_operand (result=0x7fbfffebf8)
    at ../../trunk/gcc/fortran/matchexp.c:620
#8  0x000000000043602a in match_or_operand (result=0x7fbfffec38)
    at ../../trunk/gcc/fortran/matchexp.c:735
#9  0x000000000043611a in match_equiv_operand (result=0x7fbfffec80)
    at ../../trunk/gcc/fortran/matchexp.c:778
#10 0x00000000004361fb in match_level_5 (result=0x7fbfffece8)
    at ../../trunk/gcc/fortran/matchexp.c:824
#11 0x0000000000436309 in gfc_match_expr (result=0x7fbfffee88)
    at ../../trunk/gcc/fortran/matchexp.c:883
#12 0x000000000043240a in gfc_match (target=0x965976 " if ( %e")
    at ../../trunk/gcc/fortran/match.c:663
#13 0x000000000043478e in gfc_match_if (if_type=0x7fbfffeedc)
    at ../../trunk/gcc/fortran/match.c:980


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
 GCC target triplet|i486-linux-gnu              |
   Last reconfirmed|2006-09-13 21:44:02         |2006-10-17 13:01:41
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (15 preceding siblings ...)
  2006-10-17 13:01 ` fxcoudert at gcc dot gnu dot org
@ 2006-10-30 16:46 ` fxcoudert at gcc dot gnu dot org
  2006-10-31 20:15 ` fxcoudert at gcc dot gnu dot org
                   ` (4 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-30 16:46 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #17 from fxcoudert at gcc dot gnu dot org  2006-10-30 16:46 -------
The following patch fixes the problem:

Index: data.c
===================================================================
--- data.c      (revision 118134)
+++ data.c      (working copy)
@@ -155,7 +155,8 @@
       init->expr_type = EXPR_CONSTANT;
       init->ts = *ts;

-      dest = gfc_getmem (len);
+      dest = gfc_getmem (len + 1);
+      dest[len] = '\0';
       init->value.character.length = len;
       init->value.character.string = dest;
       /* Blank the string if we're only setting a substring.  */
Index: decl.c
===================================================================
--- decl.c      (revision 118134)
+++ decl.c      (working copy)
@@ -753,10 +753,11 @@
   slen = expr->value.character.length;
   if (len != slen)
     {
-      s = gfc_getmem (len);
+      s = gfc_getmem (len + 1);
       memcpy (s, expr->value.character.string, MIN (len, slen));
       if (len > slen)
        memset (&s[slen], ' ', len - slen);
+      s[len] = '\0';
       gfc_free (expr->value.character.string);
       expr->value.character.string = s;
       expr->value.character.length = len;
Index: expr.c
===================================================================
--- expr.c      (revision 118134)
+++ expr.c      (working copy)
@@ -1438,7 +1438,7 @@
          gfc_extract_int (p->ref->u.ss.end, &end);
          s = gfc_getmem (end - start + 1);
          memcpy (s, p->value.character.string + start, end - start);
-         s[end] = '\0';  /* TODO: C-style string for debugging.  */
+         s[end-start+1] = '\0';  /* TODO: C-style string for debugging.  */
          gfc_free (p->value.character.string);
          p->value.character.string = s;
          p->value.character.length = end - start;


Before submitting it, I'd like to audit the rest of the front-end code for
problems similar to those in decl.c and data.c.


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |fxcoudert at gcc dot gnu dot
                   |dot org                     |org
             Status|NEW                         |ASSIGNED
           Keywords|                            |patch
   Last reconfirmed|2006-10-17 13:01:41         |2006-10-30 16:46:22
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] Internal Error: gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (16 preceding siblings ...)
  2006-10-30 16:46 ` fxcoudert at gcc dot gnu dot org
@ 2006-10-31 20:15 ` fxcoudert at gcc dot gnu dot org
  2006-11-03 12:29 ` [Bug fortran/29067] [4.1/4.2 only] " fxcoudert at gcc dot gnu dot org
                   ` (3 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-10-31 20:15 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #18 from fxcoudert at gcc dot gnu dot org  2006-10-31 20:15 -------
Subject: Bug 29067

Author: fxcoudert
Date: Tue Oct 31 20:15:22 2006
New Revision: 118338

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=118338
Log:
        PR fortran/29067

        * decl.c (gfc_set_constant_character_len): NULL-terminate the
        character constant string.
        * data.c (create_character_intializer): Likewise.
        * expr.c (gfc_simplify_expr): NULL-terminate the substring
        character constant.
        * primary.c (match_hollerith_constant): NULL-terminate the
        character constant string.

        * gfortran.dg/pr29067.f: New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/pr29067.f
Modified:
    trunk/gcc/fortran/data.c
    trunk/gcc/fortran/decl.c
    trunk/gcc/fortran/expr.c
    trunk/gcc/fortran/primary.c
    trunk/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] [4.1/4.2 only] gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (17 preceding siblings ...)
  2006-10-31 20:15 ` fxcoudert at gcc dot gnu dot org
@ 2006-11-03 12:29 ` fxcoudert at gcc dot gnu dot org
  2006-11-03 14:26 ` fxcoudert at gcc dot gnu dot org
                   ` (2 subsequent siblings)
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-11-03 12:29 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #19 from fxcoudert at gcc dot gnu dot org  2006-11-03 12:29 -------
Subject: Bug 29067

Author: fxcoudert
Date: Fri Nov  3 12:28:57 2006
New Revision: 118456

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=118456
Log:
        PR fortran/29067

        * decl.c (gfc_set_constant_character_len): NULL-terminate the
        character constant string.
        * data.c (create_character_intializer): Likewise.
        * expr.c (gfc_simplify_expr): NULL-terminate the substring
        character constant.
        * primary.c (match_hollerith_constant): NULL-terminate the
        character constant string.

        * gfortran.dg/pr29067.f: New test.

Added:
    branches/gcc-4_2-branch/gcc/testsuite/gfortran.dg/pr29067.f
      - copied unchanged from r118338,
trunk/gcc/testsuite/gfortran.dg/pr29067.f
Modified:
    branches/gcc-4_2-branch/gcc/fortran/ChangeLog
    branches/gcc-4_2-branch/gcc/fortran/data.c
    branches/gcc-4_2-branch/gcc/fortran/decl.c
    branches/gcc-4_2-branch/gcc/fortran/expr.c
    branches/gcc-4_2-branch/gcc/fortran/primary.c
    branches/gcc-4_2-branch/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] [4.1/4.2 only] gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (18 preceding siblings ...)
  2006-11-03 12:29 ` [Bug fortran/29067] [4.1/4.2 only] " fxcoudert at gcc dot gnu dot org
@ 2006-11-03 14:26 ` fxcoudert at gcc dot gnu dot org
  2006-11-03 14:28 ` [Bug fortran/29067] " fxcoudert at gcc dot gnu dot org
  2006-11-30 19:26 ` chaoyingfu at gcc dot gnu dot org
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-11-03 14:26 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #20 from fxcoudert at gcc dot gnu dot org  2006-11-03 14:26 -------
Subject: Bug 29067

Author: fxcoudert
Date: Fri Nov  3 14:25:56 2006
New Revision: 118457

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=118457
Log:
        PR fortran/29067

        * decl.c (gfc_set_constant_character_len): NULL-terminate the
        character constant string.
        * data.c (create_character_intializer): Likewise.
        * expr.c (gfc_simplify_expr): NULL-terminate the substring
        character constant.
        * primary.c (match_hollerith_constant): NULL-terminate the
        character constant string.

        * gfortran.dg/pr29067.f: New test.

Added:
    branches/gcc-4_1-branch/gcc/testsuite/gfortran.dg/pr29067.f
      - copied unchanged from r118456,
branches/gcc-4_2-branch/gcc/testsuite/gfortran.dg/pr29067.f
Modified:
    branches/gcc-4_1-branch/gcc/fortran/ChangeLog
    branches/gcc-4_1-branch/gcc/fortran/data.c
    branches/gcc-4_1-branch/gcc/fortran/decl.c
    branches/gcc-4_1-branch/gcc/fortran/expr.c
    branches/gcc-4_1-branch/gcc/fortran/primary.c
    branches/gcc-4_1-branch/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (19 preceding siblings ...)
  2006-11-03 14:26 ` fxcoudert at gcc dot gnu dot org
@ 2006-11-03 14:28 ` fxcoudert at gcc dot gnu dot org
  2006-11-30 19:26 ` chaoyingfu at gcc dot gnu dot org
  21 siblings, 0 replies; 23+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2006-11-03 14:28 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #21 from fxcoudert at gcc dot gnu dot org  2006-11-03 14:28 -------
Fixed on all active branches.


-- 

fxcoudert at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|                            |FIXED
            Summary|[4.1/4.2 only]              |gfc_resolve_expr(): Bad
                   |gfc_resolve_expr(): Bad     |expression type
                   |expression type             |
   Target Milestone|---                         |4.1.2


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

* [Bug fortran/29067] gfc_resolve_expr(): Bad expression type
  2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
                   ` (20 preceding siblings ...)
  2006-11-03 14:28 ` [Bug fortran/29067] " fxcoudert at gcc dot gnu dot org
@ 2006-11-30 19:26 ` chaoyingfu at gcc dot gnu dot org
  21 siblings, 0 replies; 23+ messages in thread
From: chaoyingfu at gcc dot gnu dot org @ 2006-11-30 19:26 UTC (permalink / raw)
  To: gcc-bugs



------- Comment #22 from chaoyingfu at gcc dot gnu dot org  2006-11-30 19:25 -------
Subject: Bug 29067

Author: chaoyingfu
Date: Thu Nov 30 19:24:37 2006
New Revision: 119373

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=119373
Log:
Merged revisions 118337-118377 via svnmerge from 
svn+ssh://chaoyingfu@sources.redhat.com/svn/gcc/trunk

........
  r118337 | charlet | 2006-10-31 12:11:46 -0800 (Tue, 31 Oct 2006) | 2 lines

  Resync.
........
  r118338 | fxcoudert | 2006-10-31 12:15:22 -0800 (Tue, 31 Oct 2006) | 12 lines

        PR fortran/29067

        * decl.c (gfc_set_constant_character_len): NULL-terminate the
        character constant string.
        * data.c (create_character_intializer): Likewise.
        * expr.c (gfc_simplify_expr): NULL-terminate the substring
        character constant.
        * primary.c (match_hollerith_constant): NULL-terminate the
        character constant string.

        * gfortran.dg/pr29067.f: New test.
........
  r118339 | fxcoudert | 2006-10-31 12:17:11 -0800 (Tue, 31 Oct 2006) | 2 lines

        * ChangeLog: Forgotten ChangeLog entry for previous commit.
........
  r118340 | charlet | 2006-10-31 12:43:39 -0800 (Tue, 31 Oct 2006) | 2 lines

  Fix typo.
........
  r118341 | tkoenig | 2006-10-31 12:58:26 -0800 (Tue, 31 Oct 2006) | 18 lines

  2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

        PR libfortran/29627
        * libgfortran.h: Add ERROR_SHORT_RECORD
        * runtime/error.c (translate_error): Add case
        for ERROR_SHORT_RECORD.
        * io/transfer.c (read_block_direct):  Separate codepaths
        for stream and record unformatted I/O.  Remove unneeded
        tests for standard input, padding and formatted I/O.
        If the record is short, read in as much data as possible,
        then raise the error.

  2006-10-31  Thomas Koenig  <Thomas.Koenig@online.de>

        PR libfortran/29627
        * gfortran.dg/unf_short_record_1.f90:  New test.
........
  r118343 | sje | 2006-10-31 14:28:18 -0800 (Tue, 31 Oct 2006) | 4 lines

        * inclhack.def (hpux11_extern_sendfile): New.
        (hpux11_extern_sendpath): New.
        * fixincl.x: Regenerate.
........
  r118344 | ebotcazou | 2006-10-31 15:29:06 -0800 (Tue, 31 Oct 2006) | 3 lines

          * gcc.c-torture/execute/20061031-1.c: New test.
........
  r118347 | aldot | 2006-10-31 15:38:58 -0800 (Tue, 31 Oct 2006) | 20 lines

  fortran/ChangeLog:
  2006-11-01  Bernhard Fischer  <aldot@gcc.gnu.org>

          PR fortran/29537
          * trans-common.c (gfc_trans_common): If the blank common is
          in a procedure or program without a name then proc_name is null, so
use
          the locus of the common.
          (gfc_sym_mangled_common_id): Fix whitespace.
          * match.c (gfc_match_common): Emit warning about blank common in
          block data.

  testsuite/ChangeLog:
  2006-11-01  Bernhard Fischer  <aldot@gcc.gnu.org>

          PR fortran/29537
          * gfortran.dg/blockdata_1.f90: Add warning about blank common in
block
        data.
          * gfortran.dg/blockdata_2.f90: New testcase.
........
  r118353 | gccadmin | 2006-10-31 16:17:53 -0800 (Tue, 31 Oct 2006) | 1 line

  Daily bump.
........
  r118355 | sayle | 2006-10-31 18:56:45 -0800 (Tue, 31 Oct 2006) | 10 lines


        PR middle-end/23470
        * tree.h (tree_expr_nonnegative_p): Return "bool" instead of "int".
        * fold-const.c (tree_expr_nonnegative_p): Likewise.  Consider
        pow(x,y) and powi(x,y) to be nonnegative if either x is nonnegative
        or y is an even integer.

        * gcc.dg/pr23470-1.c: New test case.
........
  r118356 | geoffk | 2006-10-31 20:47:30 -0800 (Tue, 31 Oct 2006) | 27 lines

        * c-decl.c (grokdeclarator): Don't set DECL_EXTERNAL on
        inline static functions in c99 mode.

        PR 16622
        * doc/extend.texi (Inline): Update.
        * c-tree.h (struct language_function): Remove field 'extern_inline'.
        * c-decl.c (current_extern_inline): Delete.
        (pop_scope): Adjust test for an undefined nested function.
        Add warning about undeclared inline function.
        (diagnose_mismatched_decls): Update comments.  Disallow overriding
        of inline functions in a translation unit in C99.  Allow inline
        declarations in C99 at any time.
        (merge_decls): Boolize variables.  Handle C99 'extern inline'
        semantics.
        (grokdeclarator): Set DECL_EXTERNAL here for functions.  Handle
        C99 inline semantics.
        (start_function): Don't clear current_extern_inline.  Don't set
        DECL_EXTERNAL.
        (c_push_function_context): Don't push current_extern_inline.
        (c_pop_function_context): Don't restore current_extern_inline.

        PR 11377
        * c-typeck.c (build_external_ref): Warn about static variables
        used in extern inline functions.
        * c-decl.c (start_decl): Warn about static variables declared
        in extern inline functions.
........
  r118357 | geoffk | 2006-10-31 20:48:15 -0800 (Tue, 31 Oct 2006) | 27 lines

        * c-decl.c (grokdeclarator): Don't set DECL_EXTERNAL on
        inline static functions in c99 mode.

        PR 16622
        * doc/extend.texi (Inline): Update.
        * c-tree.h (struct language_function): Remove field 'extern_inline'.
        * c-decl.c (current_extern_inline): Delete.
        (pop_scope): Adjust test for an undefined nested function.
        Add warning about undeclared inline function.
        (diagnose_mismatched_decls): Update comments.  Disallow overriding
        of inline functions in a translation unit in C99.  Allow inline
        declarations in C99 at any time.
        (merge_decls): Boolize variables.  Handle C99 'extern inline'
        semantics.
        (grokdeclarator): Set DECL_EXTERNAL here for functions.  Handle
        C99 inline semantics.
        (start_function): Don't clear current_extern_inline.  Don't set
        DECL_EXTERNAL.
        (c_push_function_context): Don't push current_extern_inline.
        (c_pop_function_context): Don't restore current_extern_inline.

        PR 11377
        * c-typeck.c (build_external_ref): Warn about static variables
        used in extern inline functions.
        * c-decl.c (start_decl): Warn about static variables declared
        in extern inline functions.
........
  r118358 | geoffk | 2006-10-31 20:53:33 -0800 (Tue, 31 Oct 2006) | 3 lines

        PR 15834
        * config/darwin.h (NO_IMPLICIT_EXTERN_C): Define.
........
  r118359 | geoffk | 2006-10-31 20:55:19 -0800 (Tue, 31 Oct 2006) | 7 lines

        * config/i386/darwin.h (PREFERRED_DEBUGGING_TYPE): Remove.
        * config/darwin.h (PREFERRED_DEBUGGING_TYPE): Set to DWARF2_DEBUG.

        * config/darwin.h (LINK_COMMAND_SPEC): Don't do weird things with -@.
        Call dsymutil when compiling and linking one or more source files
        in one step.
........
  r118360 | geoffk | 2006-10-31 21:06:12 -0800 (Tue, 31 Oct 2006) | 23 lines

  In gcc/:
        * coverage.c (coverage_checksum_string): Update comment.
        * dwarf2out.c (switch_to_eh_frame_section): Update for removal
        of get_file_function_name.
        * cgraphunit.c (cgraph_build_static_cdtor): Update for rename
        of get_file_function_name_long.
        * tree.c (get_file_function_name): Rename from
        get_file_function_name_long; improve comment; handle 'I' and 'D'
        specially when the target has ctor/dtor support; remove special
        handling for 'F'.
        (get_file_function_name): Remove.
        * tree.h (get_file_function_name): Rename from
          get_file_function_name_long.
        (get_file_function_name): Remove prototype.
  In gcc/cp/:
        * name-lookup.c (get_anonymous_namespace_name): New.
        (push_namespace_with_attribs): Use get_anonymous_namespace_name.
        * decl2.c (start_objects): Update for rename of
        get_file_function_name_long.
  In gcc/fortran/:
        * trans-decl.c (gfc_generate_constructors): Update for removal
        of get_file_function_name.
........
  r118361 | geoffk | 2006-10-31 21:14:40 -0800 (Tue, 31 Oct 2006) | 49 lines

  2006-09-07  Eric Christopher  <echristo@apple.com>
            Falk Hueffner  <falk@debian.org>

        * doc/extend.texi (__builtin_bswap32): Document.
        (__builtin_bswap64): Ditto.
        * doc/libgcc.texi (bswapsi2): Document.
        (bswapdi2): Ditto.
        * doc/rtl.texi (bswap): Document.
        * optabs.c (expand_unop): Don't widen a bswap.
        (init_optabs): Init bswap. Set libfuncs explicitly
        for bswapsi2 and bswapdi2.
        * optabs.h (OTI_bswap): New.
        (bswap_optab): Ditto.
        * genopinit.c (optabs): Handle bswap_optab.
        * tree.h (tree_index): Add TI_UINT32_TYPE and
        TI_UINT64_TYPE.
        (uint32_type_node): New.
        (uint64_type_node): Ditto.
        * tree.c (build_common_tree_nodes_2): Initialize
        uint32_type_node and uint64_type_node.
        * builtins.c (expand_builtin_bswap): New.
        (expand_builtin): Call.
        (fold_builtin_bswap): New.
        (fold_builtin_1): Call.
        * fold-const.c (tree_expr_nonnegative_p): Return true
        for bswap.
        * builtin-types.def (BT_UINT32): New.
        (BT_UINT64): Ditto.
        (BT_FN_UINT32_UINT32): Ditto.
        (BT_FN_UINT64_UINT64): Ditto.
        * builtins.def (BUILT_IN_BSWAP32): New.
        (BUILT_IN_BSWAP64): Ditto.
        * rtl.def (BSWAP): New.
        * genattrtab.c (check_attr_value): New.
        * libgcc2.c (__bswapSI2): New.
        (__bswapDI2): Ditto.
        * libgcc2.h (__bswapSI2): Declare.
        (__bswapDI2): Ditto.
        * mklibgcc.in (lib2funcs): Add _bswapsi2 and _bswapdi2.
        * simplify-rtx.c (simplify_const_unary_operation): Return
        0 for BSWAP.
        * libgcc-std.ver (__bwapsi2): Add.
        (__bswapdi2): Ditto.
        * reload1.c (eliminate_regs_1): Add bswap.
        (elimination_effects): Ditto.
        * config/i386/i386.h (x86_bswap): New.
        (TARGET_BSWAP): Use.
        * config/i386/i386.c (x86_bswap): Set.
........
  r118362 | geoffk | 2006-10-31 21:16:14 -0800 (Tue, 31 Oct 2006) | 12 lines

  In gcc/:
        * toplev.c (compile_file): Call final_write_globals
        even if there have been errors.
  In gcc/cp/:
        * decl2.c (cp_write_global_declarations): Rename from
        cp_finish_file.
        * cp-lang.c (finish_file): Don't call cp_finish_file.
        * cp-tree.h (cp_write_global_declarations): Rename from
        cp_finish_file.
        * cp-objcp-common.h (LANG_HOOKS_WRITE_GLOBALS): Define to
        cp_write_global_declarations.
........
  r118363 | geoffk | 2006-10-31 21:17:14 -0800 (Tue, 31 Oct 2006) | 1 line

  Add missing genopinit.c change for revision 118361.
........
  r118364 | geoffk | 2006-10-31 21:20:05 -0800 (Tue, 31 Oct 2006) | 10 lines

  2006-10-31  Eric Christopher  <echristo@apple.com>
            Falk Hueffner  <falk@debian.org>

        * gcc.dg/builtin-bswap-1.c: New.
        * gcc.dg/builtin-bswap-2.c: New.
        * gcc.dg/builtin-bswap-3.c: New.
        * gcc.dg/builtin-bswap-4.c: New.
        * gcc.dg/builtin-bswap-5.c: New.
        * gcc.target/i386/builtin-bswap-1.c: New.
........
  r118365 | geoffk | 2006-10-31 21:28:41 -0800 (Tue, 31 Oct 2006) | 28 lines

  In gcc/:
        PR 23067
        * c-decl.c (start_struct): Don't create self-containing
        structures.
        * config/rs6000/rs6000.c (darwin_rs6000_special_round_type_align):
        New.
        * config/rs6000/rs6000-protos.h
        (darwin_rs6000_special_round_type_align): New.
        * config/rs6000/darwin.h (ADJUST_FIELD_ALIGN): Rewrite.
        (ROUND_TYPE_ALIGN): Use darwin_rs6000_special_round_type_align.
  In gcc/testsuite/:
        PR 23067
        * gcc.target/powerpc/darwin-abi-3.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-6.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-7.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-8.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-9.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-10.c: Remove XFAIL.
        * gcc.target/powerpc/darwin-abi-11.c: Remove XFAIL.
  In libobjc/:
        * encoding.c (darwin_rs6000_special_round_type_align): New.
  In libffi/:
        * src/powerpc/ffi_darwin.c (darwin_adjust_aggregate_sizes): New.
        (ffi_prep_cif_machdep): Call darwin_adjust_aggregate_sizes for
        Darwin.
        * testsuite/libffi.call/nested_struct4.c: Remove Darwin XFAIL.
        * testsuite/libffi.call/nested_struct6.c: Remove Darwin XFAIL.
........
  r118366 | ghazi | 2006-10-31 21:38:21 -0800 (Tue, 31 Oct 2006) | 7 lines

        * builtins.def (gamma, lgamma): Use ATTR_MATHFN_FPROUNDING_STORE.

  testsuite:
        * gcc.dg/torture/builtin-attr-1.c: Don't test gamma/lgamma.
        * gcc.dg/torture/builtin-convert-1.c: Don't test lgamma.
........
  r118367 | geoffk | 2006-10-31 21:42:01 -0800 (Tue, 31 Oct 2006) | 1 line

  Fix date on ChangeLog entry
........
  r118371 | dannysmith | 2006-10-31 22:23:12 -0800 (Tue, 31 Oct 2006) | 22
lines

        * target.h (targetm.cxx.use_atexit_for_cxa_atexit): New target
        hook.
        * target-def.h: (TARGET_CXX_USE_ATEXIT_FOR_CXA_ATEXIT): Define
        default.
        * config/i386/mingw32.h (TARGET_CXX_USE_ATEXIT_FOR_CXA_ATEXIT):
        Override default.
        * doc/tm.texi (TARGET_CXX_USE_ATEXIT_FOR_CXA_ATEXIT): Document.
        * configure.ac (use_cxa_atexit): As a special case, don't test
        for libc definition of __cxa_atexit on mingw32
        * configure: Regenerate.
        * config.gcc (i[34567]86-pc-mingw32): Default to
        enable__cxa_atexit=yes.

  cp

        * decl.c (get_atexit_node): Reference atexit, not __cxa_exit.
        if targetm.cxx.use_atexit_for cxa_atexit.
        (start_cleanup_fn): Likewise.
        (register_dtor_fn): Likewise.
........
  r118372 | pinskia | 2006-10-31 23:28:53 -0800 (Tue, 31 Oct 2006) | 7 lines

  2006-10-31  Andrew Pinski  <pinskia@gmail.com>

          * doc/invoke.texi (-fkeep-inline-functions): Change "GNU C"
          to "GNU C89".
........
  r118373 | rguenth | 2006-11-01 03:38:06 -0800 (Wed, 01 Nov 2006) | 10 lines

  2006-11-01  Richard Guenther  <rguenther@suse.de>

        * config/i386/i386.c (ix86_expand_rint): Fix issues with
        signed zeros.
        (ix86_expand_floorceildf_32): Likewise.
        (ix86_expand_floorceil): Likewise.
        (ix86_expand_trunc): Likewise.

        * testsuite/gcc.target/i386/fpprec-1.c: New testcase.
........
  r118374 | ebotcazou | 2006-11-01 03:58:18 -0800 (Wed, 01 Nov 2006) | 1 line

  Fix asm string.
........
  r118377 | ebotcazou | 2006-11-01 04:09:25 -0800 (Wed, 01 Nov 2006) | 3 lines

        * gcc.c-torture/execute/20061101-1.c: New test.
........

Modified:
    branches/fixed-point/   (props changed)
    branches/fixed-point/fixincludes/ChangeLog
    branches/fixed-point/fixincludes/fixincl.x
    branches/fixed-point/fixincludes/inclhack.def
    branches/fixed-point/gcc/ChangeLog
    branches/fixed-point/gcc/DATESTAMP
    branches/fixed-point/gcc/ada/ChangeLog
    branches/fixed-point/gcc/ada/a-rbtgso.ads
    branches/fixed-point/gcc/builtin-types.def
    branches/fixed-point/gcc/builtins.c
    branches/fixed-point/gcc/builtins.def
    branches/fixed-point/gcc/c-decl.c
    branches/fixed-point/gcc/c-tree.h
    branches/fixed-point/gcc/c-typeck.c
    branches/fixed-point/gcc/cgraphunit.c
    branches/fixed-point/gcc/config.gcc
    branches/fixed-point/gcc/config/darwin.h
    branches/fixed-point/gcc/config/i386/darwin.h
    branches/fixed-point/gcc/config/i386/i386.c
    branches/fixed-point/gcc/config/i386/i386.h
    branches/fixed-point/gcc/config/i386/mingw32.h
    branches/fixed-point/gcc/config/rs6000/darwin.h
    branches/fixed-point/gcc/config/rs6000/rs6000-protos.h
    branches/fixed-point/gcc/config/rs6000/rs6000.c
    branches/fixed-point/gcc/configure
    branches/fixed-point/gcc/configure.ac
    branches/fixed-point/gcc/coverage.c
    branches/fixed-point/gcc/cp/ChangeLog
    branches/fixed-point/gcc/cp/cp-lang.c
    branches/fixed-point/gcc/cp/cp-objcp-common.h
    branches/fixed-point/gcc/cp/cp-tree.h
    branches/fixed-point/gcc/cp/decl.c
    branches/fixed-point/gcc/cp/decl2.c
    branches/fixed-point/gcc/cp/name-lookup.c
    branches/fixed-point/gcc/doc/extend.texi
    branches/fixed-point/gcc/doc/invoke.texi
    branches/fixed-point/gcc/doc/libgcc.texi
    branches/fixed-point/gcc/doc/rtl.texi
    branches/fixed-point/gcc/doc/tm.texi
    branches/fixed-point/gcc/dwarf2out.c
    branches/fixed-point/gcc/fold-const.c
    branches/fixed-point/gcc/fortran/ChangeLog
    branches/fixed-point/gcc/fortran/data.c
    branches/fixed-point/gcc/fortran/decl.c
    branches/fixed-point/gcc/fortran/expr.c
    branches/fixed-point/gcc/fortran/match.c
    branches/fixed-point/gcc/fortran/primary.c
    branches/fixed-point/gcc/fortran/trans-common.c
    branches/fixed-point/gcc/fortran/trans-decl.c
    branches/fixed-point/gcc/genattrtab.c
    branches/fixed-point/gcc/genopinit.c
    branches/fixed-point/gcc/libgcc-std.ver
    branches/fixed-point/gcc/libgcc2.c
    branches/fixed-point/gcc/libgcc2.h
    branches/fixed-point/gcc/mklibgcc.in
    branches/fixed-point/gcc/optabs.c
    branches/fixed-point/gcc/optabs.h
    branches/fixed-point/gcc/reload1.c
    branches/fixed-point/gcc/rtl.def
    branches/fixed-point/gcc/simplify-rtx.c
    branches/fixed-point/gcc/target-def.h
    branches/fixed-point/gcc/target.h
    branches/fixed-point/gcc/testsuite/ChangeLog
    branches/fixed-point/gcc/testsuite/gcc.dg/inline-10.c
    branches/fixed-point/gcc/testsuite/gcc.dg/torture/builtin-attr-1.c
    branches/fixed-point/gcc/testsuite/gcc.dg/torture/builtin-convert-1.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-10.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-11.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-3.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-6.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-7.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-8.c
    branches/fixed-point/gcc/testsuite/gcc.target/powerpc/darwin-abi-9.c
    branches/fixed-point/gcc/testsuite/gfortran.dg/blockdata_1.f90
    branches/fixed-point/gcc/toplev.c
    branches/fixed-point/gcc/tree.c
    branches/fixed-point/gcc/tree.h
    branches/fixed-point/libffi/ChangeLog
    branches/fixed-point/libffi/src/powerpc/ffi_darwin.c
    branches/fixed-point/libffi/testsuite/libffi.call/nested_struct4.c
    branches/fixed-point/libffi/testsuite/libffi.call/nested_struct6.c
    branches/fixed-point/libgfortran/ChangeLog
    branches/fixed-point/libgfortran/io/transfer.c
    branches/fixed-point/libgfortran/libgfortran.h
    branches/fixed-point/libgfortran/runtime/error.c
    branches/fixed-point/libobjc/ChangeLog
    branches/fixed-point/libobjc/encoding.c

Propchange: branches/fixed-point/
            ('svnmerge-integrated' modified)


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29067


^ permalink raw reply	[flat|nested] 23+ messages in thread

end of thread, other threads:[~2006-11-30 19:26 UTC | newest]

Thread overview: 23+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2006-09-13 20:10 [Bug fortran/29067] New: Internal Error: gfc_resolve_expr(): Bad expression type mathieu dot courtois at free dot fr
2006-09-13 20:17 ` [Bug fortran/29067] " kargl at gcc dot gnu dot org
2006-09-13 20:18 ` mathieu dot courtois at free dot fr
2006-09-13 21:42 ` kargl at gcc dot gnu dot org
2006-09-13 21:44 ` kargl at gcc dot gnu dot org
2006-09-14  9:05 ` mathieu dot courtois at free dot fr
2006-09-14  9:08 ` mathieu dot courtois at free dot fr
2006-10-12 12:18 ` pault at gcc dot gnu dot org
2006-10-12 14:13 ` sgk at troutmask dot apl dot washington dot edu
2006-10-13  7:39 ` fxcoudert at gcc dot gnu dot org
2006-10-13  7:54 ` fxcoudert at gcc dot gnu dot org
2006-10-15  1:21 ` kargl at gcc dot gnu dot org
2006-10-15  1:53 ` kargl at gcc dot gnu dot org
2006-10-15  8:40 ` fxcoudert at gcc dot gnu dot org
2006-10-16 21:28 ` mathieu dot courtois at free dot fr
2006-10-17 12:43 ` pault at gcc dot gnu dot org
2006-10-17 13:01 ` fxcoudert at gcc dot gnu dot org
2006-10-30 16:46 ` fxcoudert at gcc dot gnu dot org
2006-10-31 20:15 ` fxcoudert at gcc dot gnu dot org
2006-11-03 12:29 ` [Bug fortran/29067] [4.1/4.2 only] " fxcoudert at gcc dot gnu dot org
2006-11-03 14:26 ` fxcoudert at gcc dot gnu dot org
2006-11-03 14:28 ` [Bug fortran/29067] " fxcoudert at gcc dot gnu dot org
2006-11-30 19:26 ` chaoyingfu at gcc dot gnu dot org

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