Jean Perier | 4073e47 | 2019-03-21 15:31:21 | [diff] [blame] | 1 | ! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. |
| 2 | ! |
| 3 | ! Licensed under the Apache License, Version 2.0 (the "License"); |
| 4 | ! you may not use this file except in compliance with the License. |
| 5 | ! You may obtain a copy of the License at |
| 6 | ! |
| 7 | ! http://www.apache.org/licenses/LICENSE-2.0 |
| 8 | ! |
| 9 | ! Unless required by applicable law or agreed to in writing, software |
| 10 | ! distributed under the License is distributed on an "AS IS" BASIS, |
| 11 | ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| 12 | ! See the License for the specific language governing permissions and |
| 13 | ! limitations under the License. |
| 14 | |
| 15 | |
| 16 | ! Test intrinsic operation folding |
| 17 | |
| 18 | module m |
| 19 | ! Check logical intrinsic operation folding |
| 20 | logical, parameter :: test_not1 = .NOT..false. |
| 21 | logical, parameter :: test_not2 = .NOT..NOT..true. |
| 22 | |
peter klausler | 5a18e79 | 2019-03-11 22:39:11 | [diff] [blame] | 23 | logical, parameter :: test_parentheses1 = .NOT.(.false.) |
| 24 | logical, parameter :: test_parentheses2 = .NOT..NOT.(.true.) |
Jean Perier | 4073e47 | 2019-03-21 15:31:21 | [diff] [blame] | 25 | |
| 26 | logical, parameter :: test_and1 = .true..AND..true. |
| 27 | logical, parameter :: test_and2 = .NOT.(.false..AND..true.) |
| 28 | logical, parameter :: test_and3 = .NOT.(.false..AND..false.) |
| 29 | logical, parameter :: test_and4 = .NOT.(.true..AND..false.) |
| 30 | |
| 31 | logical, parameter :: test_or1 = .true..OR..true. |
| 32 | logical, parameter :: test_or2 = .false..OR..true. |
| 33 | logical, parameter :: test_or3 = .NOT.(.false..OR..false.) |
| 34 | logical, parameter :: test_or4 = .true..OR..false. |
| 35 | |
| 36 | logical, parameter :: test_eqv1 = .false..EQV..false. |
| 37 | logical, parameter :: test_eqv2 = .true..EQV..true. |
| 38 | logical, parameter :: test_eqv3 = .NOT.(.false..EQV..true.) |
| 39 | logical, parameter :: test_eqv4 = .NOT.(.true..EQV..false.) |
| 40 | |
| 41 | logical, parameter :: test_neqv1 = .true..NEQV..false. |
| 42 | logical, parameter :: test_neqv2 = .false..NEQV..true. |
| 43 | logical, parameter :: test_neqv3 = .NOT.(.false..NEQV..false.) |
| 44 | logical, parameter :: test_neqv4 = .NOT.(.true..NEQV..true.) |
| 45 | |
| 46 | ! Check integer intrinsic operator folding |
| 47 | |
| 48 | ! Check integer relational intrinsic operation folding |
| 49 | logical, parameter :: test_le_i1 = 1.LE.2 |
| 50 | logical, parameter :: test_le_i2 = .NOT.(2.LE.1) |
| 51 | logical, parameter :: test_le_i3 = 2.LE.2 |
| 52 | logical, parameter :: test_le_i4 = -1.LE.2 |
| 53 | logical, parameter :: test_le_i5 = .NOT.(-2.LE.-3) |
| 54 | |
| 55 | logical, parameter :: test_lt_i1 = 1.LT.2 |
| 56 | logical, parameter :: test_lt_i2 = .NOT.(2.LT.1) |
| 57 | logical, parameter :: test_lt_i3 = .NOT.(2.LT.2) |
| 58 | logical, parameter :: test_lt_i4 = -1.LT.2 |
| 59 | logical, parameter :: test_lt_i5 = .NOT.(-2.LT.-3) |
| 60 | |
| 61 | logical, parameter :: test_ge_i1 = .NOT.(1.GE.2) |
| 62 | logical, parameter :: test_ge_i2 = 2.GE.1 |
| 63 | logical, parameter :: test_ge_i3 = 2.GE.2 |
| 64 | logical, parameter :: test_ge_i4 = .NOT.(-1.GE.2) |
| 65 | logical, parameter :: test_ge_i5 = -2.GE.-3 |
| 66 | |
| 67 | logical, parameter :: test_gt_i1 = .NOT.(1.GT.2) |
| 68 | logical, parameter :: test_gt_i2 = 2.GT.1 |
| 69 | logical, parameter :: test_gt_i3 = .NOT.(2.GT.2) |
| 70 | logical, parameter :: test_gt_i4 = .NOT.(-1.GT.2) |
| 71 | logical, parameter :: test_gt_i5 = -2.GT.-3 |
| 72 | |
| 73 | logical, parameter :: test_eq_i1 = 2.EQ.2 |
| 74 | logical, parameter :: test_eq_i2 = .NOT.(-2.EQ.2) |
| 75 | |
| 76 | logical, parameter :: test_ne_i1 =.NOT.(2.NE.2) |
| 77 | logical, parameter :: test_ne_i2 = -2.NE.2 |
| 78 | |
| 79 | ! Check integer intrinsic operation folding |
| 80 | logical, parameter :: test_unaryminus_i = (-(-1)).EQ.1 |
| 81 | logical, parameter :: test_unaryplus_i = (+1).EQ.1 |
| 82 | |
| 83 | logical, parameter :: test_plus_i1 = (1+1).EQ.2 |
| 84 | logical, parameter :: test_plus_i2 = ((-3)+1).EQ.-2 |
| 85 | |
| 86 | logical, parameter :: test_minus_i1 = (1-1).EQ.0 |
| 87 | logical, parameter :: test_minus_i2 = (1-(-1)).EQ.2 |
| 88 | |
| 89 | logical, parameter :: test_multiply_i1 = (2*2).EQ.4 |
| 90 | logical, parameter :: test_multiply_i2 = (0*1).EQ.0 |
| 91 | logical, parameter :: test_multiply_i3= ((-3)*2).EQ.(-6) |
| 92 | |
| 93 | logical, parameter :: test_divide_i1 = (5/3).EQ.(1) |
| 94 | logical, parameter :: test_divide_i2 = (6/3).EQ.(2) |
| 95 | logical, parameter :: test_divide_i3 = ((-7)/2).EQ.(-3) |
| 96 | logical, parameter :: test_divide_i4 = (0/127).EQ.(0) |
| 97 | |
Jean Perier | 9f98662 | 2019-03-28 15:18:42 | [diff] [blame] | 98 | logical, parameter :: test_pow1 = (2**0).EQ.(1) |
| 99 | logical, parameter :: test_pow2 = (1**100).EQ.(1) |
| 100 | logical, parameter :: test_pow3 = (2**4).EQ.(16) |
| 101 | logical, parameter :: test_pow4 = (7**5).EQ.(16807) |
Jean Perier | 4073e47 | 2019-03-21 15:31:21 | [diff] [blame] | 102 | |
Jean Perier | 572de7c | 2019-10-31 15:03:16 | [diff] [blame^] | 103 | ! test MIN and MAX |
| 104 | real, parameter :: x1 = -35., x2= -35.05, x3=0., x4=35.05, x5=35. |
| 105 | real, parameter :: res_max_r = max(x1, x2, x3, x4, x5) |
| 106 | real, parameter :: res_min_r = min(x1, x2, x3, x4, x5) |
| 107 | logical, parameter :: test_max_r = res_max_r.EQ.x4 |
| 108 | logical, parameter :: test_min_r = res_min_r.EQ.x2 |
| 109 | |
| 110 | logical, parameter :: test_min_i = min(-3, 3).EQ.-3 |
| 111 | logical, parameter :: test_max_i = max(-3, 3).EQ.3 |
| 112 | integer, parameter :: i1 = 35, i2= 36, i3=0, i4=-35, i5=-36 |
| 113 | integer, parameter :: res_max_i = max(i1, i2, i3, i4, i5) |
| 114 | integer, parameter :: res_min_i = min(i1, i2, i3, i4, i5) |
| 115 | logical, parameter :: test_max_i2 = res_max_i.EQ.i2 |
| 116 | logical, parameter :: test_min_i2 = res_min_i.EQ.i5 |
| 117 | |
| 118 | character(*), parameter :: c1 = "elephant", c2="elevator" |
| 119 | character(*), parameter :: c3 = "excalibur", c4="z", c5="epsilon" |
| 120 | character(*), parameter :: res_max_c = max(c1, c2, c3, c4, c5) |
| 121 | character(*), parameter :: res_min_c = min(c1, c2, c3, c4, c5) |
| 122 | ! length of result is length of longest arguments! |
| 123 | character(len(c3)), parameter :: exp_min = c1 |
| 124 | character(len(c3)), parameter :: exp_max = c4 |
| 125 | logical, parameter :: test_max_c_1 = res_max_c.EQ.exp_max |
| 126 | logical, parameter :: test_max_c_2 = res_max_c.NE.c4 |
| 127 | logical, parameter :: test_max_c_3 = len(res_max_c).EQ.len(c3) |
| 128 | logical, parameter :: test_min_c_1 = res_min_c.NE.c1 |
| 129 | logical, parameter :: test_min_c_2 = res_min_c.EQ.exp_min |
| 130 | logical, parameter :: test_min_c_3 = len(res_min_c).EQ.len(c3) |
| 131 | |
| 132 | integer, parameter :: x1a(*) = [1, 12, 3, 14] |
| 133 | integer, parameter :: x2a(*) = [11, 2, 13, 4] |
| 134 | logical, parameter :: test_max_a1 = all(max(x1a, x2a).EQ.[11, 12, 13, 14]) |
| 135 | logical, parameter :: test_min_a1 = all(min(x1a, x2a).EQ.[1, 2, 3, 4]) |
| 136 | |
Jean Perier | 4073e47 | 2019-03-21 15:31:21 | [diff] [blame] | 137 | end module |