Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | StackNum | |||
integer, | intent(in) | :: | LineNum | |||
character(len=*), | intent(in) | :: | Error |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE AddError(StackNum, LineNum, Error)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Adds an error message to a stack.
! METHODOLOGY EMPLOYED:
!
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: StackNum ! index pointer to location in ErlStack structure
INTEGER, INTENT(IN) :: LineNum ! Erl program line number
CHARACTER(len=*), INTENT(IN) :: Error ! error message to be added to ErlStack
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
TYPE(ErlStackType) :: TempStack ! temporary copy of single ErlStack
INTEGER :: ErrorNum ! local count of errors for this ErlStack
! FLOW:
IF (ErlStack(StackNum)%NumErrors == 0) THEN
ALLOCATE(ErlStack(StackNum)%Error(1))
ErlStack(StackNum)%NumErrors = 1
ELSE
TempStack = ErlStack(StackNum)
DEALLOCATE(ErlStack(StackNum)%Error)
ALLOCATE(ErlStack(StackNum)%Error(ErlStack(StackNum)%NumErrors + 1))
ErlStack(StackNum)%Error(1:ErlStack(StackNum)%NumErrors) = TempStack%Error(1:ErlStack(StackNum)%NumErrors)
ErlStack(StackNum)%NumErrors = ErlStack(StackNum)%NumErrors + 1
END IF
ErrorNum = ErlStack(StackNum)%NumErrors
IF (LineNum > 0) THEN
ErlStack(StackNum)%Error(ErrorNum) = &
'Line '//TRIM(IntegerToString(LineNum))//': '//Error//' "'//TRIM(ErlStack(StackNum)%Line(LineNum))//'"'
ELSE
ErlStack(StackNum)%Error(ErrorNum) = Error
END IF
RETURN
END SUBROUTINE AddError