@@ -3,30 +3,34 @@ program assertion_examples
33 ! ! of two kinds of constraints:
44 ! ! 1. Preconditions: requirements for correct execution at the start of a procedure and
55 ! ! 2. Postconditions: requirements for correct execution at the end of a procedure.
6+ use assert_m, only : assert
7+ use intrinsic_array_m, only : intrinsic_array_t
68 implicit none
79
8- print * , reciprocal( 2 .)
10+ print * , " roots: " , roots(a = 1 .,b = 0 .,c =- 4 .)
911
1012contains
1113
12- pure real function reciprocal(x ) result(reciprocal_of_x )
13- ! ! Erroneous calculation of the reciprocal of the function's argument
14- use assert_m, only : assert
15- real , intent ( in ) :: x
14+ pure function roots ( a , b , c ) result(zeros )
15+ ! ! Calculate the roots of a quadratic polynomial
16+ real , intent ( in ) :: a, b, c
17+ real zeros( 2 )
1618
17- call assert(assertion = x /= 0 ., description = " reciprocal: x /= 0" , diagnostic_data = x) ! Precondition passes
19+ associate(discriminant = > b** 2 - 4 * a* c)
20+ call assert(assertion = (discriminant >= 0 .), description = " roots: nonnegative discriminant" , diagnostic_data = discriminant)
1821
19- reciprocal_of_x = 0 . ! incorrect value for the reciprocal of x
22+ associate(radical = > sqrt (discriminant))
23+ zeros = [- b + radical, - b - radical]/ (2 * a)
2024
21- block
22- real , parameter :: tolerance = 1.E-06
23-
24- associate(error = > x* reciprocal_of_x - 1 .)
25-
26- call assert(abs (error) < tolerance, " reciprocal: abs(error) < tolerance" , error) ! Postcondition fails
25+ block
26+ real , parameter :: tolerance = 1.E-06
2727
28+ associate(errors = > a* zeros** 2 + b* zeros + c)
29+ call assert(maxval (abs (errors)) < tolerance, " roots: |max(error)| > tolerance" , intrinsic_array_t([errors]))
30+ end associate
31+ end block
2832 end associate
29- end block
33+ end associate
3034
3135 end function
3236
0 commit comments