From 2241d969a3734b5d5941ef51987b511252ba3210 Mon Sep 17 00:00:00 2001 From: wzw Date: Fri, 21 Oct 2022 16:33:11 +0800 Subject: [PATCH] Add test cases for attribute declarations and specifications --- ...bute-declarations-and-specifications.patch | 645 ++++++++++++++++++ flang.spec | 13 +- 2 files changed, 657 insertions(+), 1 deletion(-) create mode 100644 6-add-test-cases-for-attribute-declarations-and-specifications.patch diff --git a/6-add-test-cases-for-attribute-declarations-and-specifications.patch b/6-add-test-cases-for-attribute-declarations-and-specifications.patch new file mode 100644 index 0000000..40cba5a --- /dev/null +++ b/6-add-test-cases-for-attribute-declarations-and-specifications.patch @@ -0,0 +1,645 @@ +commit b42d6323c2d4fb4802e1276bfbb16b5947b99b27 +Author: wzw +Date: Fri Oct 21 16:20:02 2022 +0800 + + [flang] Add test cases for attribute declarations and specifications + + Add test cases for attribute declarations and specifications + +diff --git a/test/Semantics/0801_C801_allocatable.f90 b/test/Semantics/0801_C801_allocatable.f90 +new file mode 100644 +index 0000000..60d8773 +--- /dev/null ++++ b/test/Semantics/0801_C801_allocatable.f90 +@@ -0,0 +1,8 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++program main ++ implicit none ++ ! WARNING: Attribute 'ALLOCATABLE' cannot be used more than once ++ real, allocatable, allocatable :: darray(:) ++end program main +diff --git a/test/Semantics/0802_C801_contiguous.f90 b/test/Semantics/0802_C801_contiguous.f90 +new file mode 100644 +index 0000000..e570a19 +--- /dev/null ++++ b/test/Semantics/0802_C801_contiguous.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++program main ++ ! WARNING: Attribute 'CONTIGUOUS' cannot be used more than once ++ integer, contiguous, contiguous, pointer :: a(:) ++end program main +diff --git a/test/Semantics/0803_C801_dimension.f90 b/test/Semantics/0803_C801_dimension.f90 +new file mode 100644 +index 0000000..10aee7d +--- /dev/null ++++ b/test/Semantics/0803_C801_dimension.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++SUBROUTINE SUB(I,M) ++ ! ERROR: Attribute 'DIMENSION' cannot be used more than once ++ INTEGER, ALLOCATABLE, DIMENSION(:,:), DIMENSION(:,:) :: A ++END SUBROUTINE +diff --git a/test/Semantics/0804_C801_external.f90 b/test/Semantics/0804_C801_external.f90 +new file mode 100644 +index 0000000..95e56da +--- /dev/null ++++ b/test/Semantics/0804_C801_external.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'EXTERNAL' cannot be used more than once ++ real, external, external :: func ++end subroutine +diff --git a/test/Semantics/0805_C801_intent.f90 b/test/Semantics/0805_C801_intent.f90 +new file mode 100644 +index 0000000..651c88f +--- /dev/null ++++ b/test/Semantics/0805_C801_intent.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test(a) ++ ! WARNING: Attribute 'INTENT(IN)' cannot be used more than once ++ real, intent(in), intent(in) :: a ++end subroutine +diff --git a/test/Semantics/0806_C801_intrinsic.f90 b/test/Semantics/0806_C801_intrinsic.f90 +new file mode 100644 +index 0000000..99c1cd6 +--- /dev/null ++++ b/test/Semantics/0806_C801_intrinsic.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'INTRINSIC' cannot be used more than once ++ real, intrinsic, intrinsic :: sin ++end subroutine +diff --git a/test/Semantics/0807_C801_optional.f90 b/test/Semantics/0807_C801_optional.f90 +new file mode 100644 +index 0000000..502e687 +--- /dev/null ++++ b/test/Semantics/0807_C801_optional.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test(a) ++ ! WARNING: Attribute 'OPTIONAL' cannot be used more than once ++ real, optional, optional ::a ++end subroutine +diff --git a/test/Semantics/0808_C801_parameter.f90 b/test/Semantics/0808_C801_parameter.f90 +new file mode 100644 +index 0000000..92d3cc5 +--- /dev/null ++++ b/test/Semantics/0808_C801_parameter.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'PARAMETER' cannot be used more than once ++ real, parameter, parameter :: two = 2.0 ++end subroutine +diff --git a/test/Semantics/0809_C801_pointer.f90 b/test/Semantics/0809_C801_pointer.f90 +new file mode 100644 +index 0000000..a366c50 +--- /dev/null ++++ b/test/Semantics/0809_C801_pointer.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'POINTER' cannot be used more than once ++ integer, pointer, pointer :: ptr ++end subroutine +diff --git a/test/Semantics/0810_C801_protected.f90 b/test/Semantics/0810_C801_protected.f90 +new file mode 100644 +index 0000000..9b49243 +--- /dev/null ++++ b/test/Semantics/0810_C801_protected.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'PROTECTED' cannot be used more than once ++ integer, protected, protected :: val ++end subroutine +diff --git a/test/Semantics/0811_C801_save.f90 b/test/Semantics/0811_C801_save.f90 +new file mode 100644 +index 0000000..cd99ebf +--- /dev/null ++++ b/test/Semantics/0811_C801_save.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'SAVE' cannot be used more than once ++ integer, save, save :: a ++end subroutine +diff --git a/test/Semantics/0812_C801_target.f90 b/test/Semantics/0812_C801_target.f90 +new file mode 100644 +index 0000000..7199798 +--- /dev/null ++++ b/test/Semantics/0812_C801_target.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'TARGET' cannot be used more than once ++ real, target, target :: a ++end subroutine +diff --git a/test/Semantics/0813_C801_value.f90 b/test/Semantics/0813_C801_value.f90 +new file mode 100644 +index 0000000..0148f37 +--- /dev/null ++++ b/test/Semantics/0813_C801_value.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test(x) ++ ! WARNING: Attribute 'VALUE' cannot be used more than once ++ integer, value, value :: x ++end subroutine +diff --git a/test/Semantics/0814_C801_volatile.f90 b/test/Semantics/0814_C801_volatile.f90 +new file mode 100644 +index 0000000..7f82dff +--- /dev/null ++++ b/test/Semantics/0814_C801_volatile.f90 +@@ -0,0 +1,7 @@ ++! Test C801: The same attr-spec shall not appear more than once in a given ++! type-declaration-stmt. ++ ++subroutine test() ++ ! WARNING: Attribute 'VOLATILE' cannot be used more than once ++ real, volatile, volatile :: a ++end subroutine +diff --git a/test/Semantics/0815_C802.f90 b/test/Semantics/0815_C802.f90 +new file mode 100644 +index 0000000..20a2ad4 +--- /dev/null ++++ b/test/Semantics/0815_C802.f90 +@@ -0,0 +1,10 @@ ++! If a language-binding-spec with a NAME= specifier appears, the ++! entity-decl-list shall consist of a single entity-decl. ++ ++module m ++ type, bind(c) :: a ++ integer(4) :: j = -1 ++ end type a ++ ! ERROR: Two entities have the same BIND(C) name 'test' ++ type(a), bind(c, name="test") :: t1, t2 ++end +diff --git a/test/Semantics/0816_C803.f90 b/test/Semantics/0816_C803.f90 +new file mode 100644 +index 0000000..0e05772 +--- /dev/null ++++ b/test/Semantics/0816_C803.f90 +@@ -0,0 +1,14 @@ ++! If a language-binding-spec is specified, the entity-decl-list shall ++! not contain any procedure names. ++ ++module m ++ integer, bind(c) :: test ++ contains ++ ! FATAL INTERNAL ERROR: bind name not allowed on this kind of symbol at ++ ! ./install-llvm-flang-f18/llvm-project/flang/lib/Semantics/symbol.cpp(326) ++ !PLEASE submit a bug report to ++ ! https://github.com/llvm/llvm-project/issues/ and include the crash backtrace. ++ ! Stack dump: ++ subroutine test ++ end ++end +diff --git a/test/Semantics/0817_C804.f90 b/test/Semantics/0817_C804.f90 +new file mode 100644 +index 0000000..bb93c9e +--- /dev/null ++++ b/test/Semantics/0817_C804.f90 +@@ -0,0 +1,9 @@ ++! If the entity is not of type character, * char-length shall not appear. ++ ++program m ++ character :: c * 15 ++ ! ERROR: A length specifier cannot be used to declare the non-character ++ ! entity 'd' ++ integer :: d * 15 ++ c = "abc" ++end +diff --git a/test/Semantics/0818_C805.f90 b/test/Semantics/0818_C805.f90 +new file mode 100644 +index 0000000..1e249cf +--- /dev/null ++++ b/test/Semantics/0818_C805.f90 +@@ -0,0 +1,14 @@ ++! A type-param-value in a char-length in an entity-decl shall be a colon, ++! asterisk, or specification expression. ++ ++program main ++ character :: a ++ character(len = 10) :: b ++ call test(b) ++contains ++ subroutine test(x) ++ character(len=*) :: x ++ ! ERROR: Must have INTEGER type, but is CHARACTER(KIND=1,LEN=3_8) ++ character('abc') :: y ++ end ++end program +diff --git a/test/Semantics/0819_C806.f90 b/test/Semantics/0819_C806.f90 +new file mode 100644 +index 0000000..d11d488 +--- /dev/null ++++ b/test/Semantics/0819_C806.f90 +@@ -0,0 +1,7 @@ ++! If initialization appears, a double-colon separator shall appear before the ++! entity-decl-list. ++ ++subroutine test() ++ ! ERROR: expected '::' ++ character(len=15) x = "aaaaa" ++end subroutine +diff --git a/test/Semantics/0820_C807.f90 b/test/Semantics/0820_C807.f90 +new file mode 100644 +index 0000000..1b771a3 +--- /dev/null ++++ b/test/Semantics/0820_C807.f90 +@@ -0,0 +1,7 @@ ++! If the PARAMETER keyword appears, initialization shall appear in each ++! entity-decl. ++ ++subroutine test() ++ ! ERROR: Missing initialization for parameter 'y' ++ character(len=15), parameter :: x="aaaaa", y ++end subroutine +diff --git a/test/Semantics/0821_C808.f90 b/test/Semantics/0821_C808.f90 +new file mode 100644 +index 0000000..e7ac3b8 +--- /dev/null ++++ b/test/Semantics/0821_C808.f90 +@@ -0,0 +1,9 @@ ++! An initialization shall not appear if object-name is a dummy argument, a ++! function result, an object in a named common block unless the type declaration ++! is in a block data program unit, an object in blank common, an allocatable ++! variable, or an automatic data object. ++ ++subroutine test(x) ++ ! ERROR: A dummy argument must not be initialized ++ integer(4) :: x = 10 ++end subroutine +diff --git a/test/Semantics/0822_C811.f90 b/test/Semantics/0822_C811.f90 +new file mode 100644 +index 0000000..d4fa055 +--- /dev/null ++++ b/test/Semantics/0822_C811.f90 +@@ -0,0 +1,11 @@ ++! If => appears in initialization, the entity shall have the POINTER attribute. ++! If = appears in initialization, the entity shall not have the POINTER ++! attribute. ++ ++subroutine test() ++ integer, target :: t = 12 ++ ! ERROR: 'p' is a pointer but is not initialized like one ++ integer, pointer :: p = t ++ ! ERROR: expected '(' ++ ! integer :: x => 10 ++end subroutine +diff --git a/test/Semantics/0823_C812.f90 b/test/Semantics/0823_C812.f90 +new file mode 100644 +index 0000000..d3cc0f8 +--- /dev/null ++++ b/test/Semantics/0823_C812.f90 +@@ -0,0 +1,8 @@ ++! If initial-data-target appears, object-name shall be ++! data-pointer-initialization compatible with it (7.5.4.6) ++ ++subroutine test() ++ integer, target :: t = 12 ++ ! ERROR: Target type INTEGER(4) is not compatible with pointer type REAL(4) ++ real, pointer :: p => t ++end subroutine +diff --git a/test/Semantics/0824_C814.f90 b/test/Semantics/0824_C814.f90 +new file mode 100644 +index 0000000..5758434 +--- /dev/null ++++ b/test/Semantics/0824_C814.f90 +@@ -0,0 +1,9 @@ ++! An automatic data object shall not have the SAVE attribute. ++ ++subroutine test(x, n, m) ++ ! ERROR: SAVE attribute may not be applied to dummy argument 'x' ++ integer, save :: x ++ integer, intent(in) :: n, m ++ ! ERROR: SAVE attribute may not be applied to automatic data object 'temp' ++ real, dimension(n,m), save :: temp ++end subroutine +diff --git a/test/Semantics/0825_C817.f90 b/test/Semantics/0825_C817.f90 +new file mode 100644 +index 0000000..9ca6776 +--- /dev/null ++++ b/test/Semantics/0825_C817.f90 +@@ -0,0 +1,13 @@ ++! An access-spec shall appear only in the specification-part of a module. ++ ++module m ++private ++end ++program main ++! ERROR: PUBLIC statement may only appear in the specification part of a module ++public ++end ++subroutine s ++! ERROR: PRIVATE statement may only appear in the specification part of a module ++private ++end +diff --git a/test/Semantics/0826_C818.f90 b/test/Semantics/0826_C818.f90 +new file mode 100644 +index 0000000..db76647 +--- /dev/null ++++ b/test/Semantics/0826_C818.f90 +@@ -0,0 +1,25 @@ ++! An entity with the BIND attribute shall be a common block, variable, ++! type, or! procedure. ++ ++subroutine test_sub() bind(c, name="test_sub") ++end subroutine ++ ++module test_variable ++ integer, bind(c, name="test_int") :: test_int ++end module test_variable ++ ++module test_type ++ type, bind(c) :: a ++ integer(4) :: j = -1 ++ end type a ++ type(a), bind(c, name="test") :: t ++end module test_type ++ ++program main ++ use, intrinsic :: iso_c_binding ++ integer(kind = c_int) :: a ++ real(kind = c_float) :: b ++ common /c/ a, b ++ save :: /c/ ++ bind(c, name="c") :: /c/ ++end program main +diff --git a/test/Semantics/0827_C819.f90 b/test/Semantics/0827_C819.f90 +new file mode 100644 +index 0000000..64a283a +--- /dev/null ++++ b/test/Semantics/0827_C819.f90 +@@ -0,0 +1,9 @@ ++! A variable with the BIND attribute shall be declared in the specification ++! part of a module. ++ ++subroutine test() ++ ! ERROR: A variable with BIND(C) attribute may only appear in the ++ ! specification part of a module ++ integer :: x ++ bind(c, name="x") :: x ++end subroutine +diff --git a/test/Semantics/0828_C822.f90 b/test/Semantics/0828_C822.f90 +new file mode 100644 +index 0000000..3b05f68 +--- /dev/null ++++ b/test/Semantics/0828_C822.f90 +@@ -0,0 +1,10 @@ ++! The sum of the rank and corank of an entity shall not exceed fifteen. ++ ++subroutine test() ++ ! ERROR: 'a' has rank 16, which is greater than the maximum supported rank 15 ++ integer, dimension(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2) :: a ++end subroutine ++ ++program main ++ call test() ++end program main +diff --git a/test/Semantics/0829_C830.f90 b/test/Semantics/0829_C830.f90 +new file mode 100644 +index 0000000..44e759f +--- /dev/null ++++ b/test/Semantics/0829_C830.f90 +@@ -0,0 +1,10 @@ ++! An entity with the CONTIGUOUS attribute shall be an array pointer, an ++! assumed-shape array, or an assumed-rank dummy data object. ++ ++subroutine test(assumed_shape, assumed_rank) ++ integer, contiguous, pointer :: a(:) ++ integer, intent(in), contiguous, dimension(:) :: assumed_shape ++ integer, contiguous :: assumed_rank(..) ++ ! Do not raised any error. ++ integer, contiguous :: err_test ++end subroutine +diff --git a/test/Semantics/0830_C831.f90 b/test/Semantics/0830_C831.f90 +new file mode 100644 +index 0000000..cd8daa7 +--- /dev/null ++++ b/test/Semantics/0830_C831.f90 +@@ -0,0 +1,14 @@ ++! An explicit-shape-spec whose bounds are not constant expressions shall ++! appear only in a subprogram, derived type definition, BLOCK construct, ++! or interface body. ++ ++subroutine test(n) ++ integer :: n ++ integer, dimension(n, 10) :: a ++end subroutine ++ ++program main ++ integer :: i = 2 ++ ! ERROR: Invalid specification expression: reference to local entity 'i' ++ integer, dimension(i, 10) :: a ++end program main +diff --git a/test/Semantics/0831_C832.f90 b/test/Semantics/0831_C832.f90 +new file mode 100644 +index 0000000..7d2b37f +--- /dev/null ++++ b/test/Semantics/0831_C832.f90 +@@ -0,0 +1,13 @@ ++! An array with the POINTER or ALLOCATABLE attribute shall have an array-spec ++! that is a deferred-shape-spec-list. ++ ++subroutine test() ++ integer :: i = 2 ++ real, pointer, dimension(:) :: a ++ ! ERROR: Array pointer 'b' must have deferred shape or assumed rank ++ real, pointer, dimension(0 : 2) :: b ++ ++ real, allocatable :: c(:) ++ ! ERROR: Allocatable array 'd' must have deferred shape or assumed rank ++ real, allocatable :: d(0 : 2) ++end subroutine +diff --git a/test/Semantics/0832_C833.f90 b/test/Semantics/0832_C833.f90 +new file mode 100644 +index 0000000..61c8f6d +--- /dev/null ++++ b/test/Semantics/0832_C833.f90 +@@ -0,0 +1,13 @@ ++! An object whose array bounds are specified by an assumed-size-spec shall be a ++! dummy data object. ++ ++subroutine test(n) ++ integer :: n ++ integer :: m = 2 ++ ++ ! ERROR: Assumed-size array 'a' must be a dummy argument ++ integer, dimension(n, *) :: a ++ ! ERROR: Assumed-size array 'b' must be a dummy argument ++ ! ERROR: Invalid specification expression: reference to local entity 'm' ++ integer, dimension(m, *):: b ++end subroutine +diff --git a/test/Semantics/0833_C835.f90 b/test/Semantics/0833_C835.f90 +new file mode 100644 +index 0000000..5ed31e9 +--- /dev/null ++++ b/test/Semantics/0833_C835.f90 +@@ -0,0 +1,10 @@ ++! An object whose array bounds are specified by an ++! implied-shape-or-assumed-size-spec shall be a dummy data object or a named ++! constant. ++ ++subroutine test(a) ++ integer, dimension(*) :: a ++ integer, parameter :: b(*) = [1, 2, 3] ++ ! ERROR: Implied-shape array 'c' must be a named constant or a dummy argument ++ integer, dimension(*) :: c ++end subroutine +diff --git a/test/Semantics/0834_C836.f90 b/test/Semantics/0834_C836.f90 +new file mode 100644 +index 0000000..d2bd467 +--- /dev/null ++++ b/test/Semantics/0834_C836.f90 +@@ -0,0 +1,7 @@ ++! An implied-shape array shall be a named constant. ++ ++subroutine test() ++ integer, parameter :: a(*) = [1,2,3] ++ ! ERROR: Missing initialization for parameter 'b' ++ integer, parameter :: b(*) ++end subroutine +diff --git a/test/Semantics/0835_C837.f90 b/test/Semantics/0835_C837.f90 +new file mode 100644 +index 0000000..732951d +--- /dev/null ++++ b/test/Semantics/0835_C837.f90 +@@ -0,0 +1,9 @@ ++! An assumed-rank entity shall be a dummy data object that does not have the ++! CODIMENSION or VALUE attribute. ++ ++subroutine test(a) ++ integer, value :: a(..) ++ ! ERROR: Assumed-rank array 'b' must be a dummy argument ++ ! ERROR: VALUE attribute may apply only to a dummy argument ++ integer, value :: b(..) ++end subroutine +diff --git a/test/Semantics/0836_C840.f90 b/test/Semantics/0836_C840.f90 +new file mode 100644 +index 0000000..63915fa +--- /dev/null ++++ b/test/Semantics/0836_C840.f90 +@@ -0,0 +1,8 @@ ++! An entity shall not have both the EXTERNAL attribute and the INTRINSIC ++! attribute. ++ ++program main ++ ! Do not raised any error! ++ real, external, intrinsic :: sin ++ real, external, intrinsic :: func ++end program main +diff --git a/test/Semantics/0837_C841.f90 b/test/Semantics/0837_C841.f90 +new file mode 100644 +index 0000000..fdf9978 +--- /dev/null ++++ b/test/Semantics/0837_C841.f90 +@@ -0,0 +1,8 @@ ++! In an external subprogram, the EXTERNAL attribute shall not be specified for ++! a procedure defined by the subprogram. ++ ++subroutine test() ++ real :: func ++ ! ERROR: EXTERNAL attribute not allowed on 'test' ++ external test ++end subroutine +diff --git a/test/Semantics/0838_C842.f90 b/test/Semantics/0838_C842.f90 +new file mode 100644 +index 0000000..0329408 +--- /dev/null ++++ b/test/Semantics/0838_C842.f90 +@@ -0,0 +1,17 @@ ++! In an interface body, the EXTERNAL attribute shall not be specified for the ++! procedure declared by the interface body. ++ ++module m ++ interface ++ real function func(x) ++ real, intent(in) :: x ++ real, external :: y ++ end function func ++ end interface ++ ! ERROR: EXTERNAL attribute not allowed on 'func' ++ external func ++end module ++ ++program main ++ use m ++end program main +diff --git a/test/result.md b/test/result.md +new file mode 100644 +index 0000000..aeacc4c +--- /dev/null ++++ b/test/result.md +@@ -0,0 +1,40 @@ ++| Constraint | flang-new | gfortran | ifort | ++| :----------------------------- | :----------------------------- | :----------------------------- | :----------------------------- | ++| C801 allocatable | WARN | ERROR | ERROR | ++| C801 contiguous | WARN | ERROR | ERROR | ++| C801 dimension | ERROR | ERROR | ERROR | ++| C801 external | WARN | ERROR | ERROR | ++| C801 intent | WARN | ERROR | ERROR | ++| C801 intrinsic | WARN | ERROR | ERROR | ++| C801 optional | WARN | ERROR | ERROR | ++| C801 parameter | WARN | ERROR | ERROR | ++| C801 pointer | WARN | ERROR | ERROR | ++| C801 protected | WARN | ERROR | ERROR | ++| C801 save | WARN | ERROR | ERROR | ++| C801 target | WARN | ERROR | ERROR | ++| C801 value | WARN | ERROR | ERROR | ++| C801 volatile | WARN | ERROR | ERROR | ++| C802 | ERROR | ERROR | ERROR | ++| C803 | ICE | ERROR | ERROR | ++| C804 | ERROR | ERROR | ERROR | ++| C805 | ERROR | ERROR | ERROR in ‘program main'
OK in 'subroutine' | ++| C806 | ERROR | ERROR | ERROR | ++| C807 | ERROR | ERROR | ERROR | ++| C808 | ERROR | ERROR | ERROR | ++| C811 | ERROR | ERROR | ERROR | ++| C812 | ERROR | ERROR | ERROR | ++| C814 | ERROR | ERROR | ERROR | ++| C817 | ERROR | ERROR | ERROR | ++| C818 | OK | OK | OK | ++| C819 | ERROR | ERROR | ERROR | ++| C822 | ERROR | ERROR | OK | ++| C830 | OK | ERROR | ERROR | ++| C831 | ERROR | ERROR | ERROR | ++| C832 | ERROR | ERROR | ERROR | ++| C833 | ERROR | ERROR | ERROR | ++| C835 | ERROR | ERROR | ERROR | ++| C836 | ERROR | ERROR | ERROR | ++| C837 | ERROR | ERROR | ERROR | ++| C840 | OK | ERROR | ERROR | ++| C841 | ERROR | ERROR | ERROR | ++| C842 | ERROR | ERROR | ERROR | diff --git a/flang.spec b/flang.spec index 109321e..0ebec4a 100644 --- a/flang.spec +++ b/flang.spec @@ -2,7 +2,7 @@ Name: flang Version: flang_20210324 -Release: 8 +Release: 11 Summary: Fortran language compiler targeting LLVM License: Apache-2.0 @@ -15,6 +15,8 @@ Patch0: 1-flang-runtime-inline.patch Patch1: 2-inline_f90_str_copy_klen.patch Patch2: 3-add-tests-interoperability-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-attribute-declarations-and-specifications.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. @@ -36,6 +38,15 @@ TODO: support build Flang. %changelog +* Fri Oct 21 2022 wangzhewei - flang_20210324-11 +- Add patch for add test cases for attribute declarations and specifications + +* 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 + +* Sun Oct 16 2022 xieyihui - flang_20210324-9 +- Add patch for add test cases for interoperability with C about C call fortran + * Mon Sep 19 2022 xieyihui - flang_20210324-8 - Add patch for add test cases for OpenMP optimization -- Gitee