diff --git a/Source/IO/FileAndStringProcessing.f90 b/Source/IO/FileAndStringProcessing.f90 index 4993b3d6..198d301b 100644 --- a/Source/IO/FileAndStringProcessing.f90 +++ b/Source/IO/FileAndStringProcessing.f90 @@ -275,4 +275,33 @@ SUBROUTINE ConvertToPath(str) END IF END SUBROUTINE ConvertToPath +! +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE RemoveWhitespace(str) +! +! ------------------------------------------------------------ +! Removes all space characters, ' ', from the string in place. +! The remainder of the string is filled with blanks. +! ------------------------------------------------------------ +! + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(INOUT) :: str + INTEGER :: i, j, n + + n = LEN(str) + j = 1 + + DO i = 1, n + IF (str(i:i) /= ' ') THEN + str(j:j) = str(i:i) + j = j + 1 + END IF + END DO + + ! Fill the remainder with blanks + IF (j <= n) str(j:n) = ' ' + + END SUBROUTINE RemoveWhitespace diff --git a/Source/IO/SMScanner.f90 b/Source/IO/SMScanner.f90 index 65c8e62f..95230985 100644 --- a/Source/IO/SMScanner.f90 +++ b/Source/IO/SMScanner.f90 @@ -10,7 +10,7 @@ !> Usage: !> !> Initialization -!> self % initWithString(str, delims) +!> self % initScannerWithString(str, delims) !> !> str is the string to be scanned !> delims is a string of the delimiters, e.g. "[,]" to delimit @@ -47,7 +47,7 @@ !> !> CHARACTER(LEN = 12) :: str = "[124, 2.718]" !> CHARACTER(LEN=3) :: dlms = "[]," -!> CALL scanner % initWithString(str,dlms) +!> CALL scanner % initScannerWithString(str,dlms) !> done = scanner % scanUpToString("[") !> intResult = scanner % scanInt() ! = 124 !> realResult = scanner % scanReal() ! = 2.178 @@ -71,7 +71,7 @@ Module SMScannerClass CONTAINS ! ======== ! - PROCEDURE :: initWithString + PROCEDURE :: initScannerWithString PROCEDURE :: reset PROCEDURE :: scanUpToString PROCEDURE :: scanInt @@ -90,7 +90,7 @@ Module SMScannerClass ! !//////////////////////////////////////////////////////////////////////// ! - SUBROUTINE initWithString(self, str, delims) + SUBROUTINE initScannerWithString(self, str, delims) IMPLICIT NONE CLASS(SMScanner) :: self CHARACTER(LEN=*) :: str @@ -103,7 +103,7 @@ SUBROUTINE initWithString(self, str, delims) self % endPos = LEN_TRIM(str) self % delm = "" - END SUBROUTINE initWithString + END SUBROUTINE initScannerWithString ! !//////////////////////////////////////////////////////////////////////// ! @@ -330,7 +330,7 @@ LOGICAL FUNCTION scanUpToTest() scanUpToTest = .TRUE. - CALL scanner % initWithString(str,dlms) + CALL scanner % initScannerWithString(str,dlms) done = scanner % scanUpToString("[") IF(done) scanUpToTest = .FALSE. scanUpToTest = scanUpToTest .AND. scanner % cursorPos == p(1) @@ -361,7 +361,7 @@ LOGICAL FUNCTION scanTest() INTEGER :: intResult REAL(KIND(1.0d0)) :: realResult - CALL scanner % initWithString(str,dlms) + CALL scanner % initScannerWithString(str,dlms) done = scanner % scanUpToString("[") scanTest = .NOT.done ! @@ -426,7 +426,7 @@ LOGICAL FUNCTION scanTest() ! Failures ! -------- ! - CALL scanner % initWithString(str2,dlms) + CALL scanner % initScannerWithString(str2,dlms) done = scanner % scanUpToString("[") scanTest = .NOT.done ! @@ -472,7 +472,7 @@ LOGICAL FUNCTION scanArrayTest() ! Test success ! ------------ ! - CALL scanner % initWithString(str,dlms) + CALL scanner % initScannerWithString(str,dlms) done = scanner % scanUpToString("=") scanArrayTest = .NOT.done IF(done) RETURN @@ -485,7 +485,7 @@ LOGICAL FUNCTION scanArrayTest() ! Test failure ! ------------ ! - CALL scanner % initWithString(failStr,dlms) + CALL scanner % initScannerWithString(failStr,dlms) done = scanner % scanUpToString("=") scanArrayTest = scanArrayTest .AND. .NOT.done IF(done) RETURN diff --git a/Source/IO/Scanning.f90 b/Source/IO/Scanning.f90 index ae8f0d8d..4634467a 100644 --- a/Source/IO/Scanning.f90 +++ b/Source/IO/Scanning.f90 @@ -12,7 +12,7 @@ Module ScanningModule USE SMScannerClass IMPLICIT NONE PRIVATE - PUBLIC :: ScanForBreaks, ScanForBreaksIsOK, flaggingIsOK + PUBLIC :: ScanForBreaks, ScanForBreaksIsOK, flaggingIsOK, connectFormatCheck ! ! ======== CONTAINS @@ -61,7 +61,7 @@ SUBROUTINE ScanForBreaks(connectionString, breaks, nSegments) REAL(KIND=RP) :: c flagged = 0 - CALL scanner % initWithString(connectionString,delims = ",-") + CALL scanner % initScannerWithString(connectionString,delims = ",-") ! ! ------------------------------------------------------------- ! Flag the locations (with a 1) where breaks will NOT be placed @@ -69,8 +69,7 @@ SUBROUTINE ScanForBreaks(connectionString, breaks, nSegments) ! CALL flagSegments(scanner, flagged, flagCount, 1, fail) IF ( fail ) THEN - WRITE(0,*) "Scanning of the following connection lines failed with a syntax error" - WRITE(0,*) TRIM(connectionString) + WRITE(0,*) "Error in connectionString: ", TRIM(connectionString) RETURN END IF @@ -98,6 +97,9 @@ SUBROUTINE flagSegments(scanner, flagged, flagCount, flagOn, fail ) ! in the form of start-stop, e.g. 4-6, separated by commas. Set ! the entry in the array flagged to flagOn for each element of each group ! For this procedure, the scanner must include "-" and "," as the delimiters. +! +! BEFORE CALLING THIS PROCEDURE, ENSURE THAT connectFormatCheck HAS BEEN +! CALLED ON THE SCANNER'S STRING. NO FORMAT CHECKING IS DONE HERE. ! ----------------------------------------------------------------------- ! IMPLICIT NONE @@ -131,35 +133,13 @@ SUBROUTINE flagSegments(scanner, flagged, flagCount, flagOn, fail ) ! ------------------------ ! strt = scanInt(scanner) -! -! --------------------------------------------------- -! The delimiter that stops this scan must be a "-" or -! there is an error in the string -! --------------------------------------------------- -! - IF ( scanner % lastDelimiter() .NE. "-" ) THEN - WRITE(0,*) "String start configuration error" - fail = .TRUE. - RETURN - END IF - - stp = scanInt(scanner) -! -! -------------------------------------------------------- -! After the integer is scanned, the next delimiter must be -! either a comma or an end of string. It cannot be a "-" -! -------------------------------------------------------- -! - IF ( scanner % lastDelimiter() .EQ. "-") THEN - WRITE(0,*) "String stop configuration error" - fail = .TRUE. - RETURN - END IF + stp = scanInt(scanner) ! ! -------------------------------------------------------- ! At the end of the string, we don't flag the last segment ! -------------------------------------------------------- ! + stp = MIN(stp,fSize) DO k = strt, stp-1 flagged(k) = flagOn flagCount = flagCount + 1 @@ -173,7 +153,82 @@ SUBROUTINE flagSegments(scanner, flagged, flagCount, flagOn, fail ) END DO END SUBROUTINE flagSegments +! +!//////////////////////////////////////////////////////////////////////// +! + LOGICAL FUNCTION connectFormatCheck(str) +! +! --------------------------------------------------------------- +! Takes a string and checks to see if it is in the format +! integer-integer[,integer-integer,...] +! where the first integer in each sequence is always to be +! less than the second. Returns false if the format is incorrect. +! --------------------------------------------------------------- +! + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: str + INTEGER :: i, n, first, second + INTEGER :: start_pos, end_pos + + connectFormatCheck = .FALSE. + n = LEN_TRIM(str) + + IF (n == 0) RETURN + + i = 1 + + DO + ! Read first integer + start_pos = i + + IF (i > n) RETURN + IF (str(i:i) < '0' .OR. str(i:i) > '9') RETURN + + DO WHILE (i <= n) + IF (str(i:i) < '0' .OR. str(i:i) > '9') EXIT + i = i + 1 + END DO + + READ(str(start_pos:i-1), *) first + + ! Require '-' + IF (i > n) RETURN + IF (str(i:i) /= '-') RETURN + i = i + 1 + + ! Read second integer + end_pos = i + + IF (i > n) RETURN + IF (str(i:i) < '0' .OR. str(i:i) > '9') RETURN + + DO WHILE (i <= n) + IF (str(i:i) < '0' .OR. str(i:i) > '9') EXIT + i = i + 1 + END DO + + READ(str(end_pos:i-1), *) second + + ! First integer must be less than second + IF (first >= second) RETURN + + ! End of string: valid + IF (i > n) THEN + connectFormatCheck = .TRUE. + RETURN + END IF + + ! Otherwise require ',' + IF (str(i:i) /= ',') RETURN + i = i + 1 + + ! Comma must be followed by another range + IF (i > n) RETURN + END DO + + END FUNCTION connectFormatCheck ! !//////////////////////////////////////////////////////////////////////// ! @@ -196,7 +251,7 @@ LOGICAL FUNCTION flagString(str, flagged, flagCount) LOGICAL :: fail flagged = 0 - CALL scanner % initWithString(str,delims = ",-") + CALL scanner % initScannerWithString(str,delims = ",-") CALL flagSegments(scanner, flagged, flagCount, 1, fail) diff --git a/Source/Project/Model/SMModel.f90 b/Source/Project/Model/SMModel.f90 index 267f97aa..c971a104 100644 --- a/Source/Project/Model/SMModel.f90 +++ b/Source/Project/Model/SMModel.f90 @@ -574,7 +574,7 @@ SUBROUTINE SetChainOptimizationParameters(curveChain, curveDict) ! CHARACTER(LEN=DEFAULT_CHARACTER_LENGTH) :: str INTEGER , PARAMETER :: DONT_SKIP = 0, SKIP = 1 - INTEGER :: j + TYPE(FTException), POINTER :: e ! curveChain % optimization = NONE IF ( curveDict % containsKey(CHAIN_OPTIMIZATION_KEY) ) THEN @@ -634,20 +634,48 @@ SUBROUTINE SetChainOptimizationParameters(curveChain, curveDict) curveChain % breaks = [0.0_RP, 1.0_RP] ELSE str = curveDict % stringValueForKey(CHAIN_BREAKS_KEY) - CALL ScanForBreaks(str, curveChain % breaks, curveChain % COUNT() ) + CALL RemoveWhitespace(str) + + IF ( .NOT.connectFormatCheck(str) ) THEN +! +! -------------------------------------------------------------- +! Ill-formed connect string. Post a warning exception and ignore +! -------------------------------------------------------------- +! + ALLOCATE(e) + CALL e % initWarningException("Format Error in connect statement:" // TRIM(str)//". Ignoring.") + CALL throw(e) + CALL releaseFTException(e) + CALL SetDefaultBreaks(curveChain) + ELSE + + CALL ScanForBreaks(str, curveChain % breaks, curveChain % COUNT() ) + + END IF END IF ELSE - IF ( curveChain % COUNT() == 1 ) THEN ! No breaks if there is only one curve - curveChain % breaks = [0.0_RP, 1.0_RP] - ELSE ! Break all curves - ALLOCATE(curveChain % breaks(0:curveChain % COUNT())) - curveChain % breaks = [(REAL(j,RP)/REAL(curveChain % COUNT(), RP),j=0,curveChain % COUNT())] - END IF + CALL SetDefaultBreaks(curveChain) END IF END IF END SUBROUTINE SetChainOptimizationParameters ! +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE SetDefaultBreaks(curveChain) + IMPLICIT NONE + CLASS(SMChainedCurve), POINTER :: curveChain + INTEGER :: j + + IF ( curveChain % COUNT() == 1 ) THEN ! No breaks if there is only one curve + curveChain % breaks = [0.0_RP, 1.0_RP] + ELSE ! Break all curves + ALLOCATE(curveChain % breaks(0:curveChain % COUNT())) + curveChain % breaks = [(REAL(j,RP)/REAL(curveChain % COUNT(), RP),j=0,curveChain % COUNT())] + END IF + + END SUBROUTINE SetDefaultBreaks +! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE ConstructCurve( self, chain, curveDict ) diff --git a/Source/Testing/MeshingTests.f90 b/Source/Testing/MeshingTests.f90 index c049c198..85ac4210 100644 --- a/Source/Testing/MeshingTests.f90 +++ b/Source/Testing/MeshingTests.f90 @@ -423,10 +423,51 @@ SUBROUTINE MiscTests USE FTAssertions IMPLICIT NONE INTEGER :: iUnit, s - +! +! ------------------------------------------------------------------- +! Test printing the help message that the scratch file actually opens +! ------------------------------------------------------------------- +! OPEN(NEWUNIT = iUnit, STATUS='SCRATCH', IOSTAT = s) CALL FTAssertEqual(expectedValue = 0,actualValue = s,msg = "Scratch file not opening") CALL PrintHelpMessage(iUnit) CLOSE(iUnit) - +! +! ------------------------------- +! Add test for whitespace removal +! ------------------------------- +! + CALL test_RemoveWhitespace() + END SUBROUTINE MiscTests +! +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE test_RemoveWhitespace() + USE TestSuiteManagerClass + USE FTAssertions + IMPLICIT NONE + + CHARACTER(LEN=30) :: str + + str = '1 - 10, 20 - 30' + CALL RemoveWhitespace(str) + CALL FTAssert(TRIM(str) == '1-10,20-30',"WHITESPACE TEST FAILED: basic whitespace") + + str = ' 1-10 ' + CALL RemoveWhitespace(str) + CALL FTAssert(TRIM(str) == '1-10',"WHITESPACE TEST FAILED: leading/trailing whitespace") + + str = '1 - 10, 20 - 30' + CALL RemoveWhitespace(str) + CALL FTAssert(TRIM(str) == '1-10,20-30',"WHITESPACE TEST FAILED: multiple spaces") + + str = '1-10' + CALL RemoveWhitespace(str) + CALL FTAssert(TRIM(str) == '1-10',"WHITESPACE TEST FAILED: no whitespace") + + str = ' ' + CALL RemoveWhitespace(str) + CALL FTAssert(LEN_TRIM(str) == 0,"WHITESPACE TEST FAILED: all whitespace") + + END SUBROUTINE test_RemoveWhitespace diff --git a/Source/Testing/ScannerTests.f90 b/Source/Testing/ScannerTests.f90 index 363134b1..7484a2e4 100644 --- a/Source/Testing/ScannerTests.f90 +++ b/Source/Testing/ScannerTests.f90 @@ -19,4 +19,39 @@ SUBROUTINE ScannerTests CALL FTAssert(ScanForBreaksIsOK(),msg = "Scan for breaks test failure") CALL FTAssert(flaggingIsOK(),msg = "Scan for flagging test failure") + CALL test_connectFormatCheck() + END SUBROUTINE ScannerTests +! +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE test_connectFormatCheck() + USE SMScannerClass + USE ScanningModule + USE FTAssertions + IMPLICIT NONE +! +! ----------- +! Should pass +! ----------- +! + CALL FTAssert(connectFormatCheck('1-10') ,msg = 'CONNECT FORMAT TEST FAILED: 1-10') + CALL FTAssert(connectFormatCheck('1-10,20-30'),msg = 'CONNECT FORMAT TEST FAILED: 1-10,20-30') + CALL FTAssert(connectFormatCheck('1-10,20-30'),msg = 'CONNECT FORMAT TEST FAILED: 1-10,20-30,40-5') + CALL FTAssert(connectFormatCheck('0-1') ,msg = 'CONNECT FORMAT TEST FAILED: 0-1') +! +! ----------- +! Should fail +! ----------- +! + CALL FTAssert(.NOT.connectFormatCheck('1-10,30-20'),msg = 'CONNECT FORMAT TEST FAILED: 1-10,30-20 invalid second range') + CALL FTAssert(.NOT.connectFormatCheck('10-1') ,msg = 'CONNECT FORMAT TEST FAILED: 10-1 should be invalid') + CALL FTAssert(.NOT.connectFormatCheck('1') ,msg = 'CONNECT FORMAT TEST FAILED: missing second integer') + CALL FTAssert(.NOT.connectFormatCheck('1-') ,msg = 'CONNECT FORMAT TEST FAILED: missing second integer') + CALL FTAssert(.NOT.connectFormatCheck('-10') ,msg = 'CONNECT FORMAT TEST FAILED: negative integer') + CALL FTAssert(.NOT.connectFormatCheck('1-10,') ,msg = 'CONNECT FORMAT TEST FAILED: trailing comma') + CALL FTAssert(.NOT.connectFormatCheck('1-10,,20-30'),msg = 'CONNECT FORMAT TEST FAILED: consecutive commas') + CALL FTAssert(.NOT.connectFormatCheck('1-10,abc-20'),msg = 'CONNECT FORMAT TEST FAILED: non-numeric value') + CALL FTAssert(.NOT.connectFormatCheck('') ,msg = 'CONNECT FORMAT TEST FAILED: empty string') + + END SUBROUTINE test_connectFormatCheck