public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/33241] New: ICE when compilation
@ 2007-08-29 23:20 victor dot prosolin at gmail dot com
2007-08-30 8:41 ` [Bug fortran/33241] ICE with parameter string arrays burnus at gcc dot gnu dot org
` (8 more replies)
0 siblings, 9 replies; 10+ messages in thread
From: victor dot prosolin at gmail dot com @ 2007-08-29 23:20 UTC (permalink / raw)
To: gcc-bugs
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 42844 bytes --]
When I try to compile the following file (attached at the end. quite big) I get
the folloring message
onefile.F90: In function MAIN__:
onefile.F90:778: internal compiler error: in gfc_get_symbol_decl, at
fortran/trans-decl.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.
Compilation options: gfortran-4.3 -save-temps onefile.F90 -Wall
System: OpenSuse 10.2 64 bit
gcc configure options (gcc-4.3 -v) :
Using built-in specs.
Target: x86_64-unknown-linux-gnu
Configured with: ../configure --prefix=/home/vip/programs/gcc
--enable-threads=posix --enable-languages=fortran --enable-checking=release
--enable-ssp --disable-libssp --disable-libgcj --with-system-zlib
--disable-shared --program-suffix=-4.3 --enable-version-specific-runtime-libs
--without-system-libunwind --enable-static : (reconfigured) ../configure
--prefix=/home/vip/programs/gcc --enable-threads=posix
--enable-languages=fortran --enable-checking=release --enable-ssp
--disable-libssp --disable-libgcj --with-system-zlib --disable-shared
--program-suffix=-4.3 --enable-version-specific-runtime-libs
--without-system-libunwind --enable-static
Thread model: posix
gcc version 4.3.0 20070821 (experimental) (GCC)
Source file:
MODULE parameters
!--------- -------- --------- --------- --------- --------- ---------
--------- -----
! Specify data types
!--------- -------- --------- --------- --------- --------- ---------
--------- -----
IMPLICIT NONE
INTEGER, PARAMETER :: rn = KIND(0.0d0) ! Precision of real numbers
INTEGER, PARAMETER :: is = SELECTED_INT_KIND(1) ! Data type of bytecode
END MODULE parameters
MODULE fparser
!------- -------- --------- --------- --------- --------- --------- ---------
-------
! Fortran 90 function parser v1.0
!------- -------- --------- --------- --------- --------- --------- ---------
-------
!
! This public domain function parser module is intended for applications
! where a set of mathematical expressions is specified at runtime and is
! then evaluated for a large number of variable values. This is done by
! compiling the set of function strings into byte code, which is interpreted
! very efficiently for the various variable values.
!
! The source code is available from:
! http://www.its.uni-karlsruhe.de/~schmehl/opensource/fparser-v1.0.tar.gz
!
! Please send comments, corrections or questions to the author:
! Roland Schmehl <Roland.Schmehl@mach.uni-karlsruhe.de>
!
!------- -------- --------- --------- --------- --------- --------- ---------
-------
! The function parser concept is based on a C++ class library written by Warp
! <warp@iki.fi> available from:
! http://www.students.tut.fi/~warp/FunctionParser/fparser.zip
!------- -------- --------- --------- --------- --------- --------- ---------
-------
USE parameters, ONLY: rn,is ! Import KIND parameters
IMPLICIT NONE
!------- -------- --------- --------- --------- --------- --------- ---------
-------
PUBLIC :: initf, & ! Initialize function parser for n
functions
parsef, & ! Parse single function string
evalf, & ! Evaluate single function
EvalErrMsg ! Error message (Use only when
EvalErrType>0)
INTEGER, PUBLIC :: EvalErrType ! =0: no error occured, >0:
evaluation error
!------- -------- --------- --------- --------- --------- --------- ---------
-------
PRIVATE
SAVE
INTEGER(is), PARAMETER :: cImmed = 1,
&
cNeg = 2,
&
cAdd = 3,
&
cSub = 4,
&
cMul = 5,
&
cDiv = 6,
&
cPow = 7,
&
cAbs = 8,
&
cExp = 9,
&
cLog10 = 10,
&
cLog = 11,
&
cSqrt = 12,
&
cSinh = 13,
&
cCosh = 14,
&
cTanh = 15,
&
cSin = 16,
&
cCos = 17,
&
cTan = 18,
&
cAsin = 19,
&
cAcos = 20,
&
cAtan = 21,
&
VarBegin = 22
CHARACTER (LEN=1), DIMENSION(cAdd:cPow), PARAMETER :: Ops = (/ '+',
&
'-',
&
'*',
&
'/',
&
'^' /)
CHARACTER (LEN=5), DIMENSION(cAbs:cAtan), PARAMETER :: Funcs = (/ 'abs ',
&
'exp ',
&
'log10',
&
'log ',
&
'sqrt ',
&
'sinh ',
&
'cosh ',
&
'tanh ',
&
'sin ',
&
'cos ',
&
'tan ',
&
'asin ',
&
'acos ',
&
'atan '
/)
TYPE tComp
INTEGER(is), DIMENSION(:), POINTER :: ByteCode
INTEGER :: ByteCodeSize
REAL(rn), DIMENSION(:), POINTER :: Immed
INTEGER :: ImmedSize
REAL(rn), DIMENSION(:), POINTER :: Stack
INTEGER :: StackSize, &
StackPtr
END TYPE tComp
TYPE (tComp), DIMENSION(:), POINTER :: Comp ! Bytecode
INTEGER, DIMENSION(:), ALLOCATABLE :: ipos ! Associates
function strings
!
CONTAINS
!
SUBROUTINE initf (n)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Initialize function parser for n functions
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: n ! Number of
functions
INTEGER :: i
!----- -------- --------- --------- --------- --------- --------- ---------
-------
ALLOCATE (Comp(n))
DO i=1,n
NULLIFY (Comp(i)%ByteCode,Comp(i)%Immed,Comp(i)%Stack)
END DO
END SUBROUTINE initf
!
SUBROUTINE parsef (i, FuncStr, Var)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Parse ith function string FuncStr and compile it into bytecode
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Function string
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
CHARACTER (LEN=LEN(FuncStr)) :: Func ! Function string,
local use
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IF (i < 1 .OR. i > SIZE(Comp)) THEN
WRITE(*,*) '*** Parser error: Function number ',i,' out of range'
STOP
END IF
ALLOCATE (ipos(LEN_TRIM(FuncStr))) ! Char. positions
in orig. string
Func = FuncStr ! Local copy of
function string
CALL Replace ('**','^ ',Func) ! Exponent into
1-Char. format
CALL RemoveSpaces (Func) ! Condense
function string
CALL CheckSyntax (Func,FuncStr,Var)
DEALLOCATE (ipos)
CALL Compile (i,Func,Var) ! Compile into
bytecode
END SUBROUTINE parsef
!
FUNCTION evalf (i, Val) RESULT (res)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Evaluate bytecode of ith function for the values passed in array Val(:)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
REAL(rn), DIMENSION(:), INTENT(in) :: Val ! Variable values
REAL(rn) :: res ! Result
INTEGER :: IP, & ! Instruction
pointer
DP, & ! Data pointer
SP ! Stack pointer
REAL(rn), PARAMETER :: zero = 0._rn
!----- -------- --------- --------- --------- --------- --------- ---------
-------
DP = 1
SP = 0
DO IP=1,Comp(i)%ByteCodeSize
SELECT CASE (Comp(i)%ByteCode(IP))
CASE (cImmed); SP=SP+1; Comp(i)%Stack(SP)=Comp(i)%Immed(DP); DP=DP+1
CASE (cNeg); Comp(i)%Stack(SP)=-Comp(i)%Stack(SP)
CASE (cAdd);
Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)+Comp(i)%Stack(SP); SP=SP-1
CASE (cSub);
Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)-Comp(i)%Stack(SP); SP=SP-1
CASE (cMul);
Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)*Comp(i)%Stack(SP); SP=SP-1
CASE (cDiv); IF (Comp(i)%Stack(SP)==0._rn) THEN; EvalErrType=1;
res=zero; RETURN; ENDIF
Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)/Comp(i)%Stack(SP); SP=SP-1
CASE (cPow);
Comp(i)%Stack(SP-1)=Comp(i)%Stack(SP-1)**Comp(i)%Stack(SP); SP=SP-1
CASE (cAbs); Comp(i)%Stack(SP)=ABS(Comp(i)%Stack(SP))
CASE (cExp); Comp(i)%Stack(SP)=EXP(Comp(i)%Stack(SP))
CASE (cLog10); IF (Comp(i)%Stack(SP)<=0._rn) THEN; EvalErrType=3;
res=zero; RETURN; ENDIF
Comp(i)%Stack(SP)=LOG10(Comp(i)%Stack(SP))
CASE (cLog); IF (Comp(i)%Stack(SP)<=0._rn) THEN; EvalErrType=3;
res=zero; RETURN; ENDIF
Comp(i)%Stack(SP)=LOG(Comp(i)%Stack(SP))
CASE (cSqrt); IF (Comp(i)%Stack(SP)<0._rn) THEN; EvalErrType=3;
res=zero; RETURN; ENDIF
Comp(i)%Stack(SP)=SQRT(Comp(i)%Stack(SP))
CASE (cSinh); Comp(i)%Stack(SP)=SINH(Comp(i)%Stack(SP))
CASE (cCosh); Comp(i)%Stack(SP)=COSH(Comp(i)%Stack(SP))
CASE (cTanh); Comp(i)%Stack(SP)=TANH(Comp(i)%Stack(SP))
CASE (cSin); Comp(i)%Stack(SP)=SIN(Comp(i)%Stack(SP))
CASE (cCos); Comp(i)%Stack(SP)=COS(Comp(i)%Stack(SP))
CASE (cTan); Comp(i)%Stack(SP)=TAN(Comp(i)%Stack(SP))
CASE (cAsin); IF
((Comp(i)%Stack(SP)<-1._rn).OR.(Comp(i)%Stack(SP)>1._rn)) THEN
EvalErrType=4; res=zero; RETURN; ENDIF
Comp(i)%Stack(SP)=ASIN(Comp(i)%Stack(SP))
CASE (cAcos); IF
((Comp(i)%Stack(SP)<-1._rn).OR.(Comp(i)%Stack(SP)>1._rn)) THEN
EvalErrType=4; res=zero; RETURN; ENDIF
Comp(i)%Stack(SP)=ACOS(Comp(i)%Stack(SP))
CASE (cAtan); Comp(i)%Stack(SP)=ATAN(Comp(i)%Stack(SP))
CASE DEFAULT; SP=SP+1;
Comp(i)%Stack(SP)=Val(Comp(i)%ByteCode(IP)-VarBegin+1)
END SELECT
END DO
EvalErrType = 0
res = Comp(i)%Stack(1)
END FUNCTION evalf
!
SUBROUTINE CheckSyntax (Func,FuncStr,Var)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check syntax of function string, returns 0 if syntax is ok
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: Func ! Function string
without spaces
CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original
function string
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
INTEGER(is) :: n
CHARACTER (LEN=1) :: c
REAL(rn) :: r
LOGICAL :: err
INTEGER :: ParCnt, & ! Parenthesis
counter
j,ib,in,lFunc
!----- -------- --------- --------- --------- --------- --------- ---------
-------
j = 1
ParCnt = 0
lFunc = LEN_TRIM(Func)
step: DO
IF (j > lFunc) CALL ParseErrMsg (j, FuncStr)
c = Func(j:j)
!-- -------- --------- --------- --------- --------- --------- ---------
-------
! Check for valid operand (must appear)
!-- -------- --------- --------- --------- --------- --------- ---------
-------
IF (c == '-' .OR. c == '+') THEN ! Check for
leading - or +
j = j+1
IF (j > lFunc) CALL ParseErrMsg (j, FuncStr, 'Missing operand')
c = Func(j:j)
IF (ANY(c == Ops)) CALL ParseErrMsg (j, FuncStr, 'Multiple
operators')
END IF
n = MathFunctionIndex (Func(j:))
IF (n > 0) THEN ! Check for math
function
j = j+LEN_TRIM(Funcs(n))
IF (j > lFunc) CALL ParseErrMsg (j, FuncStr, 'Missing function
argument')
c = Func(j:j)
IF (c /= '(') CALL ParseErrMsg (j, FuncStr, 'Missing opening
parenthesis')
END IF
IF (c == '(') THEN ! Check for
opening parenthesis
ParCnt = ParCnt+1
j = j+1
CYCLE step
END IF
IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number
r = RealNum (Func(j:),ib,in,err)
IF (err) CALL ParseErrMsg (j, FuncStr, 'Invalid number format:
'//Func(j+ib-1:j+in-2))
j = j+in-1
IF (j > lFunc) EXIT
c = Func(j:j)
ELSE ! Check for
variable
n = VariableIndex (Func(j:),Var,ib,in)
IF (n == 0) CALL ParseErrMsg (j, FuncStr, 'Invalid element:
'//Func(j+ib-1:j+in-2))
j = j+in-1
IF (j > lFunc) EXIT
c = Func(j:j)
END IF
DO WHILE (c == ')') ! Check for
closing parenthesis
ParCnt = ParCnt-1
IF (ParCnt < 0) CALL ParseErrMsg (j, FuncStr, 'Mismatched
parenthesis')
IF (Func(j-1:j-1) == '(') CALL ParseErrMsg (j-1, FuncStr, 'Empty
parentheses')
j = j+1
IF (j > lFunc) EXIT
c = Func(j:j)
END DO
!-- -------- --------- --------- --------- --------- --------- ---------
-------
! Now, we have a legal operand: A legal operator or end of string must
follow
!-- -------- --------- --------- --------- --------- --------- ---------
-------
IF (j > lFunc) EXIT
IF (ANY(c == Ops)) THEN ! Check for
multiple operators
IF (j+1 > lFunc) CALL ParseErrMsg (j, FuncStr)
IF (ANY(Func(j+1:j+1) == Ops)) CALL ParseErrMsg (j+1, FuncStr,
'Multiple operators')
ELSE ! Check for next
operand
CALL ParseErrMsg (j, FuncStr, 'Missing operator')
END IF
!-- -------- --------- --------- --------- --------- --------- ---------
-------
! Now, we have an operand and an operator: the next loop will check for
another
! operand (must appear)
!-- -------- --------- --------- --------- --------- --------- ---------
-------
j = j+1
END DO step
IF (ParCnt > 0) CALL ParseErrMsg (j, FuncStr, 'Missing )')
END SUBROUTINE CheckSyntax
!
FUNCTION EvalErrMsg () RESULT (msg)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Return error message
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), DIMENSION(4), PARAMETER :: m = (/ 'Division by zero
', &
'Argument of SQRT
negative ', &
'Argument of LOG
negative ', &
'Argument of ASIN or
ACOS illegal' /)
CHARACTER (LEN=LEN(m)) :: msg
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IF (EvalErrType < 1 .OR. EvalErrType > SIZE(m)) THEN
msg = ''
ELSE
msg = m(EvalErrType)
ENDIF
END FUNCTION EvalErrMsg
!
SUBROUTINE ParseErrMsg (j, FuncStr, Msg)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! !print error message and terminate program
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: j
CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original
function string
CHARACTER (LEN=*), OPTIONAL, INTENT(in) :: Msg
INTEGER :: k
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IF (PRESENT(Msg)) THEN
WRITE(*,*) '*** Error in syntax of function string: '//Msg
ELSE
WRITE(*,*) '*** Error in syntax of function string:'
ENDIF
WRITE(*,*)
WRITE(*,'(A)') ' '//FuncStr
DO k=1,ipos(j)
WRITE(*,'(A)',ADVANCE='NO') ' ' ! Advance to the
jth position
END DO
WRITE(*,'(A)') '?'
STOP
END SUBROUTINE ParseErrMsg
!
FUNCTION OperatorIndex (c) RESULT (n)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Return operator index
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=1), INTENT(in) :: c
INTEGER(is) :: n,j
!----- -------- --------- --------- --------- --------- --------- ---------
-------
n = 0
DO j=cAdd,cPow
IF (c == Ops(j)) THEN
n = j
EXIT
END IF
END DO
END FUNCTION OperatorIndex
!
FUNCTION MathFunctionIndex (str) RESULT (n)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Return index of math function beginnig at 1st position of string str
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: str
INTEGER(is) :: n,j
INTEGER :: k
CHARACTER (LEN=LEN(Funcs)) :: fun
!----- -------- --------- --------- --------- --------- --------- ---------
-------
n = 0
DO j=cAbs,cAtan ! Check all math
functions
k = MIN(LEN_TRIM(Funcs(j)), LEN(str))
CALL LowCase (str(1:k), fun)
IF (fun == Funcs(j)) THEN ! Compare lower
case letters
n = j ! Found a matching
function
EXIT
END IF
END DO
END FUNCTION MathFunctionIndex
!
FUNCTION VariableIndex (str, Var, ibegin, inext) RESULT (n)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Return index of variable at begin of string str (returns 0 if no variable
found)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: str ! String
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
INTEGER(is) :: n ! Index of
variable
INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position
of variable name
inext ! Position of
character after name
INTEGER :: j,ib,in,lstr
!----- -------- --------- --------- --------- --------- --------- ---------
-------
n = 0
!print*, "IN VariableIndex:", str, Var!, ibegin, inext
lstr = LEN_TRIM(str)
IF (lstr > 0) THEN
DO ib=1,lstr ! Search for first
character in str
IF (str(ib:ib) /= ' ') EXIT ! When lstr>0 at
least 1 char in str
END DO
DO in=ib,lstr ! Search for name
terminators
IF (SCAN(str(in:in),'+-*/^) ') > 0) EXIT
END DO
DO j=1,SIZE(Var)
IF (str(ib:in-1) == Var(j)) THEN
n = j ! Variable name
found
EXIT
END IF
END DO
END IF
IF (PRESENT(ibegin)) ibegin = ib
IF (PRESENT(inext)) inext = in
END FUNCTION VariableIndex
!
SUBROUTINE RemoveSpaces (str)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Remove Spaces from string, remember positions of characters in old string
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(inout) :: str
INTEGER :: k,lstr
!----- -------- --------- --------- --------- --------- --------- ---------
-------
lstr = LEN_TRIM(str)
ipos = (/ (k,k=1,lstr) /)
k = 1
DO WHILE (str(k:lstr) /= ' ')
IF (str(k:k) == ' ') THEN
str(k:lstr) = str(k+1:lstr)//' ' ! Move 1 character
to left
ipos(k:lstr) = (/ ipos(k+1:lstr), 0 /) ! Move 1 element
to left
k = k-1
END IF
k = k+1
END DO
END SUBROUTINE RemoveSpaces
!
SUBROUTINE Replace (ca,cb,str)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Replace ALL appearances of character set ca in string str by character
set cb
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: ca
CHARACTER (LEN=LEN(ca)), INTENT(in) :: cb ! LEN(ca) must be
LEN(cb)
CHARACTER (LEN=*), INTENT(inout) :: str
INTEGER :: j,lca
!----- -------- --------- --------- --------- --------- --------- ---------
-------
lca = LEN(ca)
DO j=1,LEN_TRIM(str)-lca+1
IF (str(j:j+lca-1) == ca) str(j:j+lca-1) = cb
END DO
END SUBROUTINE Replace
!
SUBROUTINE Compile (i, F, Var)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Compile i-th function string F into bytecode
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
CHARACTER (LEN=*), INTENT(in) :: F ! Function string
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
INTEGER :: istat
!----- -------- --------- --------- --------- --------- --------- ---------
-------
!print*, "IN Compile", i, F, Var
IF (ASSOCIATED(Comp(i)%ByteCode)) DEALLOCATE ( Comp(i)%ByteCode, &
Comp(i)%Immed, &
Comp(i)%Stack )
Comp(i)%ByteCodeSize = 0
Comp(i)%ImmedSize = 0
Comp(i)%StackSize = 0
Comp(i)%StackPtr = 0
CALL CompileSubstr (i,F,1,LEN_TRIM(F),Var) ! Compile string
to determine size
ALLOCATE ( Comp(i)%ByteCode(Comp(i)%ByteCodeSize), &
Comp(i)%Immed(Comp(i)%ImmedSize), &
Comp(i)%Stack(Comp(i)%StackSize), &
STAT = istat )
IF (istat /= 0) THEN
WRITE(*,*) '*** Parser error: Memmory allocation for byte code failed'
STOP
ELSE
Comp(i)%ByteCodeSize = 0
Comp(i)%ImmedSize = 0
Comp(i)%StackSize = 0
Comp(i)%StackPtr = 0
CALL CompileSubstr (i,F,1,LEN_TRIM(F),Var) ! Compile string
into bytecode
END IF
!
END SUBROUTINE Compile
!
SUBROUTINE AddCompiledByte (i, b)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Add compiled byte to bytecode
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
INTEGER(is), INTENT(in) :: b ! Value of byte to
be added
!----- -------- --------- --------- --------- --------- --------- ---------
-------
Comp(i)%ByteCodeSize = Comp(i)%ByteCodeSize + 1
IF (ASSOCIATED(Comp(i)%ByteCode)) Comp(i)%ByteCode(Comp(i)%ByteCodeSize) =
b
END SUBROUTINE AddCompiledByte
!
FUNCTION MathItemIndex (i, F, Var) RESULT (n)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Return math item index, if item is real number, enter it into
Comp-structure
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
CHARACTER (LEN=*), INTENT(in) :: F ! Function
substring
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
INTEGER(is) :: n ! Byte value of
math item
!----- -------- --------- --------- --------- --------- --------- ---------
-------
n = 0
!print*, "IN MathItemIndex", i, F, Var
IF (SCAN(F(1:1),'0123456789.') > 0) THEN ! Check for begin
of a number
Comp(i)%ImmedSize = Comp(i)%ImmedSize + 1
IF (ASSOCIATED(Comp(i)%Immed)) Comp(i)%Immed(Comp(i)%ImmedSize) =
RealNum (F)
n = cImmed
ELSE ! Check for a
variable
!print*, "B4 VariableIndex ", F, Var
n = VariableIndex (F, Var)
IF (n > 0) n = VarBegin+n-1
END IF
END FUNCTION MathItemIndex
!
FUNCTION CompletelyEnclosed (F, b, e) RESULT (res)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check if function substring F(b:e) is completely enclosed by a pair of
parenthesis
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: F ! Function
substring
INTEGER, INTENT(in) :: b,e ! First and last
pos. of substring
LOGICAL :: res
INTEGER :: j,k
!----- -------- --------- --------- --------- --------- --------- ---------
-------
res=.false.
IF (F(b:b) == '(' .AND. F(e:e) == ')') THEN
k = 0
DO j=b+1,e-1
IF (F(j:j) == '(') THEN
k = k+1
ELSEIF (F(j:j) == ')') THEN
k = k-1
END IF
IF (k < 0) EXIT
END DO
IF (k == 0) res=.true. ! All opened
parenthesis closed
END IF
END FUNCTION CompletelyEnclosed
!
RECURSIVE SUBROUTINE CompileSubstr (i, F, b, e, Var)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Compile i-th function string F into bytecode
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: i ! Function
identifier
CHARACTER (LEN=*), INTENT(in) :: F ! Function
substring
INTEGER, INTENT(in) :: b,e ! Begin and end
position substring
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with
variable names
INTEGER(is) :: n
INTEGER :: b2,j,k,io
CHARACTER (LEN=*), PARAMETER :: calpha =
'abcdefghijklmnopqrstuvwxyz'// &
'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check for special cases of substring
!----- -------- --------- --------- --------- --------- --------- ---------
-------
!print*, "IN CompileSubstr", i, F, b, e, Var
IF (F(b:b) == '+') THEN ! Case 1: F(b:e) =
'+...'
! WRITE(*,*)'1. F(b:e) = "+..."'
CALL CompileSubstr (i, F, b+1, e, Var)
RETURN
ELSEIF (CompletelyEnclosed (F, b, e)) THEN ! Case 2: F(b:e) =
'(...)'
! WRITE(*,*)'2. F(b:e) = "(...)"'
CALL CompileSubstr (i, F, b+1, e-1, Var)
RETURN
ELSEIF (SCAN(F(b:b),calpha) > 0) THEN
n = MathFunctionIndex (F(b:e))
IF (n > 0) THEN
b2 = b+INDEX(F(b:e),'(')-1
IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 3: F(b:e) =
'fcn(...)'
! WRITE(*,*)'3. F(b:e) = "fcn(...)"'
CALL CompileSubstr(i, F, b2+1, e-1, Var)
CALL AddCompiledByte (i, n)
RETURN
END IF
END IF
ELSEIF (F(b:b) == '-') THEN
IF (CompletelyEnclosed (F, b+1, e)) THEN ! Case 4: F(b:e) =
'-(...)'
! WRITE(*,*)'4. F(b:e) = "-(...)"'
CALL CompileSubstr (i, F, b+2, e-1, Var)
CALL AddCompiledByte (i, cNeg)
RETURN
ELSEIF (SCAN(F(b+1:b+1),calpha) > 0) THEN
n = MathFunctionIndex (F(b+1:e))
IF (n > 0) THEN
b2 = b+INDEX(F(b+1:e),'(')
IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 5: F(b:e) =
'-fcn(...)'
! WRITE(*,*)'5. F(b:e) = "-fcn(...)"'
CALL CompileSubstr(i, F, b2+1, e-1, Var)
CALL AddCompiledByte (i, n)
CALL AddCompiledByte (i, cNeg)
RETURN
END IF
END IF
ENDIF
END IF
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check for operator in substring: check only base level (k=0), exclude
expr. in ()
!----- -------- --------- --------- --------- --------- --------- ---------
-------
DO io=cAdd,cPow ! Increasing
priority +-*/^
k = 0
DO j=e,b,-1
IF (F(j:j) == ')') THEN
k = k+1
ELSEIF (F(j:j) == '(') THEN
k = k-1
END IF
IF (k == 0 .AND. F(j:j) == Ops(io) .AND. IsBinaryOp (j, F)) THEN
IF (ANY(F(j:j) == Ops(cMul:cPow)) .AND. F(b:b) == '-') THEN ! Case
6: F(b:e) = '-...Op...' with Op > -
! WRITE(*,*)'6. F(b:e) = "-...Op..." with Op > -'
CALL CompileSubstr (i, F, b+1, e, Var)
CALL AddCompiledByte (i, cNeg)
RETURN
ELSE ! Case
7: F(b:e) = '...BinOp...'
! WRITE(*,*)'7. Binary operator',F(j:j)
CALL CompileSubstr (i, F, b, j-1, Var)
CALL CompileSubstr (i, F, j+1, e, Var)
CALL AddCompiledByte (i, OperatorIndex(Ops(io)))
Comp(i)%StackPtr = Comp(i)%StackPtr - 1
RETURN
END IF
END IF
END DO
END DO
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check for remaining items, i.e. variables or explicit numbers
!----- -------- --------- --------- --------- --------- --------- ---------
-------
b2 = b
IF (F(b:b) == '-') b2 = b2+1
!print*, "B4 MathItemIndex", i, F(b2:e), Var
n = MathItemIndex(i, F(b2:e), Var)
! WRITE(*,*)'8. AddCompiledByte ',n
CALL AddCompiledByte (i, n)
Comp(i)%StackPtr = Comp(i)%StackPtr + 1
IF (Comp(i)%StackPtr > Comp(i)%StackSize) Comp(i)%StackSize =
Comp(i)%StackSize + 1
IF (b2 > b) CALL AddCompiledByte (i, cNeg)
END SUBROUTINE CompileSubstr
!
FUNCTION IsBinaryOp (j, F) RESULT (res)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Check if operator F(j:j) in string F is binary operator
! Special cases already covered elsewhere: (that is corrected
in v1.1)
! - operator character F(j:j) is first character of string (j=1)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
INTEGER, INTENT(in) :: j ! Position of
Operator
CHARACTER (LEN=*), INTENT(in) :: F ! String
LOGICAL :: res ! Result
INTEGER :: k
LOGICAL :: Dflag,Pflag
!----- -------- --------- --------- --------- --------- --------- ---------
-------
res=.true.
IF (F(j:j) == '+' .OR. F(j:j) == '-') THEN ! Plus or minus
sign:
IF (j == 1) THEN ! - leading unary
operator ?
res = .false.
ELSEIF (SCAN(F(j-1:j-1),'+-*/^(') > 0) THEN ! - other unary
operator ?
res = .false.
ELSEIF (SCAN(F(j+1:j+1),'0123456789') > 0 .AND. & ! - in exponent of
real number ?
SCAN(F(j-1:j-1),'eEdD') > 0) THEN
Dflag=.false.; Pflag=.false.
k = j-1
DO WHILE (k > 1) ! step to the
left in mantissa
k = k-1
IF (SCAN(F(k:k),'0123456789') > 0) THEN
Dflag=.true.
ELSEIF (F(k:k) == '.') THEN
IF (Pflag) THEN
EXIT ! * EXIT: 2nd
appearance of '.'
ELSE
Pflag=.true. ! * mark 1st
appearance of '.'
ENDIF
ELSE
EXIT ! * all other
characters
END IF
END DO
IF (Dflag .AND. (k == 1 .OR. SCAN(F(k:k),'+-*/^(') > 0)) res =
.false.
END IF
END IF
END FUNCTION IsBinaryOp
!
FUNCTION RealNum (str, ibegin, inext, error) RESULT (res)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Get real number from string - Format:
[blanks][+|-][nnn][.nnn][e|E|d|D[+|-]nnn]
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: str ! String
REAL(rn) :: res ! Real number
INTEGER, OPTIONAL, INTENT(out) :: ibegin, & ! Start position
of real number
inext ! 1st character
after real number
LOGICAL, OPTIONAL, INTENT(out) :: error ! Error flag
INTEGER :: ib,in,istat
LOGICAL :: Bflag, & ! .T. at begin of
number in str
InMan, & ! .T. in mantissa
of number
Pflag, & ! .T. after 1st
'.' encountered
Eflag, & ! .T. at exponent
identifier 'eEdD'
InExp, & ! .T. in exponent
of number
DInMan, & ! .T. if at least
1 digit in mant.
DInExp, & ! .T. if at least
1 digit in exp.
err ! Local error flag
!----- -------- --------- --------- --------- --------- --------- ---------
-------
Bflag=.true.; InMan=.false.; Pflag=.false.; Eflag=.false.; InExp=.false.
DInMan=.false.; DInExp=.false.
ib = 1
in = 1
DO WHILE (in <= LEN_TRIM(str))
SELECT CASE (str(in:in))
CASE (' ') ! Only leading
blanks permitted
ib = ib+1
IF (InMan .OR. Eflag .OR. InExp) EXIT
CASE ('+','-') ! Permitted only
IF (Bflag) THEN
InMan=.true.; Bflag=.false. ! - at beginning
of mantissa
ELSEIF (Eflag) THEN
InExp=.true.; Eflag=.false. ! - at beginning
of exponent
ELSE
EXIT ! - otherwise STOP
ENDIF
CASE ('0':'9') ! Mark
IF (Bflag) THEN
InMan=.true.; Bflag=.false. ! - beginning of
mantissa
ELSEIF (Eflag) THEN
InExp=.true.; Eflag=.false. ! - beginning of
exponent
ENDIF
IF (InMan) DInMan=.true. ! Mantissa
contains digit
IF (InExp) DInExp=.true. ! Exponent
contains digit
CASE ('.')
IF (Bflag) THEN
Pflag=.true. ! - mark 1st
appearance of '.'
InMan=.true.; Bflag=.false. ! mark beginning
of mantissa
ELSEIF (InMan .AND..NOT.Pflag) THEN
Pflag=.true. ! - mark 1st
appearance of '.'
ELSE
EXIT ! - otherwise STOP
END IF
CASE ('e','E','d','D') ! Permitted only
IF (InMan) THEN
Eflag=.true.; InMan=.false. ! - following
mantissa
ELSE
EXIT ! - otherwise STOP
ENDIF
CASE DEFAULT
EXIT ! STOP at all
other characters
END SELECT
in = in+1
END DO
err = (ib > in-1) .OR. (.NOT.DInMan) .OR.
((Eflag.OR.InExp).AND..NOT.DInExp)
IF (err) THEN
res = 0.0_rn
ELSE
READ(str(ib:in-1),*,IOSTAT=istat) res
err = istat /= 0
END IF
IF (PRESENT(ibegin)) ibegin = ib
IF (PRESENT(inext)) inext = in
IF (PRESENT(error)) error = err
END FUNCTION RealNum
!
SUBROUTINE LowCase (str1, str2)
!----- -------- --------- --------- --------- --------- --------- ---------
-------
! Transform upper case letters in str1 into lower case letters, result is
str2
!----- -------- --------- --------- --------- --------- --------- ---------
-------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: str1
CHARACTER (LEN=*), INTENT(out) :: str2
INTEGER :: j,k
CHARACTER (LEN=*), PARAMETER :: lc = 'abcdefghijklmnopqrstuvwxyz'
CHARACTER (LEN=*), PARAMETER :: uc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
!----- -------- --------- --------- --------- --------- --------- ---------
-------
str2 = str1
DO j=1,LEN_TRIM(str1)
k = INDEX(uc,str1(j:j))
IF (k > 0) str2(j:j) = lc(k:k)
END DO
END SUBROUTINE LowCase
!
END MODULE fparser
PROGRAM fptest
!--------- -------- --------- --------- --------- --------- ---------
--------- -----
!
! Example program 4 for using the function parser module
!
!--------- -------- --------- --------- --------- --------- ---------
--------- -----
USE parameters, ONLY: rn
USE fparser
IMPLICIT NONE
INTEGER, PARAMETER :: nfunc = 1
CHARACTER (LEN=*), DIMENSION(nfunc), PARAMETER :: func = (/ '1.0e0 + 5.e1' /)
INTEGER, PARAMETER :: nvar = 0
CHARACTER (LEN=*), DIMENSION(nvar), PARAMETER :: var = 'a'
REAL(rn), DIMENSION(nvar), PARAMETER :: val = 0._rn
REAL(rn) :: res
INTEGER :: i
!--------- -------- --------- --------- --------- --------- ---------
--------- -----
!
CALL initf (nfunc) ! Initialize function parser for
nfunc functions
DO i=1,nfunc
WRITE(*,*)'UP parsef'
CALL parsef (i, func(i), var) ! Parse and bytecompile ith function
string
END DO
DO i=1,nfunc
WRITE(*,*)'FCN evalf'
res = evalf (i, val) ! Interprete bytecode representation
of ith function
IF (EvalErrType > 0) WRITE(*,*)'*** Error: ',EvalErrMsg ()
WRITE(*,*)'res=',res
END DO
!
END PROGRAM fptest
--
Summary: ICE when compilation
Product: gcc
Version: 4.3.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: victor dot prosolin at gmail dot com
GCC build triplet: x86_64-unknown-linux-gnu
GCC host triplet: x86_64-unknown-linux-gnu
GCC target triplet: x86_64-unknown-linux-gnu
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
@ 2007-08-30 8:41 ` burnus at gcc dot gnu dot org
2007-08-30 9:04 ` burnus at gcc dot gnu dot org
` (7 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: burnus at gcc dot gnu dot org @ 2007-08-30 8:41 UTC (permalink / raw)
To: gcc-bugs
------- Comment #1 from burnus at gcc dot gnu dot org 2007-08-30 08:41 -------
Please attach such long examples the next time. This makes the bug report
easier to read and saves one from removing all the line breaks that get added.
I tried your example with NAG f95 and it reports:
Error: line 278: Array constructor values have differing CHARACTER lengths (21
and 32)
If I fix this error, it compiles with NAG f95 without errors.
Independent of this fix, it creashes with gfortran; minimal test case:
PROGRAM fptest
IMPLICIT NONE
CHARACTER (LEN=*), DIMENSION(1), PARAMETER :: var = 'a'
CALL parsef (var)
contains
SUBROUTINE parsef (Var)
IMPLICIT NONE
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var
END SUBROUTINE parsef
END PROGRAM fptest
--
burnus at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |burnus at gcc dot gnu dot
| |org
OtherBugsDependingO| |32834
nThis| |
GCC build triplet|x86_64-unknown-linux-gnu |
GCC host triplet|x86_64-unknown-linux-gnu |
GCC target triplet|x86_64-unknown-linux-gnu |
Keywords| |ice-on-valid-code
Known to fail| |4.1.3 4.2.2 4.3.0
Summary|ICE when compilation |ICE with parameter string
| |arrays
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
2007-08-30 8:41 ` [Bug fortran/33241] ICE with parameter string arrays burnus at gcc dot gnu dot org
@ 2007-08-30 9:04 ` burnus at gcc dot gnu dot org
2007-08-30 9:07 ` burnus at gcc dot gnu dot org
` (6 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: burnus at gcc dot gnu dot org @ 2007-08-30 9:04 UTC (permalink / raw)
To: gcc-bugs
------- Comment #2 from burnus at gcc dot gnu dot org 2007-08-30 09:04 -------
Forgot to mention that gfortran gives the same error as NAG f95 but only when
using -std=f95 or f2003:
Error: The CHARACTER elements of the array constructor at (1) must have the
same length (24/32)
Work around: Change
CHARACTER (LEN=*), DIMENSION(nvar), PARAMETER :: var = 'a'
into
CHARACTER (LEN=20), DIMENSION(nvar), PARAMETER :: var = 'a'
and the ICE is gone.
--
burnus at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
OtherBugsDependingO| |19276
nThis| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
2007-08-30 8:41 ` [Bug fortran/33241] ICE with parameter string arrays burnus at gcc dot gnu dot org
2007-08-30 9:04 ` burnus at gcc dot gnu dot org
@ 2007-08-30 9:07 ` burnus at gcc dot gnu dot org
2007-08-30 13:41 ` fxcoudert at gcc dot gnu dot org
` (5 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: burnus at gcc dot gnu dot org @ 2007-08-30 9:07 UTC (permalink / raw)
To: gcc-bugs
------- Comment #3 from burnus at gcc dot gnu dot org 2007-08-30 09:07 -------
Created an attachment (id=14138)
--> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=14138&action=view)
Testcase of comment 0 as file
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (2 preceding siblings ...)
2007-08-30 9:07 ` burnus at gcc dot gnu dot org
@ 2007-08-30 13:41 ` fxcoudert at gcc dot gnu dot org
2007-08-30 17:09 ` victor dot prosolin at gmail dot com
` (4 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: fxcoudert at gcc dot gnu dot org @ 2007-08-30 13:41 UTC (permalink / raw)
To: gcc-bugs
--
fxcoudert at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|UNCONFIRMED |NEW
Ever Confirmed|0 |1
Last reconfirmed|0000-00-00 00:00:00 |2007-08-30 13:40:52
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (3 preceding siblings ...)
2007-08-30 13:41 ` fxcoudert at gcc dot gnu dot org
@ 2007-08-30 17:09 ` victor dot prosolin at gmail dot com
2007-09-04 18:17 ` pault at gcc dot gnu dot org
` (3 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: victor dot prosolin at gmail dot com @ 2007-08-30 17:09 UTC (permalink / raw)
To: gcc-bugs
------- Comment #4 from victor dot prosolin at gmail dot com 2007-08-30 17:09 -------
I am sorry for posting such a long example, but the code was not written by me
so I didn't want to make stupid changes. It's my first time reporting a bug via
bugzilla so don't be too critical about me not figuring out how to create an
attachment instead of posting it as a message.
Additional info: Intel Fortran, Sun Fortran, openf95 and g95 pass this code
with no problem, though g95 segfaults on execution.
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (4 preceding siblings ...)
2007-08-30 17:09 ` victor dot prosolin at gmail dot com
@ 2007-09-04 18:17 ` pault at gcc dot gnu dot org
2007-09-05 13:35 ` pault at gcc dot gnu dot org
` (2 subsequent siblings)
8 siblings, 0 replies; 10+ messages in thread
From: pault at gcc dot gnu dot org @ 2007-09-04 18:17 UTC (permalink / raw)
To: gcc-bugs
------- Comment #5 from pault at gcc dot gnu dot org 2007-09-04 18:17 -------
A fix for this one is coming with that for PR31564 - within 48 hours.
Paul
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
AssignedTo|unassigned at gcc dot gnu |pault at gcc dot gnu dot org
|dot org |
Status|NEW |ASSIGNED
Last reconfirmed|2007-08-30 13:40:52 |2007-09-04 18:17:16
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (5 preceding siblings ...)
2007-09-04 18:17 ` pault at gcc dot gnu dot org
@ 2007-09-05 13:35 ` pault at gcc dot gnu dot org
2007-09-05 13:37 ` pault at gcc dot gnu dot org
2007-09-06 11:56 ` patchapp at dberlin dot org
8 siblings, 0 replies; 10+ messages in thread
From: pault at gcc dot gnu dot org @ 2007-09-05 13:35 UTC (permalink / raw)
To: gcc-bugs
------- Comment #6 from pault at gcc dot gnu dot org 2007-09-05 13:34 -------
Subject: Bug 33241
Author: pault
Date: Wed Sep 5 13:34:25 2007
New Revision: 128130
URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=128130
Log:
2007-09-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31564
* primary.c (gfc_match_rvalue): Make expressions that refer
to derived type parameters that have array references into
variable expressions. Remove references to use association
from the symbol.
PR fortran/33241
* decl.c (add_init_expr_to_sym): Provide assumed character
length parameters with the length of the initialization
expression, if a constant, or that of the first element of
an array.
2007-09-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31564
* gfortran.dg/derived_comp_array_ref_2.f90: New test.
PR fortran/33241
* gfortran.dg/char_length_10.f90: New test.
Added:
trunk/gcc/testsuite/gfortran.dg/char_length_10.f90
trunk/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90
Modified:
trunk/gcc/fortran/ChangeLog
trunk/gcc/fortran/decl.c
trunk/gcc/fortran/primary.c
trunk/gcc/testsuite/ChangeLog
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (6 preceding siblings ...)
2007-09-05 13:35 ` pault at gcc dot gnu dot org
@ 2007-09-05 13:37 ` pault at gcc dot gnu dot org
2007-09-06 11:56 ` patchapp at dberlin dot org
8 siblings, 0 replies; 10+ messages in thread
From: pault at gcc dot gnu dot org @ 2007-09-05 13:37 UTC (permalink / raw)
To: gcc-bugs
------- Comment #7 from pault at gcc dot gnu dot org 2007-09-05 13:37 -------
Fixed on trunk
Paul
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|ASSIGNED |RESOLVED
Resolution| |FIXED
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
* [Bug fortran/33241] ICE with parameter string arrays
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
` (7 preceding siblings ...)
2007-09-05 13:37 ` pault at gcc dot gnu dot org
@ 2007-09-06 11:56 ` patchapp at dberlin dot org
8 siblings, 0 replies; 10+ messages in thread
From: patchapp at dberlin dot org @ 2007-09-06 11:56 UTC (permalink / raw)
To: gcc-bugs
------- Comment #8 from patchapp at dberlin dot org 2007-09-06 11:55 -------
Subject: Bug number PR33241
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-09/msg00322.html
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33241
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2007-09-06 11:56 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-08-29 23:20 [Bug fortran/33241] New: ICE when compilation victor dot prosolin at gmail dot com
2007-08-30 8:41 ` [Bug fortran/33241] ICE with parameter string arrays burnus at gcc dot gnu dot org
2007-08-30 9:04 ` burnus at gcc dot gnu dot org
2007-08-30 9:07 ` burnus at gcc dot gnu dot org
2007-08-30 13:41 ` fxcoudert at gcc dot gnu dot org
2007-08-30 17:09 ` victor dot prosolin at gmail dot com
2007-09-04 18:17 ` pault at gcc dot gnu dot org
2007-09-05 13:35 ` pault at gcc dot gnu dot org
2007-09-05 13:37 ` pault at gcc dot gnu dot org
2007-09-06 11:56 ` patchapp at dberlin 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).