1! Copyright 2018-2020 Free Software Foundation, Inc. 2! 3! This program is free software; you can redistribute it and/or modify 4! it under the terms of the GNU General Public License as published by 5! the Free Software Foundation; either version 3 of the License, or 6! (at your option) any later version. 7! 8! This program is distributed in the hope that it will be useful, 9! but WITHOUT ANY WARRANTY; without even the implied warranty of 10! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11! GNU General Public License for more details. 12! 13! You should have received a copy of the GNU General Public License 14! along with this program. If not, see <http://www.gnu.org/licenses/> . 15 16! Source code for short-circuit-argument-list.exp. 17 18module called_state 19 implicit none 20 type called_counts 21 integer :: function_no_arg_called = 0 22 integer :: function_no_arg_false_called = 0 23 integer :: function_one_arg_called = 0 24 integer :: function_two_arg_called = 0 25 integer :: function_array_called = 0 26 end type 27 type(called_counts) :: calls 28end module called_state 29 30logical function function_no_arg() 31 use called_state 32 implicit none 33 calls%function_no_arg_called = calls%function_no_arg_called + 1 34 function_no_arg = .TRUE. 35end function function_no_arg 36 37logical function function_no_arg_false() 38 use called_state 39 implicit none 40 calls%function_no_arg_false_called = calls%function_no_arg_false_called + 1 41 function_no_arg_false = .FALSE. 42end function function_no_arg_false 43 44logical function function_one_arg(x) 45 use called_state 46 implicit none 47 logical, intent(in) :: x 48 calls%function_one_arg_called = calls%function_one_arg_called + 1 49 function_one_arg = .TRUE. 50end function function_one_arg 51 52logical function function_two_arg(x, y) 53 use called_state 54 implicit none 55 logical, intent(in) :: x, y 56 calls%function_two_arg_called = calls%function_two_arg_called + 1 57 function_two_arg = .TRUE. 58end function function_two_arg 59 60logical function function_array(logical_array) 61 use called_state 62 implicit none 63 logical, dimension(4,2), target, intent(in) :: logical_array 64 logical, dimension(:,:), pointer :: p 65 calls%function_array_called = calls%function_array_called + 1 66 function_array = .TRUE. 67end function function_array 68 69program generate_truth_table 70 use called_state 71 implicit none 72 interface 73 logical function function_no_arg() 74 end function function_no_arg 75 logical function function_no_arg_false() 76 end function 77 logical function function_one_arg(x) 78 logical, intent(in) :: x 79 end function 80 logical function function_two_arg(x, y) 81 logical, intent(in) :: x, y 82 end function 83 logical function function_array(logical_array) 84 logical, dimension(4,2), target, intent(in) :: logical_array 85 end function function_array 86 end interface 87 logical, dimension (4,2) :: truth_table 88 logical :: a, b, c, d, e 89 character(2) :: binary_string 90 binary_string = char(0) // char(1) 91 truth_table = .FALSE. 92 truth_table(3:4,1) = .TRUE. 93 truth_table(2::2,2) = .TRUE. 94 a = function_no_arg() ! post_truth_table_init 95 b = function_no_arg_false() 96 c = function_one_arg(b) 97 d = function_two_arg(a, b) 98 e = function_array(truth_table) 99 print *, truth_table(:, 1), a, b, e 100 print *, truth_table(:, 2), c, d 101end program generate_truth_table 102