1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3module m
4! C743 No component-attr-spec shall appear more than once in a
5! given component-def-stmt.
6!
7! R737 data-component-def-stmt ->
8!        declaration-type-spec [[, component-attr-spec-list] ::]
9!        component-decl-list
10!  component-attr-spec values are:
11!    PUBLIC, PRIVATE, ALLOCATABLE, CODIMENSION [*], CONTIGUOUS, DIMENSION(5),
12!      POINTER
13
14  type :: derived
15    !WARNING: Attribute 'PUBLIC' cannot be used more than once
16    real, public, allocatable, public :: field1
17    !WARNING: Attribute 'PRIVATE' cannot be used more than once
18    real, private, allocatable, private :: field2
19    !ERROR: Attributes 'PUBLIC' and 'PRIVATE' conflict with each other
20    real, public, allocatable, private :: field3
21    !WARNING: Attribute 'ALLOCATABLE' cannot be used more than once
22    real, allocatable, public, allocatable :: field4
23    !ERROR: Attribute 'CODIMENSION' cannot be used more than once
24    real, public, codimension[:], allocatable, codimension[:] :: field5
25    !WARNING: Attribute 'CONTIGUOUS' cannot be used more than once
26    real, public, contiguous, pointer, contiguous, dimension(:) :: field6
27    !ERROR: Attribute 'DIMENSION' cannot be used more than once
28    real, dimension(5), public, dimension(5) :: field7
29    !WARNING: Attribute 'POINTER' cannot be used more than once
30    real, pointer, public, pointer :: field8
31  end type derived
32
33end module m
34