From f0a016c6ca2fec164d2724a24b57e94e625803bd Mon Sep 17 00:00:00 2001 From: David Kopriva Date: Thu, 13 Aug 2026 11:14:59 -0700 Subject: [PATCH 1/4] Add Connection format check Add procedures and their tests to check for the proper formatting for the "connect" keword in the chain definitions. --- Source/IO/FileAndStringProcessing.f90 | 29 ++++++++++ Source/IO/SMScanner.f90 | 20 +++---- Source/IO/Scanning.f90 | 81 ++++++++++++++++++++++++++- Source/Testing/MeshingTests.f90 | 45 ++++++++++++++- Source/Testing/ScannerTests.f90 | 35 ++++++++++++ 5 files changed, 195 insertions(+), 15 deletions(-) diff --git a/Source/IO/FileAndStringProcessing.f90 b/Source/IO/FileAndStringProcessing.f90 index 4993b3d6..338051db 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 whitespace, ' ', in a string while destroying +! the string. +! ------------------------------------------------------ +! + 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..91ca588c 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 @@ -173,7 +173,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 +271,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/Testing/MeshingTests.f90 b/Source/Testing/MeshingTests.f90 index c049c198..94f1039b 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 scatch 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 From c5f7fd5779f1046c6859d28d042ca180c05cc0d1 Mon Sep 17 00:00:00 2001 From: David Kopriva Date: Thu, 13 Aug 2026 12:44:32 -0700 Subject: [PATCH 2/4] New reporting of connect errors Add checking of the connect format string before scanning for breaks. Post an exception if there is a problem, otherwise using the default segmentation. --- Source/IO/Scanning.f90 | 32 +++++------------------ Source/Project/Model/SMModel.f90 | 44 ++++++++++++++++++++++++++------ 2 files changed, 42 insertions(+), 34 deletions(-) diff --git a/Source/IO/Scanning.f90 b/Source/IO/Scanning.f90 index 91ca588c..4634467a 100644 --- a/Source/IO/Scanning.f90 +++ b/Source/IO/Scanning.f90 @@ -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 diff --git a/Source/Project/Model/SMModel.f90 b/Source/Project/Model/SMModel.f90 index e7a95755..01ea4231 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 ) From 13fe84a80fd1d7a27bd57f571b79591ba136f6cc Mon Sep 17 00:00:00 2001 From: David Kopriva Date: Thu, 13 Aug 2026 13:05:23 -0700 Subject: [PATCH 3/4] Update MeshingTests.f90 Fix spelling --- Source/Testing/MeshingTests.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Source/Testing/MeshingTests.f90 b/Source/Testing/MeshingTests.f90 index 94f1039b..85ac4210 100644 --- a/Source/Testing/MeshingTests.f90 +++ b/Source/Testing/MeshingTests.f90 @@ -424,9 +424,9 @@ SUBROUTINE MiscTests IMPLICIT NONE INTEGER :: iUnit, s ! -! ------------------------------------------------------------------ -! Test printing the help message that the scatch file actually opens -! ------------------------------------------------------------------ +! ------------------------------------------------------------------- +! 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") From 8a6be1d29f42f976969ce9aa8a0c2a9366fbe72c Mon Sep 17 00:00:00 2001 From: Andrew Winters Date: Sat, 15 Aug 2026 20:22:02 +0200 Subject: [PATCH 4/4] update comment --- Source/IO/FileAndStringProcessing.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Source/IO/FileAndStringProcessing.f90 b/Source/IO/FileAndStringProcessing.f90 index 338051db..198d301b 100644 --- a/Source/IO/FileAndStringProcessing.f90 +++ b/Source/IO/FileAndStringProcessing.f90 @@ -280,28 +280,28 @@ END SUBROUTINE ConvertToPath ! SUBROUTINE RemoveWhitespace(str) ! -! ------------------------------------------------------ -! Removes whitespace, ' ', in a string while destroying -! the string. -! ------------------------------------------------------ +! ------------------------------------------------------------ +! 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