From 948c0466543d87e732fe140fad9530316407cfe9 Mon Sep 17 00:00:00 2001 From: MinchaoLiang Date: Thu, 27 Oct 2022 21:31:51 +0800 Subject: [PATCH] Add test cases for types --- 6-Add-test-cases-for-types.patch | 873 +++++++++++++++++++++++++++++++ flang.spec | 6 +- 2 files changed, 878 insertions(+), 1 deletion(-) create mode 100644 6-Add-test-cases-for-types.patch diff --git a/6-Add-test-cases-for-types.patch b/6-Add-test-cases-for-types.patch new file mode 100644 index 0000000..9e424fc --- /dev/null +++ b/6-Add-test-cases-for-types.patch @@ -0,0 +1,873 @@ +commit 8dca32950ac1c1a677bcff46e67f01efa11fa123 +Author: MinchaoLiang +Date: Thu Oct 27 21:21:54 2022 +0800 + + Add test cases for types + +diff --git a/test/Semantics/0701_C729.f90 b/test/Semantics/0701_C729.f90 +new file mode 100644 +index 0000000..3e1f54c +--- /dev/null ++++ b/test/Semantics/0701_C729.f90 +@@ -0,0 +1,11 @@ ++! Test C729: A derived type type-name shall not be DOUBLEPRECISION or the same ++! as the name of any intrinsic type defined in this document. ++ ++program main ++ implicit none ++ !ERROR: A derived type name cannot be the name of an intrinsic type ++ type :: DOUBLEPRECISION ++ integer :: test ++ end type DOUBLEPRECISION ++ !ERROR: A derived type name cannot be the name of an intrinsic type ++end +\ No newline at end of file +diff --git a/test/Semantics/0702_C730_abstract.f90 b/test/Semantics/0702_C730_abstract.f90 +new file mode 100644 +index 0000000..3d124bc +--- /dev/null ++++ b/test/Semantics/0702_C730_abstract.f90 +@@ -0,0 +1,11 @@ ++! Test C730: The same type-attr-spec shall not appear more ++! than once in a given derived-type-stmt. ++ ++program main ++ implicit none ++ !WARNING: Attribute 'ABSTRACT' cannot be used more than once ++ type,abstract,abstract:: person ++ character(len=20) :: name ++ integer :: age ++ end type person ++end +\ No newline at end of file +diff --git a/test/Semantics/0703_C730_public.f90 b/test/Semantics/0703_C730_public.f90 +new file mode 100644 +index 0000000..00f982e +--- /dev/null ++++ b/test/Semantics/0703_C730_public.f90 +@@ -0,0 +1,12 @@ ++! Test C730: The same type-attr-spec shall not appear more ++! than once in a given derived-type-stmt. ++ ++program main ++ implicit none ++ !ERROR: PUBLIC attribute may only appear in the specification part of a module ++ !WARNING: Attribute 'PUBLIC' cannot be used more than once ++ type,public,public :: person ++ character(len=20) :: name ++ integer :: age ++ end type person ++end +\ No newline at end of file +diff --git a/test/Semantics/0704_C730_private.f90 b/test/Semantics/0704_C730_private.f90 +new file mode 100644 +index 0000000..70d72da +--- /dev/null ++++ b/test/Semantics/0704_C730_private.f90 +@@ -0,0 +1,12 @@ ++! Test C730: The same type-attr-spec shall not appear more ++! than once in a given derived-type-stmt. ++ ++program main ++ implicit none ++ !ERROR: PRIVATE attribute may only appear in the specification part of a module ++ !WARNING: Attribute 'PRIVATE' cannot be used more than once ++ type,private,private :: person ++ character(len=20) :: name ++ integer :: age ++ end type person ++end +\ No newline at end of file +diff --git a/test/Semantics/0705_C730_bind.f90 b/test/Semantics/0705_C730_bind.f90 +new file mode 100644 +index 0000000..baede1a +--- /dev/null ++++ b/test/Semantics/0705_C730_bind.f90 +@@ -0,0 +1,11 @@ ++! Test C730: The same type-attr-spec shall not appear more ++! than once in a given derived-type-stmt. ++ ++program main ++ implicit none ++ !WARNING: Attribute 'BIND(C)' cannot be used more than once ++ type,bind(C),bind(C) :: person ++ character(len=20) :: name ++ integer :: age ++ end type person ++end +\ No newline at end of file +diff --git a/test/Semantics/0706_C730_extends.f90 b/test/Semantics/0706_C730_extends.f90 +new file mode 100644 +index 0000000..af70d7d +--- /dev/null ++++ b/test/Semantics/0706_C730_extends.f90 +@@ -0,0 +1,14 @@ ++! Test C730: The same type-attr-spec shall not appear more ++! than once in a given derived-type-stmt. ++ ++program main ++ implicit none ++ type :: person ++ character :: name ++ integer :: age ++ end type person ++ !ERROR: Attribute 'EXTENDS' cannot be used more than once ++ type,extends(person),extends(person) :: woman ++ integer :: salary ++ end type woman ++end +\ No newline at end of file +diff --git a/test/Semantics/0707_C731.f90 b/test/Semantics/0707_C731.f90 +new file mode 100644 +index 0000000..5e68829 +--- /dev/null ++++ b/test/Semantics/0707_C731.f90 +@@ -0,0 +1,10 @@ ++! Test C731: The same type-param-name shall not appear ++! more than once in a given derived-type-stmt ++ ++program main ++ !ERROR: Duplicate type parameter name: 'dim' ++ type t(dim,dim) ++ integer, kind :: dim ++ real :: c(dim) ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0708_C732.f90 b/test/Semantics/0708_C732.f90 +new file mode 100644 +index 0000000..de325b4 +--- /dev/null ++++ b/test/Semantics/0708_C732.f90 +@@ -0,0 +1,10 @@ ++! Test C732: A parent-type-name shall be the name of a previously defined extensible type ++ ++program main ++ implicit none ++ !ERROR: Derived type 'man' not found ++ type,extends(man) :: person ++ character :: name ++ integer :: age ++ end type person ++end +\ No newline at end of file +diff --git a/test/Semantics/0709_C733_contains.f90 b/test/Semantics/0709_C733_contains.f90 +new file mode 100644 +index 0000000..e27750d +--- /dev/null ++++ b/test/Semantics/0709_C733_contains.f90 +@@ -0,0 +1,17 @@ ++! Test C733: If the type definition contains or inherits a deferred ++! type-bound procedure, ABSTRACT shall appear ++ ++program main ++ implicit none ++ type :: t ++ contains ++ !ERROR: Procedure bound to non-ABSTRACT derived type 'abstract_t' may not be DEFERRED ++ procedure(s), pass, deferred :: foo ++ end type ++ abstract interface ++ subroutine s(this) ++ import :: t ++ class(t),intent(in)::this ++ end subroutine s ++ end interface ++end +\ No newline at end of file +diff --git a/test/Semantics/0710_C733_inherits.f90 b/test/Semantics/0710_C733_inherits.f90 +new file mode 100644 +index 0000000..e471aa8 +--- /dev/null ++++ b/test/Semantics/0710_C733_inherits.f90 +@@ -0,0 +1,19 @@ ++! Test C733: If the type definition contains or inherits a deferred ++! type-bound procedure, ABSTRACT shall appear ++program main ++ implicit none ++ type,abstract :: t ++ contains ++ procedure(s), pass, deferred :: f ++ end type ++ ! ERROR: Non-ABSTRACT extension of ABSTRACT derived type 't' lacks a binding for DEFERRED procedure 'f' ++ type,extends(t) :: as ++ real :: x ++ end type ++ abstract interface ++ subroutine s(this) ++ import :: t ++ class(t),intent(in)::this ++ end subroutine s ++ end interface ++end +\ No newline at end of file +diff --git a/test/Semantics/0711_C734_abstract.f90 b/test/Semantics/0711_C734_abstract.f90 +new file mode 100644 +index 0000000..f1334ba +--- /dev/null ++++ b/test/Semantics/0711_C734_abstract.f90 +@@ -0,0 +1,11 @@ ++! Test C734: If ABSTRACT appears, the type shall be extensible ++ ++program main ++ implicit none ++ ! ERROR: An ABSTRACT derived type must be extensible ++ type,abstract :: t ++ sequence ++ integer :: i ++ real :: r ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0712_C734_parent.f90 b/test/Semantics/0712_C734_parent.f90 +new file mode 100644 +index 0000000..b7f5783 +--- /dev/null ++++ b/test/Semantics/0712_C734_parent.f90 +@@ -0,0 +1,14 @@ ++! Test C734: If ABSTRACT appears, the type shall be extensible. ++ ++program main ++ implicit none ++ type:: t ++ sequence ++ integer :: i ++ real :: r ++ end type ++ ! ERROR: The parent type is not extensible ++ type,extends(t)::test ++ real :: v ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0713_C735.f90 b/test/Semantics/0713_C735.f90 +new file mode 100644 +index 0000000..c99cf66 +--- /dev/null ++++ b/test/Semantics/0713_C735.f90 +@@ -0,0 +1,14 @@ ++! Test C735: If EXTENDS appears, SEQUENCE shall not appear. ++ ++program main ++ implicit none ++ type:: t ++ integer :: i ++ real :: r ++ end type ++ ! ERROR: A sequence type may not have the EXTENDS attribute ++ type,extends(t)::test ++ sequence ++ real :: va ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0714_C738_private.f90 b/test/Semantics/0714_C738_private.f90 +new file mode 100644 +index 0000000..837393a +--- /dev/null ++++ b/test/Semantics/0714_C738_private.f90 +@@ -0,0 +1,17 @@ ++! Test C738: The same private-or-sequence shall not ++! appear more than once in a given derived-type-def. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: PRIVATE may not appear more than once in derived type components ++ private ++ private ++ integer :: i ++ real :: r ++ end type ++end module types ++program main ++use types ++implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0715_C738_sequence.f90 b/test/Semantics/0715_C738_sequence.f90 +new file mode 100644 +index 0000000..d5a50bc +--- /dev/null ++++ b/test/Semantics/0715_C738_sequence.f90 +@@ -0,0 +1,17 @@ ++! Test C738: The same private-or-sequence shall not ++! appear more than once in a given derived-type-def. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: SEQUENCE may not appear more than once in derived type components ++ sequence ++ sequence ++ integer :: i ++ real :: r ++ end type ++end module types ++program main ++use types ++implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0716_C739.f90 b/test/Semantics/0716_C739.f90 +new file mode 100644 +index 0000000..5ee1bcf +--- /dev/null ++++ b/test/Semantics/0716_C739.f90 +@@ -0,0 +1,12 @@ ++! Test C739: If END TYPE is followed by a type-name, the type-name shall be ++! the same as that in the corresponding derived-type-stmt. ++ ++program main ++ implicit none ++ ! ERROR: derived type definition name mismatch ++ type :: t ++ sequence ++ integer :: i ++ real :: r ++ end type a ++end +\ No newline at end of file +diff --git a/test/Semantics/0717_C740_one.f90 b/test/Semantics/0717_C740_one.f90 +new file mode 100644 +index 0000000..fd24386 +--- /dev/null ++++ b/test/Semantics/0717_C740_one.f90 +@@ -0,0 +1,11 @@ ++! Test C740: If SEQUENCE appears, the type shall have at least one component, each data component ++! shall be declared to be of an intrinsic type or of a sequence type, the derived type shall not have ++! any type parameter, and a type-bound-procedure-part shall not appear. ++ ++program main ++ implicit none ++ ! ERROR: A sequence type must have at least one component ++ type :: t ++ sequence ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0718_C740_sequence.f90 b/test/Semantics/0718_C740_sequence.f90 +new file mode 100644 +index 0000000..eecf5ce +--- /dev/null ++++ b/test/Semantics/0718_C740_sequence.f90 +@@ -0,0 +1,22 @@ ++! Test C740: If SEQUENCE appears, the type shall have at least one component, each data component ++! shall be declared to be of an intrinsic type or of a sequence type, the derived type shall not have ++! any type parameter, and a type-bound-procedure-part shall not appear. ++ ++program main ++ implicit none ++ type,abstract :: t ++ sequence ++ real :: r ++ ! ERROR: A sequence type may not have a CONTAINS statement ++ contains ++ ! ERROR: Passed-object dummy argument 'this' of procedure 'f' may not be polymorphic because 't' is not extensible ++ procedure(s), PASS, deferred :: f ++ end type ++ abstract interface ++ subroutine s(this) ++ import :: t ++ ! ERROR: Non-extensible derived type 't' may not be used with CLASS keyword ++ class(t),intent(in)::this ++ end subroutine s ++ end interface ++end +\ No newline at end of file +diff --git a/test/Semantics/0719_C741.f90 b/test/Semantics/0719_C741.f90 +new file mode 100644 +index 0000000..f4cb2c4 +--- /dev/null ++++ b/test/Semantics/0719_C741.f90 +@@ -0,0 +1,11 @@ ++! Test C741: A type-param-name in a type-param-def-stmt in a derived-type-def shall be one ++! of the type-param-names in the derived-type-stmt of that derived-type-def. ++ ++program main ++implicit none ++ ! ERROR: No definition found for type parameter 'a' ++ type matrix(k,d,a) ++ integer,kind:: k ++ integer,len:: d ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0720_C742_noDef.f90 b/test/Semantics/0720_C742_noDef.f90 +new file mode 100644 +index 0000000..6ed282d +--- /dev/null ++++ b/test/Semantics/0720_C742_noDef.f90 +@@ -0,0 +1,10 @@ ++! Test C742: Each type-param-name in the derived-type-stmt in a derived-type-def shall ++! appear exactly once as a type-param-name in a type-param-def-stmt in that derived-type-def. ++ ++program main ++ implicit none ++ ! ERROR: No definition found for type parameter 'd' ++ type matrix(k,d) ++ integer,kind:: k ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0721_C742_defTwice.f90 b/test/Semantics/0721_C742_defTwice.f90 +new file mode 100644 +index 0000000..5a587bc +--- /dev/null ++++ b/test/Semantics/0721_C742_defTwice.f90 +@@ -0,0 +1,12 @@ ++! Test C742: Each type-param-name in the derived-type-stmt in a derived-type-def shall ++! appear exactly once as a type-param-name in a type-param-def-stmt in that derived-type-def. ++ ++program main ++ implicit none ++ ! ERROR: Type parameter, component, or procedure binding 'k' already defined in this type ++ type matrix(k,d) ++ integer,kind :: k ++ integer,len :: d ++ integer,len :: k ++ end type ++end +\ No newline at end of file +diff --git a/test/Semantics/0722_C743_public.f90 b/test/Semantics/0722_C743_public.f90 +new file mode 100644 +index 0000000..f0b05c9 +--- /dev/null ++++ b/test/Semantics/0722_C743_public.f90 +@@ -0,0 +1,16 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: Attribute 'PUBLIC' cannot be used more than once ++ private ++ integer,public,public :: i ++ REAL :: r ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0723_C743_private.f90 b/test/Semantics/0723_C743_private.f90 +new file mode 100644 +index 0000000..b0be948 +--- /dev/null ++++ b/test/Semantics/0723_C743_private.f90 +@@ -0,0 +1,15 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: Attribute 'PRIVATE' cannot be used more than once ++ integer,private,private :: i ++ REAL :: r ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0724_C743_allocatable.f90 b/test/Semantics/0724_C743_allocatable.f90 +new file mode 100644 +index 0000000..ac3d9b7 +--- /dev/null ++++ b/test/Semantics/0724_C743_allocatable.f90 +@@ -0,0 +1,15 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: Attribute 'ALLOCATABLE' cannot be used more than once ++ integer,allocatable,allocatable :: i ++ real :: r ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0725_C743_codimension.f90 b/test/Semantics/0725_C743_codimension.f90 +new file mode 100644 +index 0000000..5239acd +--- /dev/null ++++ b/test/Semantics/0725_C743_codimension.f90 +@@ -0,0 +1,14 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Attribute 'CODIMENSION' cannot be used more than once ++ real,allocatable,codimension [:,:,:],codimension [:,:,:] :: g(:,:,:) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0726_C743_contiguous.f90 b/test/Semantics/0726_C743_contiguous.f90 +new file mode 100644 +index 0000000..ba88828 +--- /dev/null ++++ b/test/Semantics/0726_C743_contiguous.f90 +@@ -0,0 +1,14 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: Attribute 'CONTIGUOUS' cannot be used more than once ++ real,pointer,contiguous,contiguous :: g(:) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0727_C743_pointer.f90 b/test/Semantics/0727_C743_pointer.f90 +new file mode 100644 +index 0000000..49e01ab +--- /dev/null ++++ b/test/Semantics/0727_C743_pointer.f90 +@@ -0,0 +1,14 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! WARNING: Attribute 'POINTER' cannot be used more than once ++ real,pointer,contiguous,pointer :: g(:) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0728_C743_dimension.f90 b/test/Semantics/0728_C743_dimension.f90 +new file mode 100644 +index 0000000..303ae2b +--- /dev/null ++++ b/test/Semantics/0728_C743_dimension.f90 +@@ -0,0 +1,14 @@ ++! Test C743: No component-attr-spec shall appear more ++! than once in a given component-def-stmt. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Attribute 'DIMENSION' cannot be used more than once ++ real,dimension(2,2),dimension(2,2) :: g ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0729_C744.f90 b/test/Semantics/0729_C744.f90 +new file mode 100644 +index 0000000..884df94 +--- /dev/null ++++ b/test/Semantics/0729_C744.f90 +@@ -0,0 +1,15 @@ ++! Test C744: If neither the POINTER nor the ALLOCATABLE attribute is ++! specified, the declaration-type-spec in the component-def-stmt shall ++! specify an intrinsic type or a previously defined derived type. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: CLASS entity 'g' must be a dummy argument or have ALLOCATABLE or POINTER attribute ++ class(*) :: g ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0730_C745_array.f90 b/test/Semantics/0730_C745_array.f90 +new file mode 100644 +index 0000000..dda723d +--- /dev/null ++++ b/test/Semantics/0730_C745_array.f90 +@@ -0,0 +1,14 @@ ++! Test C745: If the POINTER or ALLOCATABLE attribute is specified, ++! each component-array-spec shall be a deferred-shape-spec-list. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Array pointer component 'g' must have deferred shape ++ real,pointer :: g(5) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0731_C745_allocatable.f90 b/test/Semantics/0731_C745_allocatable.f90 +new file mode 100644 +index 0000000..b5f4257 +--- /dev/null ++++ b/test/Semantics/0731_C745_allocatable.f90 +@@ -0,0 +1,14 @@ ++! Test C745: If the POINTER or ALLOCATABLE attribute is specified, ++! each component-array-spec shall be a deferred-shape-spec-list. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Allocatable array component 'g' must have deferred shape ++ real,allocatable :: g(5) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0732_C746_explicit.f90 b/test/Semantics/0732_C746_explicit.f90 +new file mode 100644 +index 0000000..a837325 +--- /dev/null ++++ b/test/Semantics/0732_C746_explicit.f90 +@@ -0,0 +1,14 @@ ++! Test C746: If a coarray-spec appears, it shall be a deferred-coshape-spec-list \ ++! and the component shall have the ALLOCATABLE attribute. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: 'g' is an ALLOCATABLE coarray and must have a deferred coshape ++ real,allocatable :: g[5:*] ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0733_C746_noAlloc.f90 b/test/Semantics/0733_C746_noAlloc.f90 +new file mode 100644 +index 0000000..7f47456 +--- /dev/null ++++ b/test/Semantics/0733_C746_noAlloc.f90 +@@ -0,0 +1,14 @@ ++! Test C746: If a coarray-spec appears, it shall be a deferred-coshape-spec-list \ ++! and the component shall have the ALLOCATABLE attribute. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Component 'g' is a coarray and must have the ALLOCATABLE attribute and have a deferred coshape ++ real :: g[5:*] ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0735_C747_ptr.f90 b/test/Semantics/0735_C747_ptr.f90 +new file mode 100644 +index 0000000..341c64a +--- /dev/null ++++ b/test/Semantics/0735_C747_ptr.f90 +@@ -0,0 +1,16 @@ ++! Test C747: If a coarray-spec appears, the component shall not be of ++! type C_PTR or C_FUNPTR from the intrinsic module ISO_C_BINDING (18.2), ++! or of type TEAM_TYPE from the intrinsic module ISO_FORTRAN_ENV (16.10.2). ++ ++module types ++ use, intrinsic :: iso_c_binding ++ ! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component ++ type, bind(c) :: t ++ ! ERROR: Coarray 's' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR ++ type(c_ptr),allocatable :: s[:] ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0736_C747_funptr.f90 b/test/Semantics/0736_C747_funptr.f90 +new file mode 100644 +index 0000000..51d4d25 +--- /dev/null ++++ b/test/Semantics/0736_C747_funptr.f90 +@@ -0,0 +1,16 @@ ++! Test C747: If a coarray-spec appears, the component shall not be of ++! type C_PTR or C_FUNPTR from the intrinsic module ISO_C_BINDING (18.2), ++! or of type TEAM_TYPE from the intrinsic module ISO_FORTRAN_ENV (16.10.2). ++ ++module types ++ use, intrinsic :: iso_c_binding ++ ! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component ++ type, bind(c) :: t ++ ! ERROR: Coarray 's' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR ++ type(c_funptr),allocatable :: s[:] ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0737_C747_team.f90 b/test/Semantics/0737_C747_team.f90 +new file mode 100644 +index 0000000..124ddf2 +--- /dev/null ++++ b/test/Semantics/0737_C747_team.f90 +@@ -0,0 +1,16 @@ ++! Test C747: If a coarray-spec appears, the component shall not be of ++! type C_PTR or C_FUNPTR from the intrinsic module ISO_C_BINDING (18.2), ++! or of type TEAM_TYPE from the intrinsic module ISO_FORTRAN_ENV (16.10.2). ++ ++module types ++ use, intrinsic :: iso_fortran_env ++ ! ERROR: Component 's' is a coarray and must have the ALLOCATABLE attribute ++ type :: t ++ ! ERROR: Coarray 's' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR ++ type(team_type):: s[:] ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0738_C749.f90 b/test/Semantics/0738_C749.f90 +new file mode 100644 +index 0000000..203abf7 +--- /dev/null ++++ b/test/Semantics/0738_C749.f90 +@@ -0,0 +1,14 @@ ++! Test C749: If neither the POINTER nor the ALLOCATABLE attribute is specified, ++! each component-array-spec shall be an explicit-shape-spec-list. ++ ++module types ++ implicit none ++ type :: t ++ ! ERROR: Component array 's' without ALLOCATABLE or POINTER attribute must have explicit shape ++ real :: s(:) ++ end type ++end module types ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0739_C750.f90 b/test/Semantics/0739_C750.f90 +new file mode 100644 +index 0000000..7eb4a19 +--- /dev/null ++++ b/test/Semantics/0739_C750.f90 +@@ -0,0 +1,21 @@ ++! Test C750: Each bound in the explicit-shape-spec shall be a specification expression in which there are no ref- ++! erences to specification functions or the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_- ++! TYPE_OF, PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a constant ex- ++! pression, and the value does not depend on the value of a variable. ++ ++module types ++ type t1 ++ real c ++ end type ++ type, extends(t1) :: t2 ++ end type ++ class(t1),pointer :: p,q ++ type :: mt ++ ! ERROR: Invalid specification expression: reference to impure function 'c_sizeof' ++ real :: s(int(c_sizeof(same_type_of(p,q))),8) ++ end type ++end module ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/0740_C751.f90 b/test/Semantics/0740_C751.f90 +new file mode 100644 +index 0000000..92afdbc +--- /dev/null ++++ b/test/Semantics/0740_C751.f90 +@@ -0,0 +1,13 @@ ++! Test C751: A component shall not have both the ALLOCATABLE and POINTER attributes. ++ ++module types ++ type :: mt ++ ! ERROR: 's' may not have both the POINTER and ALLOCATABLE attributes ++ ! ERROR: 's' may not have the POINTER attribute because it is a coarray ++ real,allocatable,pointer :: s[:] ++ end type ++end module ++program main ++ use types ++ implicit none ++end +\ No newline at end of file +diff --git a/test/Semantics/result.md b/test/Semantics/result-07.md +new file mode 100644 +index 0000000..33775be +--- /dev/null ++++ b/test/Semantics/result.md +@@ -0,0 +1,41 @@ ++| Constraint | flang-new | gfortran | ifort | ++| :--------------: | :-------: | :------: | :---: | ++| C729 | ERROR | ERROR | ERROR | ++| C730 abstract | WARNING | ERROR | ERROR | ++| C730 public | WARNING | ERROR | ERROR | ++| C730 private | WARNING | ERROR | ERROR | ++| C730 bind | WARNING | ERROR | ERROR | ++| C730 extends | ERROR | ERROR | ERROR | ++| C731 | ERROR | ERROR | OK | ++| C732 | ERROR | ERROR | ERROR | ++| C733 contains | ERROR | ERROR | ERROR | ++| C733 inherits | ERROR | ERROR | ERROR | ++| C734 abstract | ERROR | ERROR | ERROR | ++| C734 parent | ERROR | ERROR | ERROR | ++| C735 | ERROR | ERROR | ERROR | ++| C738 private | WARNING | ERROR | ERROR | ++| C738 sequence | WARNING | ERROR | ERROR | ++| C739 | ERROR | ERROR | ERROR | ++| C740 one | ERROR | OK | OK | ++| C740 sequence | ERROR | ERROR | ERROR | ++| C741 | ERROR | ERROR | ERROR | ++| C742 noDef | ERROR | ERROR | ERROR | ++| C742 defTwice | ERROR | ERROR | ERROR | ++| C743 public | WARNING | ERROR | ERROR | ++| C743 private | WARNING | ERROR | ERROR | ++| C743 allocatable | WARNING | ERROR | ERROR | ++| C743 codimension | ERROR | ERROR | ERROR | ++| C743 contiguous | WARNING | ERROR | ERROR | ++| C743 pointer | WARNING | ERROR | ERROR | ++| C743 dimension | WARNING | ERROR | ERROR | ++| C744 | ERROR | ERROR | ERROR | ++| C745 array | ERROR | ERROR | ERROR | ++| C745 allocatable | ERROR | ERROR | ERROR | ++| C746 explicit | ERROR | ERROR | ERROR | ++| C746 noAlloc | ERROR | ERROR | ERROR | ++| C747 ptr | ERROR | ERROR | ERROR | ++| C747 funptr | ERROR | ERROR | ERROR | ++| C747 team | ERROR | ERROR | ERROR | ++| C749 | ERROR | ERROR | ERROR | ++| C750 | ERROR | ERROR | ERROR | ++| C751 | ERROR | ERROR | ERROR | diff --git a/flang.spec b/flang.spec index d7e263d..5e5771e 100644 --- a/flang.spec +++ b/flang.spec @@ -2,7 +2,7 @@ Name: flang Version: flang_20210324 -Release: 10 +Release: 11 Summary: Fortran language compiler targeting LLVM License: Apache-2.0 @@ -16,6 +16,7 @@ Patch1: 2-inline_f90_str_copy_klen.patch Patch2: 3-test-for-interoperability-with-c-fortran-call-c.patch Patch3: 4-add-test-cases-for-openmp-optimization.patch Patch4: 5-test-for-interoperability-with-c-c-call-fortran.patch +Patch5: 6-Add-test-cases-for-types.patch %description Flang depends on a fork of the LLVM project (https://github.com/flang-compiler/classic-flang-llvm-project). The fork made some changes to the upstream LLVM project to support Flang toolchain. Flang cannot build independently for now. @@ -37,6 +38,9 @@ TODO: support build Flang. %changelog +* Mon Oct 24 2022 MinchaoLiang - flang_20210324-11 +- Add patch for add test cases for types + * Fri Oct 21 2022 xieyihui - flang_20210324-10 - Fix 3-test-for-interoperability-with-c-fortran-call-c.patch for add new test cases and fix test cases about bindc and Fix 5-test-for-interoperability-with-c-c-call-fortran.patch for test cases about function -- Gitee