Before we begin, we notice that RESOUT requires the output unit number. So, we are going to have to write
ASRTT(RESULT, OUTPUT)
That gets intrusive pretty quickly. Let's pull the output unit out, into a COMMON block named OUTP:
C
C
PROGRAM MAIN
COMMON /OUTP/KOUT
INTEGER KOUT
...
STOP
END
...
C
C SUBROUTINE RESOUT
C WRITES OUT THE RESULT OF THE TEST
C '.' IF THE ARGUMENT IS .TRUE.
C 'F' OTHERWISE
C PARAM - LOGICAL *RESLT* WHETHER OR NOT THE TEST HAS PASSED
SUBROUTINE RESOUT(RESLT)
COMMON /OUTP/KOUT
INTEGER KOUT
LOGICAL RESLT
INTEGER RESCHR
INTEGER CHARA
CHARA = RESCHR(RESLT)
WRITE(KOUT, 100) CHARA
100 FORMAT(A1, $)
RETURN
END
We only include the block in the routines what need access to it, effectively limiting its scope. Now we can write assertions along the following lines:
LOGICAL TEST
...
TEST = .TRUE.
...
CALL ASRTT(TEST)
...
which is much more natural.
With the refactoring done, we begin with the test for assert true (ASRTT). The test code is pretty simple:
C
C TEST CASE FOR ASRTT, THE ASSERTION THAT THE ARGUMENT IS TRUE
SUBROUTINE TASRTT()
COMMON /OUTP/KOUT
EXTERNAL ASRTT
INTEGER KOUT
INTEGER I
INTEGER OUTPUT
INTEGER EXPECT
INTEGER RESULT
INTEGER KTEMP
DIMENSION RESULT(2)
DIMENSION EXPECT(2)
DATA (EXPECT(I), I= 1, 2)/1H., 1HF/, OUTPUT/10/
KTEMP = KOUT
KOUT = OUTPUT
OPEN(UNIT = OUTPUT, STATUS = 'SCRATCH')
CALL ASRTT(.TRUE.)
CALL ASRTT(.FALSE.)
REWIND(OUTPUT)
READ(OUTPUT, 100) (RESULT(I), I = 1, 2)
CLOSE(OUTPUT)
100 FORMAT(2A1)
DO 600 I = 1, 2
IF (EXPECT(I) .EQ. result(I)) GO TO 300
WRITE(KTEMP, 200)
200 FORMAT(1HF, $)
GO TO 500
300 CONTINUE
WRITE(KTEMP, 400) IPASS
400 FORMAT(1H., $)
500 CONTINUE
600 CONTINUE
KOUT = KTEMP
RETURN
END
This is essentially a repeat of the test we developed for RESOUT. Making the test pass simply requires a call to RESOUT.
C
C BASIC ASSERT_TRUE
C
C PARAM: LOGICAL TSTVAL THE VALUE TO BE TESTED
C PARAM: INTEGER OUTPUT THE UNIT TO WRITE THE RESULT TO
SUBROUTINE ASRTT(TSTVAL)
LOGICAL TSTVAL
CALL RESOUT(TSTVAL, OUTPUT)
RETURN
END
The test for ASRTF is the same, with the sole exception that the elements of EXPECT array are reversed.
C
C TEST CASE FOR ASRTF, THE ASSERTION THAT THE ARGUMENT IS TRUE
SUBROUTINE TASRTF()
COMMON /OUTP/KOUT
EXTERNAL ASRTT
INTEGER KOUT
INTEGER I
INTEGER OUTPUT
INTEGER EXPECT
INTEGER RESULT
INTEGER KTEMP
DIMENSION RESULT(2)
DIMENSION EXPECT(2)
DATA (EXPECT(I), I= 1, 2)/1H., 1HF/, OUTPUT/10/
KTEMP = KOUT
KOUT = OUTPUT
OPEN(UNIT = OUTPUT, STATUS = 'SCRATCH')
CALL ASRTF(.TRUE.)
CALL ASRTF(.FALSE.)
REWIND(OUTPUT)
READ(OUTPUT, 100) (RESULT(I), I = 1, 2)
CLOSE(OUTPUT)
100 FORMAT(2A1)
DO 600 I = 1, 2
IF (EXPECT(I) .EQ. RESULT(I)) GO TO 300
WRITE(KOUT, 200)
200 FORMAT(1HF, $)
GO TO 500
300 CONTINUE
WRITE(KOUT, 400) IPASS
400 FORMAT(1H., $)
500 CONTINUE
600 CONTINUE
KOUT = KTEMP
RETURN
END
Making the test pass involves simply negating the argument and passing it to ASRTT.
C
C BASIC ASSERT_FALSE
C
C PARAM: LOGICAL TSTVAL THE VALUE TO BE TESTED
C PARAM: INTEGER OUTPUT THE UNIT TO WRITE THE RESULT TO
SUBROUTINE ASRTF(TSTVAL)
LOGICAL TSTVAL
CALL ASRTT(.NOT. TSTVAL)
RETURN
END
At this point we have repeated the code to set the output unit, set our expectations, and read the results back in 3 times. This is a major violation of the DRY principle, and so we really should refactor the code to remove the duplication. We will make a note to fix that next time.
As a second point, we really would like to drop the writing and reading back in part of the tests. We tested that as part of RESOUT; it seems foolish to keep testing it. Instead, let's factor out the common functionality into the the test for RESOUT, and just call that for each of our assertions. Our main logic will reside in a set of LOGICAL functions, that can be tested separately. The basis of each function name will be EQUAL, with the prefix letter that indicates the type of the argument:
The tests verify that 2 integers are equal return .TRUE., and two that are not equal return .FALSE. We then make use of the functionality that we have created already in RESCHR and RESOUT. The code to make these pass is simple:
The test for LOGICAL variables is similarly simple:
- IEQUAL - compares 2 INTEGER values
- LEQUAL - compares 2 LOGICAL values
- AEQUAL - compares 2 REAL values
- DEQUAL - compares 2 DOUBLE PRECISION values
- CEQUAL - compares 2 COMPLEX values
C
C TESTS THE FUNCTIONING OF THE INTEGER COMPARISON,
C LOGICAL FUNCTION IEQUAL
SUBROUTINE TESTI()
LOGICAL IEQUAL
CALL ASRTT(IEQUAL(1, 1))
CALL ASRTF(IEQUAL(1, 2))
RETURN
END
C
C DETERMINE IF TWO INTEGERS ARE EQUAL:
C
C INPUT EXPECT (INTEGER) - THE EXPECTED VALUE
C INPUT ACTUAL (INTEGER) - THE VALUE TO BE COMPARED TO EXPECT
C OUTPUT EXPECT .EQ. ACTUAL
LOGICAL FUNCTION IEQUAL(EXPECT, ACTUAL)
INTEGER EXPECT
INTEGER ACTUAL
IEQUAL = EXPECT .EQ. ACTUAL
END
The test for LOGICAL variables is similarly simple:
C
C TESTS THE FUNCTIONING OF THE LOGICAL COMPARISON,
C LOGICAL FUNCTION LEQUAL
SUBROUTINE TESTL()
LOGICAL LEQUAL
CALL ASRTT(LEQUAL(.TRUE., .TRUE.))
CALL ASRTT(LEQUAL(.FALSE., .FALSE.))
CALL ASRTF(LEQUAL(.TRUE., .FALSE.))
CALL ASRTF(LEQUAL(.FALSE., .TRUE.))
RETURN
END
C
C DETERMINE IF TWO LOGICALS ARE EQUIVALENT:
C
C INPUT EXPECT (LOGICAL) - THE EXPECTED VALUE
C INPUT ACTUAL (LOGICAL) - THE VALUE TO BE COMPARED TO EXPECT
C OUTPUT EXPECT .EQ. ACTUAL
C
C NOTE: BECAUSE F77 WANTS ".EQV." INSTEAD OF
C THE F66 ".EQ." WHEN COMPARING LOGICALS, THE
C COMPARISON IS WRITTEN IN A SOMEWHAT CONVOLUTED WAY
LOGICAL FUNCTION LEQUAL(EXPECT, ACTUAL)
LOGICAL EXPECT
LOGICAL ACTUAL
LEQUAL = (EXPECT .AND. ACTUAL) .OR.
& (.NOT. EXPECT .AND. .NOT. ACTUAL)
END
As the comment indicates, there is one slight complication. FORTRAN 77 prefers the use of the .EQV. relation for comparing two LOGICAL variables. To silence the compiler warnings (from g77), the routine is written in the current, somewhat unintuitive way.
For the comparison of REALs,there is a slight twist. Floating point arithmetic is imprecise, and so the exact comparison of 2 floating point numbers (REAL, DOUBLE PRCISION, or COMPLEX) is a bad idea; we may get two comparisons that should be equal that are not. For example:
C
C DEMONSTRATION OF FLOATING POINT
PROGRAM COMP
REAL ONE
REAL THIRD
REAL THREE
LOGICAL RESULT
ONE = 1.0
THIRD = 1.0 / 3.0
WRITE (6, 100) ONE, THIRD
100 FORMAT(6HONE = , F15.10, 1X, 13H 1.0 / 3.0 = , F15.10)
THREE = THIRD * 3.0
WRITE (6, 200) THIRD
200 FORMAT(20H 3.0 * (1.0 / 3.0) = , F15.10)
RESULT = ONE .EQ. THIRD
WRITE (6, 300) RESULT
300 FORMAT(32H 1.0 .EQ. (3.0 * (1.0 / 3.0)) = ,L1)
STOP
END
ONE = 1.0000000000 1.0 / 3.0 = 0.3333333433
3.0 * (1.0 / 3.0) = 0.3333333433
1.0 .EQ. (3.0 * (1.0 / 3.0)) = F
To account for this, xUnit framework assertions for floating point values add a third parameter, the positive value EPSILN. If the two values are within EPSILN of each others, the assertion returns true. Otherwise, it is false. This gives us the test cases for AEQUAL and DEQUAL:
C
C TESTS THE FUNCTIONING OF THE COMPARISON OF REALS,
C LOGICAL FUNCTION AEQUAL
SUBROUTINE TESTA()
LOGICAL AEQUAL
REAL EXPECT
REAL ACTUL1
REAL ACTUL2
REAL ACTUL3
REAL EPS1
REAL EPS2
DATA EXPECT/1.0/, ACTUL1/1.0/, ACTUL2/1.00001/, ACTUL3/0.99999/
DATA EPS1/1.E-1/, EPS2/1.E-7/
CALL ASRTT(AEQUAL(EXPECT, ACTUL1, EPS1))
CALL ASRTT(AEQUAL(EXPECT, ACTUL1, EPS2))
CALL ASRTT(AEQUAL(EXPECT, ACTUL2, EPS1))
CALL ASRTF(AEQUAL(EXPECT, ACTUL2, EPS2))
CALL ASRTT(AEQUAL(EXPECT, ACTUL3, EPS1))
CALL ASRTF(AEQUAL(EXPECT, ACTUL3, EPS2))
RETURN
END
C
C TESTS THE FUNCTIONING OF THE COMPARISON OF DOUBLES,
C LOGICAL FUNCTION EQUALD
SUBROUTINE TESTD()
LOGICAL DEQUAL
DOUBLE PRECISION EXPECT
DOUBLE PRECISION ACTUL1
DOUBLE PRECISION ACTUL2
DOUBLE PRECISION ACTUL3
DOUBLE PRECISION EPS1
DOUBLE PRECISION EPS2
DATA EXPECT/1.0D0/, ACTUL1/1.0D0/, ACTUL2/1.00000001D0/,
& ACTUL3/0.99999999D0/
DATA EPS1/1.D-1/
C EPS2 SEEMS LIKE IT SHOULD BE 1.D-8, BUT DOUBLE PRECISION
C REPRESENTATION OF *ACTUL3* IS SLIGHTLY LESS THAN THE DECIMAL
C REPRESENTATION, SO THE TEST WILL FAIL IF 1.D-8 IS USED
DATA EPS2/5.D-9/
CALL ASRTT(DEQUAL(EXPECT, ACTUL1, EPS1))
CALL ASRTT(DEQUAL(EXPECT, ACTUL1, EPS2))
CALL ASRTT(DEQUAL(EXPECT, ACTUL2, EPS1))
CALL ASRTF(DEQUAL(EXPECT, ACTUL2, EPS2))
CALL ASRTT(DEQUAL(EXPECT, ACTUL3, EPS1))
CALL ASRTF(DEQUAL(EXPECT, ACTUL3, EPS2))
RETURN
END
with the obvious implementations:
C
C DETERMINE IF TWO REALS ARE "ESSENTIALLY" EQUAL:
C ABS(EXPECT - ACTUAL) <= EPSILN
C
C INPUT EXPECT (REAL) - THE EXPECTED VALUE
C INPUT ACTUAL (REAL) - THE VALUE TO BE COMPARED TO EXPECT
C INPUT EPSILN (REAL) - THE TOLERANCE
C OUTPUT RESULT
LOGICAL FUNCTION AEQUAL(EXPECT, ACTUAL, EPSILN)
REAL EXPECT
REAL ACTUAL
REAL EPSILN
AEQUAL = ABS(EXPECT - ACTUAL) .LE. EPSILN
END
C
C DETERMINE IF TWO DOUBLES ARE "ESSENTIALLY" EQUAL:
C ABS(EXPECT - ACTUAL) <= EPSILN
C
C INPUT EXPECT (DOUBLE) - THE EXPECTED VALUE
C INPUT ACTUAL (DOUBLE) - THE VALUE TO BE COMPARED TO EXPECT
C INPUT EPSILN (DOUBLE) - THE TOLERANCE
C OUTPUT RESULT
LOGICAL FUNCTION DEQUAL(EXPECT, ACTUAL, EPSILN)
DOUBLE PRECISION EXPECT
DOUBLE PRECISION ACTUAL
DOUBLE PRECISION EPSILN
DEQUAL = DABS(EXPECT - ACTUAL) .LE. EPSILN
END
Finally, the COMPLEX data type has a similar implementation. The only difference is that EPSILN will also be of type COMPLEX. This allows the user to specify separate epsilon values for the real and imaginary parts of the comparison. The FORTRAN 66 spec specifies that both the real and imaginary parts of a COMPLEX are REALs. So, we come up with the test:
C
C TESTS THE FUNCTIONING OF THE COMPARISON OF COMPLEX VALUES,
C LOGICAL FUNCTION CEQUAL
C THIS IS SOMEWHAT INELEGANT, BUT COVERS ALL OF THE POSSIBLITIES
SUBROUTINE TESTC
LOGICAL CEQUAL
COMPLEX EXPECT
COMPLEX ACTUAL
COMPLEX EPS1
COMPLEX EPS2
COMPLEX EPS3
COMPLEX EPS4
REAL ONE
REAL ONEPLS
REAL ONEMNS
REAL EPSLN1
REAL EPSLN2
DATA ONE/1.0/, ONEPLS/1.00001/, ONEMNS/0.99999/
DATA EPSLN1/1.E-1/, EPSLN2/1.E-7/
C
EXPECT = CMPLX(ONE, ONE)
ACTUAL = CMPLX(ONE, ONE)
EPS1 = CMPLX(EPSLN1, EPSLN1)
EPS2 = CMPLX(EPSLN2, EPSLN2)
EPS4 = CMPLX(EPSLN1, EPSLN2)
EPS3 = CMPLX(EPSLN2, EPSLN1)
C
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEPLS, ONE)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEMNS, ONE)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONE, ONEPLS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONE, ONEMNS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEPLS, ONEPLS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEPLS, ONEMNS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEMNS, ONEPLS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
C
ACTUAL = CMPLX(ONEMNS, ONEMNS)
CALL ASRTT(CEQUAL(EXPECT, ACTUAL, EPS1))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS2))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS3))
CALL ASRTF(CEQUAL(EXPECT, ACTUAL, EPS4))
RETURN
END
We could implement this inline (with calls to the ABS function). Instead, we again apply the DRY principle and call AEQUAL.
C
C DETERMINE IF TWO COMPLEX VALUES ARE "ESSENTIALLY" EQUAL:
C ABS(EXPECT - ACTUAL) <= EPSILN FOR BOTH THE REAL
C AND IMAGINARY PARTS
C
C INPUT EXPECT (COMPLEX) - THE EXPECTED VALUE
C INPUT ACTUAL (COMPLEX) - THE VALUE TO BE COMPARED TO EXPECT
C INPUT EPSILN (COMPLEX) - THE TOLERANCE
C OUTPUT RESULT
LOGICAL FUNCTION
CEQUAL(EXPECT, ACTUAL, EPSILN)
LOGICAL AEQUAL
COMPLEX EXPECT
COMPLEX ACTUAL
COMPLEX EPSILN
CEQUAL = AEQUAL(REAL(EXPECT), REAL(ACTUAL), REAL(EPSILN))
& .AND. AEQUAL(AIMAG(EXPECT), AIMAG(ACTUAL), AIMAG(EPSILN))
END
The next step is to write our xASRTE SUBROUTINEs in terms of xEQUAL and ASRTT:
C
C IASRTE
C ASSERTS THAT 2 INTEGERS ARE EQUAL
SUBROUTINE IASRTE(EXPECT, ACTUAL)
INTEGER EXPECT
INTEGER ACTUAL
LOGICAL RESULT
RESULT = IEQUAL(EXPECT, ACTUAL)
CALL ASRTT(RESULT)
RETURN
END
C
C LASRTE
C ASSERTS THAT 2 LOGICAL VARIABLES ARE EQUAL
SUBROUTINE LASRTE(EXPECT, ACTUAL)
LOGICAL EXPECT
LOGICAL ACTUAL
LOGICAL RESULT
RESULT = LEQUAL(EXPECT, ACTUAL)
CALL ASRTT(RESULT)
RETURN
END
C
C AASRTE
C ASSERTS THAT 2 REALS ARE ESSENTIALLY EQUAL
C ABS(EXPECT - ACTUAL) .LE. EPSILN
SUBROUTINE AASRTE(EXPECT, ACTUAL, EPSILN)
REAL EXPECT
REAL ACTUAL
REAL EPSILN
LOGICAL RESULT
RESULT = AEQUAL(EXPECT, ACTUAL)
CALL ASRTT(RESULT)
RETURN
END
C
C DASRTE
C ASSERTS THAT 2 DOUBLE PRECISION VARIABLES ARE ESSENTIALLY EQUAL
C DABS(EXPECT - ACTUAL) .LE. EPSILN
SUBROUTINE IASRTE(EXPECT, ACTUAL, EPSILN)
DOUBLE PRECISION EXPECT
DOUBLE PRECISION ACTUAL
DOUBLE PRECISION EPSILN
LOGICAL RESULT
RESULT = DEQUAL(EXPECT, ACTUAL)
CALL ASRTT(RESULT)
RETURN
END
C
C CASRTE
C ASSERTS THAT 2 DOUBLE PRECISION VARIABLES ARE ESSENTIALLY EQUAL
C ABS(REAL(EXPECT) - REAL(ACTUAL)) .LE. REAL(EPSILN)
C ABS(AIMAG(EXPECT) - AIMAG(ACTUAL)) .LE. AIMAG(EPSILN)
SUBROUTINE CASRTE(EXPECT, ACTUAL, EPSILN)
COMPLEX EXPECT
COMPLEX ACTUAL
COMPLEX EPSILN
LOGICAL RESULT
RESULT = CEQUAL(EXPECT, ACTUAL, EPSILN)
CALL ASRTT(RESULT)
RETURN
END
Finally, we have a main program to run all of our tests:
PROGRAM TCASES
COMMON /OUTP/KOUT
INTEGER KOUT
KOUT = 6
CALL TSTCHR()
CALL TSTOUT()
CALL TASRTT()
CALL TASRTF()
CALL TESTI()
CALL TESTL()
CALL TESTA()
CALL TESTD()
CALL TESTC()
STOP
END
Summary
In this installment, we've covered a lot of ground. We completed the basic version of our xUnit framework for FORTRAN 66.
We:
- Wrote ASRTT by using RESOUT
- Wrote ASRTF by using ASRTT
- Created xEQUAL classes for each of the types
- INTEGER
- LOGICAL
- REAL (accounting for the imprecision in floating point arithmetic)
- DOUBLE PRECISION (again accounting for the imprecision in floating point arithmetic)
- COMPLEX (by using AEQUAL)
- Wrote our xASRTE classes using xEQUAL and ASRTT
- Did all of it using Test-driven development (TDD), so that we have a complete set of test cases to support refactoring.
Next time we will tighten up the code, cleaning up a a few remaining bits of duplication, and enhance the framework to include some useful feedback.
No comments:
Post a Comment