Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/char_unpack_2.f90 @ 132:d34655255c78
update gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 10:21:07 +0900 |
parents | 84e7813d76e9 |
children |
comparison
equal
deleted
inserted
replaced
130:e108057fa461 | 132:d34655255c78 |
---|---|
20 call test (unpack (vector, mask, field)) | 20 call test (unpack (vector, mask, field)) |
21 contains | 21 contains |
22 subroutine test (a) | 22 subroutine test (a) |
23 character (len = slen), dimension (:, :) :: a | 23 character (len = slen), dimension (:, :) :: a |
24 | 24 |
25 if (size (a, 1) .ne. n1) call abort | 25 if (size (a, 1) .ne. n1) STOP 1 |
26 if (size (a, 2) .ne. n2) call abort | 26 if (size (a, 2) .ne. n2) STOP 2 |
27 | 27 |
28 i = 0 | 28 i = 0 |
29 do i2 = 1, n2 | 29 do i2 = 1, n2 |
30 do i1 = 1, n1 | 30 do i1 = 1, n1 |
31 if (mask (i1, i2)) then | 31 if (mask (i1, i2)) then |
32 i = i + 1 | 32 i = i + 1 |
33 if (a (i1, i2) .ne. vector (i)) call abort | 33 if (a (i1, i2) .ne. vector (i)) STOP 3 |
34 else | 34 else |
35 if (a (i1, i2) .ne. field) call abort | 35 if (a (i1, i2) .ne. field) STOP 4 |
36 end if | 36 end if |
37 end do | 37 end do |
38 end do | 38 end do |
39 end subroutine test | 39 end subroutine test |
40 end program main | 40 end program main |