Skip to content

Type/Class Mods #78

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
DavidAKopriva wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Type/Class Mods #78

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion Source/FTObjects/FTDictionaryClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -571,7 +571,7 @@ SUBROUTINE castToDictionary(obj,cast)
!
IMPLICIT NONE
CLASS(FTObject) , POINTER :: obj
CLASS(FTDictionary), POINTER :: cast
TYPE (FTDictionary), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down
22 changes: 13 additions & 9 deletions Source/FTObjects/FTExceptionClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -417,7 +417,7 @@ SUBROUTINE castToException(obj,cast)
!
IMPLICIT NONE
CLASS(FTObject) , POINTER :: obj
CLASS(FTException), POINTER :: cast
TYPE (FTException), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down Expand Up @@ -611,7 +611,7 @@ SUBROUTINE throw(exceptionToThrow)
!>Throws the exception: exceptionToThrow
!
IMPLICIT NONE
TYPE (FTException), POINTER :: exceptionToThrow
CLASS(FTException), POINTER :: exceptionToThrow
CLASS(FTObject) , POINTER :: ptr => NULL()

IF ( .NOT.ASSOCIATED(errorStack) ) THEN
Expand Down Expand Up @@ -702,9 +702,10 @@ LOGICAL FUNCTION catchErrorWithName(exceptionName)
CHARACTER(LEN=*) :: exceptionName

TYPE(FTLinkedListIterator) :: iterator
CLASS(FTLinkedList), POINTER :: ptr => NULL()
CLASS(FTObject) , POINTER :: obj => NULL()
CLASS(FTException) , POINTER :: e => NULL()
CLASS(FTLinkedList), POINTER :: ptr => NULL()
CLASS(FTObject) , POINTER :: obj => NULL()
TYPE (FTException) , POINTER :: e => NULL()
CLASS(FTException) , POINTER :: ePtr => NULL()

catchErrorWithName = .false.

Expand All @@ -725,7 +726,8 @@ LOGICAL FUNCTION catchErrorWithName(exceptionName)
obj => iterator % object()
CALL cast(obj,e)
IF ( e % exceptionName() == exceptionName ) THEN
CALL setCurrentError(e)
ePtr => e
CALL setCurrentError(ePtr)
catchErrorWithName = .true.
CALL errorStack % remove(obj)
EXIT
Expand Down Expand Up @@ -795,7 +797,9 @@ FUNCTION popLastException()
CALL initializeFTExceptions
ELSE
CALL errorStack % pop(obj)
IF(ASSOCIATED(obj)) CALL cast(obj,popLastException)
IF(ASSOCIATED(obj)) THEN
popLastException => exceptionFromObject(obj)
END IF
END IF

END FUNCTION popLastException
Expand All @@ -819,7 +823,7 @@ FUNCTION peekLastException()

peekLastException => NULL()
obj => errorStack % peek()
CALL cast(obj,peekLastException)
peekLastException => exceptionFromObject(obj)

END FUNCTION peekLastException
!
Expand All @@ -842,7 +846,7 @@ SUBROUTINE printAllExceptions
CALL iterator % setToStart
DO WHILE (.NOT.iterator % isAtEnd())
objectPtr => iterator % object()
CALL cast(objectPtr,e)
e => exceptionFromObject(objectPtr)
CALL e % printDescription(6)
CALL iterator % moveToNext()
END DO
Expand Down
6 changes: 3 additions & 3 deletions Source/FTObjects/FTLinkedListClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -579,7 +579,7 @@ END FUNCTION numberOfRecords
!
SUBROUTINE releaseFTLinkedList(self)
IMPLICIT NONE
CLASS (FTLinkedList), POINTER :: self
TYPE (FTLinkedList), POINTER :: self
CLASS(FTObject) , POINTER :: obj

IF(.NOT. ASSOCIATED(self)) RETURN
Expand Down Expand Up @@ -777,7 +777,7 @@ SUBROUTINE castObjectToLinkedList(obj,cast)
!
IMPLICIT NONE
CLASS(FTObject) , POINTER :: obj
CLASS(FTLinkedList), POINTER :: cast
TYPE (FTLinkedList), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down Expand Up @@ -941,7 +941,7 @@ END SUBROUTINE initWithFTLinkedList
SUBROUTINE releaseFTLinkedListIterator(self)
IMPLICIT NONE
TYPE(FTLinkedListIterator), POINTER :: self
CLASS(FTObject) , POINTER :: obj
CLASS(FTObject) , POINTER :: obj

IF(.NOT. ASSOCIATED(self)) RETURN

Expand Down
10 changes: 5 additions & 5 deletions Source/FTObjects/FTMultiIndexTable.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -124,8 +124,8 @@ SUBROUTINE castObjectToMultiIndexMatrixData(obj,cast)
! Cast the base class FTObject to the FTException class
! -----------------------------------------------------
!
CLASS(FTObject) , POINTER :: obj
CLASS(MultiIndexMatrixData), POINTER :: cast
CLASS(FTObject) , POINTER :: obj
TYPE (MultiIndexMatrixData), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down Expand Up @@ -380,7 +380,7 @@ FUNCTION objectInMultiIndexTableForKeys(self,keys) RESULT(r)
DO WHILE (ASSOCIATED(currentRecord))

obj => currentRecord % recordObject
CALL cast(obj,mData)
mData => MultiIndexMatrixDataCast(obj)
IF ( keysMatch(key1 = mData % key,key2 = orderedKeys) ) THEN
r => mData % object
EXIT
Expand Down Expand Up @@ -429,8 +429,8 @@ FUNCTION MultiIndexTableContainsKeys(self,keys) RESULT(r)
currentRecord => self % table(i) % head
DO WHILE (ASSOCIATED(currentRecord))

obj => currentRecord % recordObject
CALL cast(obj,mData)
obj => currentRecord % recordObject
mData => MultiIndexMatrixDataCast(obj)
IF ( keysMatch(key1 = mData % key,key2 = orderedKeys)) THEN
r = .TRUE.
EXIT
Expand Down
2 changes: 1 addition & 1 deletion Source/FTObjects/FTObjectArrayClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -487,7 +487,7 @@ SUBROUTINE castToMutableObjectArray(obj,cast)
!
IMPLICIT NONE
CLASS(FTObject) , POINTER :: obj
CLASS(FTMutableObjectArray), POINTER :: cast
TYPE (FTMutableObjectArray), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down
2 changes: 1 addition & 1 deletion Source/FTObjects/FTObjectClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@
!> SUBROUTINE castToSubclass(obj,cast)
!> IMPLICIT NONE
!> CLASS(FTObject), POINTER :: obj
!> CLASS(SubClass), POINTER :: cast
!> TYPE (SubClass), POINTER :: cast
!>
!> cast => NULL()
!> SELECT TYPE (e => obj)
Expand Down
8 changes: 4 additions & 4 deletions Source/FTObjects/FTSparseMatrixClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,7 @@ SUBROUTINE castObjectToMatrixData(obj,cast)
! -----------------------------------------------------
!
CLASS(FTObject) , POINTER :: obj
CLASS(MatrixData), POINTER :: cast
TYPE (MatrixData), POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down Expand Up @@ -382,7 +382,7 @@ FUNCTION objectInSparseMatrixForKeys(self,i,j) RESULT(r)
DO WHILE (.NOT.self % iterator % isAtEnd())

obj => self % iterator % object()
CALL cast(obj,mData)
mData => matrixDataCast(obj)
IF ( mData % key == j ) THEN
r => mData % object
EXIT
Expand Down Expand Up @@ -428,8 +428,8 @@ FUNCTION SparseMatrixContainsKeys(self,i,j) RESULT(r)
CALL self % iterator % setToStart()
DO WHILE (.NOT.self % iterator % isAtEnd())

obj => self % iterator % object()
CALL cast(obj,mData)
obj => self % iterator % object()
mData => matrixDataCast(obj)
IF ( mData % key == j ) THEN
r = .TRUE.
RETURN
Expand Down
2 changes: 1 addition & 1 deletion Source/FTObjects/FTValueClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -768,7 +768,7 @@ SUBROUTINE castToValue(obj,cast)
!
IMPLICIT NONE
CLASS(FTObject), POINTER :: obj
CLASS(FTValue) , POINTER :: cast
TYPE (FTValue) , POINTER :: cast

cast => NULL()
SELECT TYPE (e => obj)
Expand Down
6 changes: 3 additions & 3 deletions Source/FTObjects/FTValueDictionaryClass.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -410,8 +410,8 @@ SUBROUTINE castDictionaryToValueDictionary(dict,valueDict)
! -----------------------------------------------------
!
IMPLICIT NONE
CLASS(FTDictionary) , POINTER :: dict
CLASS(FTValueDictionary), POINTER :: valueDict
CLASS (FTDictionary) , POINTER :: dict
TYPE (FTValueDictionary), POINTER :: valueDict

valueDict => NULL()
SELECT TYPE (dict)
Expand All @@ -432,8 +432,8 @@ SUBROUTINE castObjectToValueDictionary(obj,valueDict)
! -----------------------------------------------------------
!
IMPLICIT NONE
CLASS(FTValueDictionary), POINTER :: valueDict
CLASS(FTObject) , POINTER :: obj
TYPE (FTValueDictionary), POINTER :: valueDict

valueDict => NULL()
SELECT TYPE (obj)
Expand Down
2 changes: 1 addition & 1 deletion Testing/Tests/DataTests.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ SUBROUTINE DataTests
IMPLICIT NONE

CHARACTER(LEN=1), ALLOCATABLE :: enc(:)
CLASS(FTData) , POINTER :: dat, datPtr
TYPE (FTData) , POINTER :: dat, datPtr
CLASS(FTObject) , POINTER :: obj
CHARACTER(LEN=1), POINTER :: storedDat(:)
CHARACTER(LEN=11) :: outString
Expand Down
2 changes: 1 addition & 1 deletion Testing/Tests/DictionaryTests.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ SUBROUTINE FTDictionaryClassTests
USE FTAssertions
IMPLICIT NONE

CLASS(FTDictionary) , POINTER :: dict, dictFromObj
TYPE (FTDictionary) , POINTER :: dict, dictFromObj
CLASS(FTObject) , POINTER :: obj
TYPE (FTValue) , POINTER :: v
TYPE (FTMutableObjectArray) , POINTER :: storedObjects
Expand Down
33 changes: 20 additions & 13 deletions Testing/Tests/ExceptionTests.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ FUNCTION testException()
USE FTExceptionClass
USE FTValueDictionaryClass
IMPLICIT NONE
CLASS(FTException) , POINTER :: testException
TYPE (FTException) , POINTER :: testException
TYPE (FTValueDictionary), POINTER :: userDictionary
CLASS(FTDictionary) , POINTER :: ptr
REAL :: r = 3.1416
Expand Down Expand Up @@ -71,9 +71,11 @@ SUBROUTINE subroutineThatThrowsError
IMPLICIT NONE

TYPE (FTException) , POINTER :: exception
CLASS(FTException) , POINTER :: ePtr

exception => testException()
CALL throw(exception)
ePtr => exception
CALL throw(ePtr)
CALL releaseFTException(exception)

END SUBROUTINE subroutineThatThrowsError
Expand All @@ -86,11 +88,12 @@ SUBROUTINE FTExceptionClassTests
USE FTAssertions
IMPLICIT NONE

CLASS(FTException) , POINTER :: e, ePtr
CLASS(FTDictionary) , POINTER :: d
CLASS(FTValueDictionary), POINTER :: userDictionary
CLASS(FTValue) , POINTER :: vGood, vBad
CLASS(FTObject) , POINTER :: obj
TYPE(FTException) , POINTER :: e, ePtr
CLASS(FTException) , POINTER :: eClassPtr
CLASS(FTDictionary) , POINTER :: d
TYPE(FTValueDictionary), POINTER :: userDictionary
CLASS(FTValue) , POINTER :: vGood, vBad
CLASS(FTObject) , POINTER :: obj
REAL :: r
CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) :: msg
REAL :: singleTol = 2*EPSILON(1.0e0)
Expand All @@ -111,15 +114,17 @@ SUBROUTINE FTExceptionClassTests
CALL FTAssertEqual(expectedValue = FT_ERROR_WARNING, &
actualValue = e % severity(), &
msg = "Warning error level match")
CALL throw(e)
eClassPtr => e
CALL throw(eClassPtr)
CALL releaseFTException(e)

ALLOCATE(e)
CALL e % initFatalException(msg = "I'm Sorry, I can't do that Dave (Designed Uncaught)")
CALL FTAssertEqual(expectedValue = FT_ERROR_FATAL, &
actualValue = e % severity(), &
msg = "Fatal error level match")
CALL throw(e)
eClassPtr => e
CALL throw(eClassPtr)
CALL releaseFTException(e)

ALLOCATE(e)
Expand All @@ -131,8 +136,10 @@ SUBROUTINE FTExceptionClassTests
expectedValueObject = vGood, &
ObservedValueObject = vBad, &
level = FT_ERROR_WARNING)
CALL releaseFTValue(vBad)
CALL releaseFTValue(vGood)
obj => vBad
CALL release(obj)
obj => vGood
CALL release(obj)

CALL FTAssertEqual(expectedValue = FT_ERROR_WARNING, &
actualValue = e % severity(), &
Expand All @@ -157,11 +164,11 @@ SUBROUTINE FTExceptionClassTests
obj => e
CALL cast(obj,ePtr)
CALL FTAssert(ASSOCIATED(ePtr),msg = "Test casting of exception")
ePtr => NULL()
ePtr => exceptionFromObject(obj)
CALL FTAssert(ASSOCIATED(ePtr),msg = "Test casting of exception by function")

CALL throw(e)
eClassPtr => e
CALL throw(eClassPtr)
CALL releaseFTException(e)
!
! -----------------------------
Expand Down
Loading
Loading