1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3module m
4
5  ! For C1543
6  interface intFace
7    !WARNING: Attribute 'MODULE' cannot be used more than once
8    module pure module real function moduleFunc()
9    end function moduleFunc
10  end interface
11
12contains
13
14! C1543 A prefix shall contain at most one of each prefix-spec.
15!
16! R1535 subroutine-stmt is
17!   [prefix] SUBROUTINE subroutine-name [ ( [dummy-arg-list] )
18!   [proc-language-binding-spec] ]
19!
20! R1526  prefix is
21!   prefix-spec[prefix-spec]...
22!
23!   prefix-spec values are:
24!      declaration-type-spec, ELEMENTAL, IMPURE, MODULE, NON_RECURSIVE,
25!      PURE, RECURSIVE
26
27    !ERROR: FUNCTION prefix cannot specify the type more than once
28    real pure real function realFunc()
29    end function realFunc
30
31    !WARNING: Attribute 'ELEMENTAL' cannot be used more than once
32    elemental real elemental function elementalFunc()
33    end function elementalFunc
34
35    !WARNING: Attribute 'IMPURE' cannot be used more than once
36    impure real impure function impureFunc()
37    end function impureFunc
38
39    !WARNING: Attribute 'PURE' cannot be used more than once
40    pure real pure function pureFunc()
41    end function pureFunc
42
43    !ERROR: Attributes 'PURE' and 'IMPURE' conflict with each other
44    impure real pure function impurePureFunc()
45    end function impurePureFunc
46
47    !WARNING: Attribute 'RECURSIVE' cannot be used more than once
48    recursive real recursive function recursiveFunc()
49    end function recursiveFunc
50
51    !WARNING: Attribute 'NON_RECURSIVE' cannot be used more than once
52    non_recursive real non_recursive function non_recursiveFunc()
53    end function non_recursiveFunc
54
55    !ERROR: Attributes 'RECURSIVE' and 'NON_RECURSIVE' conflict with each other
56    non_recursive real recursive function non_recursiveRecursiveFunc()
57    end function non_recursiveRecursiveFunc
58end module m
59