Scanner error messages

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
 

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

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,16 +61,15 @@ 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
 !     -------------------------------------------------------------
 !
       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)
 

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 )