mirror of
				https://github.com/sharkdp/bat.git
				synced 2025-10-30 22:54:07 +00:00 
			
		
		
		
	Add Fortran (Modern) syntax test file
This commit is contained in:
		
				
					committed by
					
						 David Peter
						David Peter
					
				
			
			
				
	
			
			
			
						parent
						
							d395f64f58
						
					
				
				
					commit
					702b5caf2d
				
			
							
								
								
									
										119
									
								
								tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										119
									
								
								tests/syntax-tests/source/Fortran (Modern)/test_savetxt.f90
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,119 @@ | ||||
| program test_savetxt | ||||
| use stdlib_kinds, only: int32, sp, dp | ||||
| use stdlib_io, only: loadtxt, savetxt | ||||
| use stdlib_error, only: check | ||||
| implicit none | ||||
|  | ||||
| character(:), allocatable :: outpath | ||||
|  | ||||
| outpath = get_outpath() // "/tmp.dat" | ||||
|  | ||||
| call test_iint32(outpath) | ||||
| call test_rsp(outpath) | ||||
| call test_rdp(outpath) | ||||
| call test_csp(outpath) | ||||
| call test_cdp(outpath) | ||||
|  | ||||
| contains | ||||
|  | ||||
|     function get_outpath() result(outpath) | ||||
|     integer :: ierr | ||||
|     character(256) :: argv | ||||
|     character(:), allocatable :: outpath | ||||
|  | ||||
|     call get_command_argument(1, argv, status=ierr) | ||||
|     if (ierr==0) then | ||||
|         outpath = trim(argv) | ||||
|     else | ||||
|         outpath = '.' | ||||
|     endif | ||||
|     end function get_outpath | ||||
|  | ||||
|     subroutine test_iint32(outpath) | ||||
|     character(*), intent(in) :: outpath | ||||
|     integer(int32) :: d(3, 2), e(2, 3) | ||||
|     integer(int32), allocatable :: d2(:, :) | ||||
|     d = reshape([1, 2, 3, 4, 5, 6], [3, 2]) | ||||
|     call savetxt(outpath, d) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [3, 2])) | ||||
|     call check(all(abs(d-d2) == 0)) | ||||
|  | ||||
|     e = reshape([1, 2, 3, 4, 5, 6], [2, 3]) | ||||
|     call savetxt(outpath, e) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [2, 3])) | ||||
|     call check(all(abs(e-d2) == 0)) | ||||
|     end subroutine | ||||
|  | ||||
|  | ||||
|     subroutine test_rsp(outpath) | ||||
|     character(*), intent(in) :: outpath | ||||
|     real(sp) :: d(3, 2), e(2, 3) | ||||
|     real(sp), allocatable :: d2(:, :) | ||||
|     d = reshape([1, 2, 3, 4, 5, 6], [3, 2]) | ||||
|     call savetxt(outpath, d) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [3, 2])) | ||||
|     call check(all(abs(d-d2) < epsilon(1._sp))) | ||||
|  | ||||
|     e = reshape([1, 2, 3, 4, 5, 6], [2, 3]) | ||||
|     call savetxt(outpath, e) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [2, 3])) | ||||
|     call check(all(abs(e-d2) < epsilon(1._sp))) | ||||
|     end subroutine test_rsp | ||||
|  | ||||
|  | ||||
|     subroutine test_rdp(outpath) | ||||
|     character(*), intent(in) :: outpath | ||||
|     real(dp) :: d(3, 2), e(2, 3) | ||||
|     real(dp), allocatable :: d2(:, :) | ||||
|     d = reshape([1, 2, 3, 4, 5, 6], [3, 2]) | ||||
|     call savetxt(outpath, d) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [3, 2])) | ||||
|     call check(all(abs(d-d2) < epsilon(1._dp))) | ||||
|  | ||||
|     e = reshape([1, 2, 3, 4, 5, 6], [2, 3]) | ||||
|     call savetxt(outpath, e) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [2, 3])) | ||||
|     call check(all(abs(e-d2) < epsilon(1._dp))) | ||||
|     end subroutine test_rdp | ||||
|  | ||||
|     subroutine test_csp(outpath) | ||||
|     character(*), intent(in) :: outpath | ||||
|     complex(sp) :: d(3, 2), e(2, 3) | ||||
|     complex(sp), allocatable :: d2(:, :) | ||||
|     d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2]) | ||||
|     call savetxt(outpath, d) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [3, 2])) | ||||
|     call check(all(abs(d-d2) < epsilon(1._sp))) | ||||
|  | ||||
|     e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3]) | ||||
|     call savetxt(outpath, e) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [2, 3])) | ||||
|     call check(all(abs(e-d2) < epsilon(1._sp))) | ||||
|     end subroutine test_csp | ||||
|  | ||||
|     subroutine test_cdp(outpath) | ||||
|     character(*), intent(in) :: outpath | ||||
|     complex(dp) :: d(3, 2), e(2, 3) | ||||
|     complex(dp), allocatable :: d2(:, :) | ||||
|     d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2]) | ||||
|     call savetxt(outpath, d) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [3, 2])) | ||||
|     call check(all(abs(d-d2) < epsilon(1._dp))) | ||||
|  | ||||
|     e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3]) | ||||
|     call savetxt(outpath, e) | ||||
|     call loadtxt(outpath, d2) | ||||
|     call check(all(shape(d2) == [2, 3])) | ||||
|     call check(all(abs(e-d2) < epsilon(1._dp))) | ||||
|     end subroutine test_cdp | ||||
|  | ||||
| end program test_savetxt | ||||
		Reference in New Issue
	
	Block a user