[thirdparty/gcc.git] / gcc / testsuite / g77.f-torture / execute / select.f

C   integer byte case with integer byte parameters as case(s)
        subroutine ib
        integer *1 a /1/
        integer *1  one,two,three
        parameter (one=1,two=2,three=3)
        select case (a)
        case (one)
        case (two)
           call abort
        case (three)
           call abort
        case default
           call abort
        end select
        print*,'normal ib'
        end
C   integer halfword case with integer halfword parameters
        subroutine ih
        integer *2 a /1/
        integer *2  one,two,three
        parameter (one=1,two=2,three=3)
        select case (a)
        case (one)
        case (two)
           call abort
        case (three)
           call abort
        case default
           call abort
        end select
        print*,'normal ih'
        end
C   integer case with integer parameters
        subroutine iw
        integer *4 a /1/
        integer *4  one,two,three
        parameter (one=1,two=2,three=3)
        select case (a)
        case (one)
        case (two)
           call abort
        case (three)
           call abort
        case default
           call abort
        end select
        print*,'normal iw'
        end
C   integer double case with integer double parameters
        subroutine id
        integer *8 a /1/
        integer *8  one,two,three
        parameter (one=1,two=2,three=3)
        select case (a)
        case (one)
        case (two)
           call abort
        case (three)
           call abort
        case default
           call abort
        end select
        print*,'normal id'
        end
C   integer byte select with integer case
       subroutine ib_mixed
       integer*1 s /1/
       select case (s)
       case (1)
       case (2)
         call abort
       end select
       print*,'ib ok'
       end
C   integer halfword with integer case
       subroutine ih_mixed
       integer*2 s /1/
       select case (s)
       case (1)
       case default
         call abort
       end select
       print*,'ih ok'
       end
C   integer word with integer case
       subroutine iw_mixed
       integer s /5/
       select case (s)
       case (1)
          call abort
       case (2)
          call abort
       case (3)
          call abort
       case (4)
          call abort
       case (5)
C                   
       case (6)
           call abort
       case default
           call abort
       end select
       print*,'iw ok'
       end
C   integer doubleword with integer case
       subroutine id_mixed
       integer *8 s /1024/
       select case (s)
       case (1)
           call abort
       case (1023)
           call abort
       case (1025)
           call abort
       case (1024)
C
       end select
       print*,'i8 ok'
       end
       subroutine l1_mixed
       logical*1 s /.TRUE./
       select case (s)
       case (.TRUE.)
       case (.FALSE.)
          call abort
       end select
       print*,'l1 ok'
       end
       subroutine l2_mixed
       logical*2 s /.FALSE./
       select case (s)
       case (.TRUE.)
           call abort
       case (.FALSE.)
       end select
       print*,'lh ok'
       end
       subroutine l4_mixed
       logical*4 s /.TRUE./
       select case (s)
       case (.FALSE.)
         call abort
       case (.TRUE.)
       end select
       print*,'lw ok'
       end
       subroutine l8_mixed
       logical*8 s /.TRUE./
       select case (s)
       case (.TRUE.)
       case (.FALSE.)
          call abort
       end select
       print*,'ld ok'
       end
C   main
C -- regression cases
        call ib
        call ih
        call iw
        call id
C -- new functionality
        call ib_mixed
        call ih_mixed
        call iw_mixed
        call id_mixed
        end
Commit	Line	Data
8e5578ea	1	C integer byte case with integer byte parameters as case(s)
	2	subroutine ib
	3	integer *1 a /1/
	4	integer *1 one,two,three
	5	parameter (one=1,two=2,three=3)
	6	select case (a)
	7	case (one)
	8	case (two)
	9	call abort
	10	case (three)
	11	call abort
	12	case default
	13	call abort
	14	end select
	15	print*,'normal ib'
	16	end
	17	C integer halfword case with integer halfword parameters
	18	subroutine ih
	19	integer *2 a /1/
	20	integer *2 one,two,three
	21	parameter (one=1,two=2,three=3)
	22	select case (a)
	23	case (one)
	24	case (two)
	25	call abort
	26	case (three)
	27	call abort
	28	case default
	29	call abort
	30	end select
	31	print*,'normal ih'
	32	end
	33	C integer case with integer parameters
	34	subroutine iw
	35	integer *4 a /1/
	36	integer *4 one,two,three
	37	parameter (one=1,two=2,three=3)
	38	select case (a)
	39	case (one)
	40	case (two)
	41	call abort
	42	case (three)
	43	call abort
	44	case default
	45	call abort
	46	end select
	47	print*,'normal iw'
	48	end
	49	C integer double case with integer double parameters
	50	subroutine id
	51	integer *8 a /1/
	52	integer *8 one,two,three
	53	parameter (one=1,two=2,three=3)
	54	select case (a)
	55	case (one)
	56	case (two)
	57	call abort
	58	case (three)
	59	call abort
	60	case default
	61	call abort
	62	end select
	63	print*,'normal id'
	64	end
65	C integer byte select with integer case
66	subroutine ib_mixed
67	integer*1 s /1/
68	select case (s)
69	case (1)
70	case (2)
71	call abort
72	end select
73	print*,'ib ok'
74	end
75	C integer halfword with integer case
76	subroutine ih_mixed
77	integer*2 s /1/
78	select case (s)
79	case (1)
80	case default
81	call abort
82	end select
83	print*,'ih ok'
84	end
85	C integer word with integer case
86	subroutine iw_mixed
87	integer s /5/
88	select case (s)
89	case (1)
90	call abort
91	case (2)
92	call abort
93	case (3)
94	call abort
95	case (4)
96	call abort
97	case (5)
98	C
99	case (6)
100	call abort
101	case default
102	call abort
103	end select
104	print*,'iw ok'
105	end
106	C integer doubleword with integer case
107	subroutine id_mixed
108	integer *8 s /1024/
109	select case (s)
110	case (1)
111	call abort
112	case (1023)
113	call abort
114	case (1025)
115	call abort
116	case (1024)
117	C
118	end select
119	print*,'i8 ok'
120	end
121	subroutine l1_mixed
122	logical*1 s /.TRUE./
123	select case (s)
124	case (.TRUE.)
125	case (.FALSE.)
126	call abort
127	end select
128	print*,'l1 ok'
129	end
130	subroutine l2_mixed
131	logical*2 s /.FALSE./
132	select case (s)
133	case (.TRUE.)
134	call abort
135	case (.FALSE.)
136	end select
137	print*,'lh ok'
138	end
139	subroutine l4_mixed
140	logical*4 s /.TRUE./
141	select case (s)
142	case (.FALSE.)
143	call abort
144	case (.TRUE.)
145	end select
146	print*,'lw ok'
147	end
148	subroutine l8_mixed
149	logical*8 s /.TRUE./
150	select case (s)
151	case (.TRUE.)
152	case (.FALSE.)
153	call abort
154	end select
155	print*,'ld ok'
156	end
157	C main
158	C -- regression cases
159	call ib
160	call ih
161	call iw
162	call id
163	C -- new functionality
164	call ib_mixed
165	call ih_mixed
166	call iw_mixed
167	call id_mixed
168	end
169
170
171
172
173