diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_16.f90 | 51 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_72.f03 | 110 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_73.f03 | 18 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_74.f03 | 48 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_75.f03 | 35 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_76.f03 | 21 |
6 files changed, 283 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/contiguous_16.f90 b/gcc/testsuite/gfortran.dg/contiguous_16.f90 new file mode 100644 index 0000000..ae1ba26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_16.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! { dg-options "-O2 -fdump-tree-original" } +! +! PR fortran/122977 - associate to a contiguous pointer + +program foo + integer, dimension(:), pointer, contiguous :: a + integer, dimension(:), allocatable :: u + allocate (a(4), u(4)) + if (.not. is_contiguous(a)) error stop 1 ! optimized + if (.not. is_contiguous(u)) error stop 2 ! optimized + + associate (b => a) + if (.not. is_contiguous(b)) error stop 3 ! optimized + associate (c => b) + if (.not. is_contiguous(c)) error stop 4 ! optimized + end associate + associate (c => b(1::2)) + if (is_contiguous(c)) stop 11 ! runtime check + end associate + end associate + + associate (v => u) + if (.not. is_contiguous(v)) error stop 5 ! optimized + associate (w => v) + if (.not. is_contiguous(w)) error stop 6 ! optimized + end associate + associate (w => v(1::2)) + if (is_contiguous(w)) stop 12 ! runtime check + end associate + end associate + + associate (b => a(1::2)) + if (is_contiguous(b)) stop 13 ! runtime check + associate (c => b) + if (is_contiguous(c)) stop 14 ! runtime check + end associate + end associate + + associate (v => u(1::2)) + if (is_contiguous(v)) stop 15 ! runtime check + associate (w => v) + if (is_contiguous(w)) stop 16 ! runtime check + end associate + end associate + + deallocate (a, u) +end program foo + +! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 6 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pdt_72.f03 b/gcc/testsuite/gfortran.dg/pdt_72.f03 new file mode 100644 index 0000000..57640bd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_72.f03 @@ -0,0 +1,110 @@ +! { dg-do compile } +! +! Tests the fix for pr122578, which failed in compilation with the errors +! shown below. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module tensor_map_m + use iso_c_binding, only : c_int + implicit none + + type tensor_t(k) + integer, kind :: k = kind(1.) + real(k), allocatable :: values_(:) ! Error: Cannot convert REAL(0) to REAL(4) at (1) + contains + generic :: values => default_real_values + procedure default_real_values + end type + + interface + pure module function default_real_values(self) result(tensor_values) + implicit none + class(tensor_t), intent(in) :: self + real, allocatable :: tensor_values(:) + end function + end interface + + type tensor_map_t(k) + integer, kind :: k = kind(1.) + real(k), dimension(:), allocatable :: intercept_, slope_ + contains + generic :: map_to_training_range => default_real_map_to_training_range + procedure :: default_real_map_to_training_range + generic :: map_from_training_range => default_real_map_from_training_range + procedure :: default_real_map_from_training_range + end type + + interface + elemental module function default_real_map_to_training_range(self, tensor) result(normalized_tensor) + implicit none + class(tensor_map_t), intent(in) :: self + type(tensor_t), intent(in) :: tensor + type(tensor_t) normalized_tensor + end function + + elemental module function default_real_map_from_training_range(self, tensor) result(unnormalized_tensor) + implicit none + class(tensor_map_t), intent(in) :: self + type(tensor_t), intent(in) :: tensor + type(tensor_t) unnormalized_tensor + end function + end interface + + type activation_t + integer(c_int) :: selection_ + contains + generic :: evaluate => default_real_evaluate + procedure default_real_evaluate + end type + + interface + elemental module function default_real_evaluate(self, x) result(y) + implicit none + class(activation_t), intent(in) :: self + real, intent(in) :: x + real y + end function + end interface + + type neural_network_t(k) + integer, kind :: k = kind(1.) + type(tensor_map_t(k)) input_map_, output_map_ + real(k), allocatable :: weights_(:,:,:), biases_(:,:) + integer, allocatable :: nodes_(:) + type(activation_t) :: activation_ + contains + generic :: infer => default_real_infer + procedure default_real_infer + end type + + integer, parameter :: input_layer = 0 +contains + elemental function default_real_infer(self, inputs) result(outputs) + class(neural_network_t), intent(in) :: self + type(tensor_t), intent(in) :: inputs + type(tensor_t) outputs + real, allocatable :: a(:,:) + integer l + associate(w => self%weights_, b => self%biases_, n => self%nodes_, output_layer => ubound(self%nodes_,1)) + allocate(a(maxval(n), input_layer:output_layer)) + associate(normalized_inputs => self%input_map_%map_to_training_range(inputs)) + a(1:n(input_layer),input_layer) = normalized_inputs%values() ! Error: Symbol ‘normalized_inputs’ + ! at (1) has no IMPLICIT type + + end associate + feed_forward: & + do l = input_layer+1, output_layer + associate(z => matmul(w(1:n(l),1:n(l-1),l), a(1:n(l-1),l-1)) + b(1:n(l),l)) + a(1:n(l),l) = self%activation_%evaluate(z) + end associate + end do feed_forward + associate(normalized_outputs => tensor_t(a(1:n(output_layer), output_layer))) + outputs = self%output_map_%map_from_training_range(normalized_outputs) ! Error: Found no matching specific + ! binding for the call to the GENERIC + ! ‘map_from_training_range’ at (1) + + end associate + end associate + end function +end module diff --git a/gcc/testsuite/gfortran.dg/pdt_73.f03 b/gcc/testsuite/gfortran.dg/pdt_73.f03 new file mode 100644 index 0000000..63a9234 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_73.f03 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! Tests the fix for pr122669, which falied with the error below. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! + implicit none + type tensor_t + real, allocatable :: values_ + end type + type(tensor_t) :: random_inputs(1) + type(tensor_t), allocatable :: outputs(:) + + random_inputs = [tensor_t(1.0)] + allocate(outputs, mold=random_inputs) ! Error: Array specification or array-valued + ! SOURCE= expression required in ALLOCATE statement at (1) + print *, size(outputs) +end diff --git a/gcc/testsuite/gfortran.dg/pdt_74.f03 b/gcc/testsuite/gfortran.dg/pdt_74.f03 new file mode 100644 index 0000000..c12db79 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_74.f03 @@ -0,0 +1,48 @@ +! { dg-do compile } +! +! Tests the fix for pr122670, where use only did not compile for PDTs. Also, it +! was found in the course of developing the fix that import only did not work +! either. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module tensor_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(0.) + real(k), allocatable :: value_ + end type + + interface + function myfunc (arg) + import tensor_t + implicit none + type (tensor_t) myfunc + type (tensor_t), intent(in) :: arg + end function + end interface + +contains + function y(x) + type(tensor_t) x, y + y = tensor_t(x%value_) + end function +end module + +function myfunc (arg) + use tensor_m, only : tensor_t + implicit none + type (tensor_t) myfunc + type (tensor_t), intent(in) :: arg + myfunc = arg + myfunc%value_ = myfunc%value_ * 2.0 +end function + + use tensor_m, only : tensor_t, y, myfunc + implicit none + type(tensor_t) desired_output + desired_output = y(tensor_t(42.)) + desired_output = myfunc (desired_output) + print *, desired_output%value_ +end diff --git a/gcc/testsuite/gfortran.dg/pdt_75.f03 b/gcc/testsuite/gfortran.dg/pdt_75.f03 new file mode 100644 index 0000000..f700871 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_75.f03 @@ -0,0 +1,35 @@ +! { dg-do compile } +! +! Tests the fix for pr122693, which failed in compilation with the errors +! shown below. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module tensor_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(0.) + end type + + interface tensor_t + module function tensor(unused_stuff) + implicit none + real unused_stuff + type(tensor_t) tensor + end function + end interface + +end module + + use tensor_m + implicit none +contains + function test_passed() + logical test_passed + type(tensor_t), allocatable :: tensor_array(:) + real, parameter :: junk = 0. + tensor_array = [tensor_t(junk)] !Error: Symbol ‘junk’ at (1) has no IMPLICIT type + test_passed = .false. !Error: ‘test_passed’ at (1) is not a variable + end function +end diff --git a/gcc/testsuite/gfortran.dg/pdt_76.f03 b/gcc/testsuite/gfortran.dg/pdt_76.f03 new file mode 100644 index 0000000..22c0a3e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_76.f03 @@ -0,0 +1,21 @@ +! { dg-do compile } + +! Make sure that pr103414 is fixed. +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +function p () + type t(n) + integer, kind :: n + character(n) :: c = '' + end type + type(t(3)) :: x = t(z'1') ! { dg-error "Expected an initialization expression" } +end + +function q () + type t(n) + integer, kind :: n + character(n) :: c = '' + end type + type(t(3)) :: x(1) = [t(z'1')] ! { dg-error "Syntax error in array constructor" } +end |