3333! POSSIBILITY OF SUCH DAMAGE.
3434
3535program main
36- ! ! input: acceptable compiler version the form major.minor.patch
36+ ! ! input: acceptable compiler version in the form major.minor.patch
3737 ! ! output:
3838 ! ! .true. if compiler version >= acceptable version
3939 ! ! .false. otherwise
@@ -47,35 +47,40 @@ program main
4747 call get_command_argument(first_argument,acceptable_version,status= stat)
4848 call validate_command_line( stat )
4949
50- associate( compiler_version= > compiler_version() )
51- associate(major_version= >major(compiler_version), acceptable_major= >major(acceptable_version))
52- if ( major_version > acceptable_major ) then
53- print * ,.true.
54- else if ( major_version == acceptable_major ) then
55- associate(minor_version= >minor(compiler_version), acceptable_minor= >minor(acceptable_version))
56- if ( minor_version > acceptable_minor ) then
57- print * ,.true.
58- else if ( minor_version == acceptable_minor ) then
59- associate(patch_version= >patch(compiler_version), acceptable_patch= >patch(acceptable_version))
60- if ( patch_version >= acceptable_patch ) then
61- print * ,.true.
62- else
63- print * ,.false.
64- end if
65- end associate
66- else
67- print * ,.false.
50+ print * , meets_minimum( acceptable_version )
51+
52+ contains
53+
54+ pure function meets_minimum ( required_version ) result( acceptable)
55+ character (len=* ), intent (in ) :: required_version
56+ logical acceptable
57+
58+ acceptable = .false. ! default result
59+
60+ associate( actual_version = > compiler_version() )
61+ associate(major_version= >major(actual_version), acceptable_major= >major(required_version))
62+ if (major_version < acceptable_major) return
63+ if (major_version > acceptable_major) then
64+ acceptable = .true.
65+ return
66+ end if
67+ associate(minor_version= >minor(actual_version), acceptable_minor= >minor(required_version))
68+ if (minor_version < acceptable_minor) return
69+ if (minor_version > acceptable_minor) then
70+ acceptable = .true.
71+ return
6872 end if
73+ associate(patch_version= >patch(actual_version), acceptable_patch= >patch(required_version))
74+ if (patch_version < acceptable_patch) return
75+ acceptable = .true.
76+ end associate
6977 end associate
70- else
71- print * ,.false.
72- end if
78+ end associate
7379 end associate
74- end associate
7580
76- contains
81+ end function
7782
78- subroutine validate_command_line ( command_line_status )
83+ pure subroutine validate_command_line ( command_line_status )
7984 integer , intent (in ) :: command_line_status
8085 select case (command_line_status)
8186 case (- 1 )
@@ -118,29 +123,31 @@ pure function minor(version_string) result(minor_value)
118123 end function
119124
120125 pure function patch (version_string ) result(patch_value)
126+ use iso_fortran_env, only : iostat_end
121127 character (len=* ), intent (in ) :: version_string
122- integer patch_value
128+ integer patch_value, io_stat
123129 character (len= :), allocatable :: trailing_digits
124130
125131 associate( first_dot = > scan (version_string, ' .' ) )
126132 associate( second_dot = > first_dot + scan (version_string(first_dot+1 :), ' .' ) )
127- associate( first_non_digit = > second_dot + first_printable_non_digit (version_string(second_dot+1 :)) )
128- trailing_digits = version_string( second_dot+1 : first_non_digit -1 )
129- read (trailing_digits,* ) patch_value
133+ associate( next_non_digit = > second_dot + next_printable_non_digit (version_string(second_dot+1 :)) )
134+ trailing_digits = version_string( second_dot+1 : next_non_digit -1 )
135+ read (trailing_digits, * , iostat = io_stat ) patch_value
130136 end associate
131137 end associate
132138 end associate
133139
134140 end function
135141
136- pure function first_printable_non_digit ( string ) result(location)
142+ pure function next_printable_non_digit ( string ) result(location)
137143 character (len=* ), intent (in ) :: string
138144 integer i, location
139145 integer , parameter :: ASCII_non_digit(* )= [(i,i= 32 ,47 ),(i,i= 58 ,126 )]
140146 character (len= 1 ), parameter :: non_digit(* )= [( char (ASCII_non_digit(i)) , i= 1 , size (ASCII_non_digit) )]
141147 character (len= size (non_digit)) non_digit_string
142148 write (non_digit_string,' (85a)' ) non_digit
143149 location = scan (string,non_digit_string)
150+ if (location== 0 ) location= len (string)+ 1
144151 end function
145152
146153end program
0 commit comments