• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1! RUN: %S/test_folding.sh %s %t %f18
2! Test intrinsic function folding edge case (both expected value and messages)
3! These tests make assumptions regarding real(4) extrema.
4
5#define TEST_ISNAN(v) logical, parameter :: test_##v =.NOT.(v.EQ.v)
6
7
8module real_tests
9  ! Test real(4) intrinsic folding on edge cases (inf and NaN)
10
11  real(4), parameter :: r4_pmax = 3.4028235E38
12  real(4), parameter :: r4_nmax = -3.4028235E38
13  !WARN: invalid argument on division
14  real(4), parameter :: r4_nan = 0._4/0._4
15  !WARN: division by zero
16  real(4), parameter :: r4_pinf = 1._4/0._4
17  !WARN: division by zero
18  real(4), parameter :: r4_ninf = -1._4/0._4
19
20  !WARN: invalid argument on intrinsic function
21  real(4), parameter :: nan_r4_acos1 = acos(1.1)
22  TEST_ISNAN(nan_r4_acos1)
23  !WARN: invalid argument on intrinsic function
24  real(4), parameter :: nan_r4_acos2 = acos(r4_pmax)
25  TEST_ISNAN(nan_r4_acos2)
26  !WARN: invalid argument on intrinsic function
27  real(4), parameter :: nan_r4_acos3 = acos(r4_nmax)
28  TEST_ISNAN(nan_r4_acos3)
29  !WARN: invalid argument on intrinsic function
30  real(4), parameter :: nan_r4_acos4 = acos(r4_ninf)
31  TEST_ISNAN(nan_r4_acos4)
32  !WARN: invalid argument on intrinsic function
33  real(4), parameter :: nan_r4_acos5 = acos(r4_pinf)
34  TEST_ISNAN(nan_r4_acos5)
35
36  !WARN: overflow on intrinsic function
37  logical, parameter :: test_exp_overflow = exp(256._4).EQ.r4_pinf
38end module
39
40module parentheses
41  ! Test parentheses in folding (they are kept around constants to keep the
42  ! distinction between variable and expressions and require special care).
43  real(4), parameter :: x_nop = 0.1_4
44  real(4), parameter :: x_p = (x_nop)
45  logical, parameter :: test_parentheses1 = acos(x_p).EQ.acos(x_nop)
46end module
47
48module specific_extremums
49  ! f18 accepts all type kinds for the arguments of specific extremum intrinsics
50  ! instead of of only default kind (or double precision for DMAX1 and DMIN1).
51  ! This extensions is implemented by using the related generic intrinsic and
52  ! converting the result.
53  ! The tests below are cases where an implementation that converts the arguments to the
54  ! standard required types instead would give different results than the implementation
55  ! specified for f18 (converting the result).
56  integer(8), parameter :: max_i32_8 = 2_8**31-1
57  integer, parameter :: expected_min0 = int(min(max_i32_8, 2_8*max_i32_8), 4)
58  !WARN: argument types do not match specific intrinsic 'min0' requirements; using 'min' generic instead and converting the result to INTEGER(4) if needed
59  integer, parameter :: result_min0 =  min0(max_i32_8, 2_8*max_i32_8)
60  ! result_min0 would be -2  if arguments were converted to default integer.
61  logical, parameter :: test_min0 = expected_min0 .EQ. result_min0
62
63  real, parameter :: expected_amax0 = real(max(max_i32_8, 2_8*max_i32_8), 4)
64  !WARN: argument types do not match specific intrinsic 'amax0' requirements; using 'max' generic instead and converting the result to REAL(4) if needed
65  real, parameter :: result_amax0 = amax0(max_i32_8, 2_8*max_i32_8)
66  ! result_amax0 would be 2.1474836E+09 if arguments were converted to default integer first.
67  logical, parameter :: test_amax0 = expected_amax0 .EQ. result_amax0
68end module
69