Bug Summary

File:build/gcc/fortran/parse.cc
Warning:line 6718, column 7
Forming reference to null pointer

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name parse.cc -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-27edQg.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc
1/* Main parser.
2 Copyright (C) 2000-2023 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21#include "config.h"
22#include "system.h"
23#include "coretypes.h"
24#include "options.h"
25#include "gfortran.h"
26#include <setjmp.h>
27#include "match.h"
28#include "parse.h"
29#include "tree-core.h"
30#include "omp-general.h"
31
32/* Current statement label. Zero means no statement label. Because new_st
33 can get wiped during statement matching, we have to keep it separate. */
34
35gfc_st_label *gfc_statement_label;
36
37static locus label_locus;
38static jmp_buf eof_buf;
39
40gfc_state_data *gfc_state_stack;
41static bool last_was_use_stmt = false;
42
43/* TODO: Re-order functions to kill these forward decls. */
44static void check_statement_label (gfc_statement);
45static void undo_new_statement (void);
46static void reject_statement (void);
47
48
49/* A sort of half-matching function. We try to match the word on the
50 input with the passed string. If this succeeds, we call the
51 keyword-dependent matching function that will match the rest of the
52 statement. For single keywords, the matching subroutine is
53 gfc_match_eos(). */
54
55static match
56match_word (const char *str, match (*subr) (void), locus *old_locus)
57{
58 match m;
59
60 if (str != NULL__null)
61 {
62 m = gfc_match (str);
63 if (m != MATCH_YES)
64 return m;
65 }
66
67 m = (*subr) ();
68
69 if (m != MATCH_YES)
70 {
71 gfc_current_locus = *old_locus;
72 reject_statement ();
73 }
74
75 return m;
76}
77
78
79/* Like match_word, but if str is matched, set a flag that it
80 was matched. */
81static match
82match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus,
83 bool *simd_matched)
84{
85 match m;
86
87 if (str != NULL__null)
88 {
89 m = gfc_match (str);
90 if (m != MATCH_YES)
91 return m;
92 *simd_matched = true;
93 }
94
95 m = (*subr) ();
96
97 if (m != MATCH_YES)
98 {
99 gfc_current_locus = *old_locus;
100 reject_statement ();
101 }
102
103 return m;
104}
105
106
107/* Load symbols from all USE statements encountered in this scoping unit. */
108
109static void
110use_modules (void)
111{
112 gfc_error_buffer old_error;
113
114 gfc_push_error (&old_error);
115 gfc_buffer_error (false);
116 gfc_use_modules ();
117 gfc_buffer_error (true);
118 gfc_pop_error (&old_error);
119 gfc_commit_symbols ();
120 gfc_warning_check ();
121 gfc_current_ns->old_equiv = gfc_current_ns->equiv;
122 gfc_current_ns->old_data = gfc_current_ns->data;
123 last_was_use_stmt = false;
124}
125
126
127/* Figure out what the next statement is, (mostly) regardless of
128 proper ordering. The do...while(0) is there to prevent if/else
129 ambiguity. */
130
131#define match(keyword, subr, st) \
132 do { \
133 if (match_word (keyword, subr, &old_locus) == MATCH_YES) \
134 return st; \
135 else \
136 undo_new_statement (); \
137 } while (0)
138
139
140/* This is a specialist version of decode_statement that is used
141 for the specification statements in a function, whose
142 characteristics are deferred into the specification statements.
143 eg.: INTEGER (king = mykind) foo ()
144 USE mymodule, ONLY mykind.....
145 The KIND parameter needs a return after USE or IMPORT, whereas
146 derived type declarations can occur anywhere, up the executable
147 block. ST_GET_FCN_CHARACTERISTICS is returned when we have run
148 out of the correct kind of specification statements. */
149static gfc_statement
150decode_specification_statement (void)
151{
152 gfc_statement st;
153 locus old_locus;
154 char c;
155
156 if (gfc_match_eos () == MATCH_YES)
157 return ST_NONE;
158
159 old_locus = gfc_current_locus;
160
161 if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
162 {
163 last_was_use_stmt = true;
164 return ST_USE;
165 }
166 else
167 {
168 undo_new_statement ();
169 if (last_was_use_stmt)
170 use_modules ();
171 }
172
173 match ("import", gfc_match_import, ST_IMPORT);
174
175 if (gfc_current_block ()(gfc_state_stack->sym)->result->ts.type != BT_DERIVED)
176 goto end_of_block;
177
178 match (NULL__null, gfc_match_st_function, ST_STATEMENT_FUNCTION);
179 match (NULL__null, gfc_match_data_decl, ST_DATA_DECL);
180 match (NULL__null, gfc_match_enumerator_def, ST_ENUMERATOR);
181
182 /* General statement matching: Instead of testing every possible
183 statement, we eliminate most possibilities by peeking at the
184 first character. */
185
186 c = gfc_peek_ascii_char ();
187
188 switch (c)
189 {
190 case 'a':
191 match ("abstract% interface", gfc_match_abstract_interface,
192 ST_INTERFACE);
193 match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
194 match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
195 match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
196 break;
197
198 case 'b':
199 match (NULL__null, gfc_match_bind_c_stmt, ST_ATTR_DECL);
200 break;
201
202 case 'c':
203 match ("codimension", gfc_match_codimension, ST_ATTR_DECL);
204 match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
205 break;
206
207 case 'd':
208 match ("data", gfc_match_data, ST_DATA);
209 match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
210 break;
211
212 case 'e':
213 match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
214 match ("entry% ", gfc_match_entry, ST_ENTRY);
215 match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
216 match ("external", gfc_match_external, ST_ATTR_DECL);
217 break;
218
219 case 'f':
220 match ("format", gfc_match_format, ST_FORMAT);
221 break;
222
223 case 'g':
224 break;
225
226 case 'i':
227 match ("implicit", gfc_match_implicit, ST_IMPLICIT);
228 match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
229 match ("interface", gfc_match_interface, ST_INTERFACE);
230 match ("intent", gfc_match_intent, ST_ATTR_DECL);
231 match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
232 break;
233
234 case 'm':
235 break;
236
237 case 'n':
238 match ("namelist", gfc_match_namelist, ST_NAMELIST);
239 break;
240
241 case 'o':
242 match ("optional", gfc_match_optional, ST_ATTR_DECL);
243 break;
244
245 case 'p':
246 match ("parameter", gfc_match_parameter, ST_PARAMETER);
247 match ("pointer", gfc_match_pointer, ST_ATTR_DECL);
248 if (gfc_match_private (&st) == MATCH_YES)
249 return st;
250 match ("procedure", gfc_match_procedure, ST_PROCEDURE);
251 if (gfc_match_public (&st) == MATCH_YES)
252 return st;
253 match ("protected", gfc_match_protected, ST_ATTR_DECL);
254 break;
255
256 case 'r':
257 break;
258
259 case 's':
260 match ("save", gfc_match_save, ST_ATTR_DECL);
261 match ("static", gfc_match_static, ST_ATTR_DECL);
262 match ("structure", gfc_match_structure_decl, ST_STRUCTURE_DECL);
263 break;
264
265 case 't':
266 match ("target", gfc_match_target, ST_ATTR_DECL);
267 match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
268 break;
269
270 case 'u':
271 break;
272
273 case 'v':
274 match ("value", gfc_match_value, ST_ATTR_DECL);
275 match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
276 break;
277
278 case 'w':
279 break;
280 }
281
282 /* This is not a specification statement. See if any of the matchers
283 has stored an error message of some sort. */
284
285end_of_block:
286 gfc_clear_error ();
287 gfc_buffer_error (false);
288 gfc_current_locus = old_locus;
289
290 return ST_GET_FCN_CHARACTERISTICS;
291}
292
293static bool in_specification_block;
294
295/* This is the primary 'decode_statement'. */
296static gfc_statement
297decode_statement (void)
298{
299 gfc_statement st;
300 locus old_locus;
301 match m = MATCH_NO;
302 char c;
303
304 gfc_enforce_clean_symbol_state ();
305
306 gfc_clear_error (); /* Clear any pending errors. */
307 gfc_clear_warning (); /* Clear any pending warnings. */
308
309 gfc_matching_function = false;
310
311 if (gfc_match_eos () == MATCH_YES)
312 return ST_NONE;
313
314 if (gfc_current_state ()(gfc_state_stack->state) == COMP_FUNCTION
315 && gfc_current_block ()(gfc_state_stack->sym)->result->ts.kind == -1)
316 return decode_specification_statement ();
317
318 old_locus = gfc_current_locus;
319
320 c = gfc_peek_ascii_char ();
321
322 if (c == 'u')
323 {
324 if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
325 {
326 last_was_use_stmt = true;
327 return ST_USE;
328 }
329 else
330 undo_new_statement ();
331 }
332
333 if (last_was_use_stmt)
334 use_modules ();
335
336 /* Try matching a data declaration or function declaration. The
337 input "REALFUNCTIONA(N)" can mean several things in different
338 contexts, so it (and its relatives) get special treatment. */
339
340 if (gfc_current_state ()(gfc_state_stack->state) == COMP_NONE
341 || gfc_current_state ()(gfc_state_stack->state) == COMP_INTERFACE
342 || gfc_current_state ()(gfc_state_stack->state) == COMP_CONTAINS)
343 {
344 gfc_matching_function = true;
345 m = gfc_match_function_decl ();
346 if (m == MATCH_YES)
347 return ST_FUNCTION;
348 else if (m == MATCH_ERROR)
349 reject_statement ();
350 else
351 gfc_undo_symbols ();
352 gfc_current_locus = old_locus;
353 }
354 gfc_matching_function = false;
355
356 /* Legacy parameter statements are ambiguous with assignments so try parameter
357 first. */
358 match ("parameter", gfc_match_parameter, ST_PARAMETER);
359
360 /* Match statements whose error messages are meant to be overwritten
361 by something better. */
362
363 match (NULL__null, gfc_match_assignment, ST_ASSIGNMENT);
364 match (NULL__null, gfc_match_pointer_assignment, ST_POINTER_ASSIGNMENT);
365
366 if (in_specification_block)
367 {
368 m = match_word (NULL__null, gfc_match_st_function, &old_locus);
369 if (m == MATCH_YES)
370 return ST_STATEMENT_FUNCTION;
371 }
372
373 if (!(in_specification_block && m == MATCH_ERROR))
374 {
375 match (NULL__null, gfc_match_ptr_fcn_assign, ST_ASSIGNMENT);
376 }
377
378 match (NULL__null, gfc_match_data_decl, ST_DATA_DECL);
379 match (NULL__null, gfc_match_enumerator_def, ST_ENUMERATOR);
380
381 /* Try to match a subroutine statement, which has the same optional
382 prefixes that functions can have. */
383
384 if (gfc_match_subroutine () == MATCH_YES)
385 return ST_SUBROUTINE;
386 gfc_undo_symbols ();
387 gfc_current_locus = old_locus;
388
389 if (gfc_match_submod_proc () == MATCH_YES)
390 {
391 if (gfc_new_block->attr.subroutine)
392 return ST_SUBROUTINE;
393 else if (gfc_new_block->attr.function)
394 return ST_FUNCTION;
395 }
396 gfc_undo_symbols ();
397 gfc_current_locus = old_locus;
398
399 /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, BLOCK and ASSOCIATE
400 statements, which might begin with a block label. The match functions for
401 these statements are unusual in that their keyword is not seen before
402 the matcher is called. */
403
404 if (gfc_match_if (&st) == MATCH_YES)
405 return st;
406 gfc_undo_symbols ();
407 gfc_current_locus = old_locus;
408
409 if (gfc_match_where (&st) == MATCH_YES)
410 return st;
411 gfc_undo_symbols ();
412 gfc_current_locus = old_locus;
413
414 if (gfc_match_forall (&st) == MATCH_YES)
415 return st;
416 gfc_undo_symbols ();
417 gfc_current_locus = old_locus;
418
419 /* Try to match TYPE as an alias for PRINT. */
420 if (gfc_match_type (&st) == MATCH_YES)
421 return st;
422 gfc_undo_symbols ();
423 gfc_current_locus = old_locus;
424
425 match (NULL__null, gfc_match_do, ST_DO);
426 match (NULL__null, gfc_match_block, ST_BLOCK);
427 match (NULL__null, gfc_match_associate, ST_ASSOCIATE);
428 match (NULL__null, gfc_match_critical, ST_CRITICAL);
429 match (NULL__null, gfc_match_select, ST_SELECT_CASE);
430 match (NULL__null, gfc_match_select_type, ST_SELECT_TYPE);
431 match (NULL__null, gfc_match_select_rank, ST_SELECT_RANK);
432
433 /* General statement matching: Instead of testing every possible
434 statement, we eliminate most possibilities by peeking at the
435 first character. */
436
437 switch (c)
438 {
439 case 'a':
440 match ("abstract% interface", gfc_match_abstract_interface,
441 ST_INTERFACE);
442 match ("allocate", gfc_match_allocate, ST_ALLOCATE);
443 match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
444 match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
445 match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
446 match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
447 break;
448
449 case 'b':
450 match ("backspace", gfc_match_backspace, ST_BACKSPACE);
451 match ("block data", gfc_match_block_data, ST_BLOCK_DATA);
452 match (NULL__null, gfc_match_bind_c_stmt, ST_ATTR_DECL);
453 break;
454
455 case 'c':
456 match ("call", gfc_match_call, ST_CALL);
457 match ("change% team", gfc_match_change_team, ST_CHANGE_TEAM);
458 match ("close", gfc_match_close, ST_CLOSE);
459 match ("continue", gfc_match_continue, ST_CONTINUE);
460 match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
461 match ("cycle", gfc_match_cycle, ST_CYCLE);
462 match ("case", gfc_match_case, ST_CASE);
463 match ("common", gfc_match_common, ST_COMMON);
464 match ("contains", gfc_match_eos, ST_CONTAINS);
465 match ("class", gfc_match_class_is, ST_CLASS_IS);
466 match ("codimension", gfc_match_codimension, ST_ATTR_DECL);
467 break;
468
469 case 'd':
470 match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE);
471 match ("data", gfc_match_data, ST_DATA);
472 match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
473 break;
474
475 case 'e':
476 match ("end file", gfc_match_endfile, ST_END_FILE);
477 match ("end team", gfc_match_end_team, ST_END_TEAM);
478 match ("exit", gfc_match_exit, ST_EXIT);
479 match ("else", gfc_match_else, ST_ELSE);
480 match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
481 match ("else if", gfc_match_elseif, ST_ELSEIF);
482 match ("error% stop", gfc_match_error_stop, ST_ERROR_STOP);
483 match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
484
485 if (gfc_match_end (&st) == MATCH_YES)
486 return st;
487
488 match ("entry% ", gfc_match_entry, ST_ENTRY);
489 match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
490 match ("external", gfc_match_external, ST_ATTR_DECL);
491 match ("event% post", gfc_match_event_post, ST_EVENT_POST);
492 match ("event% wait", gfc_match_event_wait, ST_EVENT_WAIT);
493 break;
494
495 case 'f':
496 match ("fail% image", gfc_match_fail_image, ST_FAIL_IMAGE);
497 match ("final", gfc_match_final_decl, ST_FINAL);
498 match ("flush", gfc_match_flush, ST_FLUSH);
499 match ("form% team", gfc_match_form_team, ST_FORM_TEAM);
500 match ("format", gfc_match_format, ST_FORMAT);
501 break;
502
503 case 'g':
504 match ("generic", gfc_match_generic, ST_GENERIC);
505 match ("go to", gfc_match_goto, ST_GOTO);
506 break;
507
508 case 'i':
509 match ("inquire", gfc_match_inquire, ST_INQUIRE);
510 match ("implicit", gfc_match_implicit, ST_IMPLICIT);
511 match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
512 match ("import", gfc_match_import, ST_IMPORT);
513 match ("interface", gfc_match_interface, ST_INTERFACE);
514 match ("intent", gfc_match_intent, ST_ATTR_DECL);
515 match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
516 break;
517
518 case 'l':
519 match ("lock", gfc_match_lock, ST_LOCK);
520 break;
521
522 case 'm':
523 match ("map", gfc_match_map, ST_MAP);
524 match ("module% procedure", gfc_match_modproc, ST_MODULE_PROC);
525 match ("module", gfc_match_module, ST_MODULE);
526 break;
527
528 case 'n':
529 match ("nullify", gfc_match_nullify, ST_NULLIFY);
530 match ("namelist", gfc_match_namelist, ST_NAMELIST);
531 break;
532
533 case 'o':
534 match ("open", gfc_match_open, ST_OPEN);
535 match ("optional", gfc_match_optional, ST_ATTR_DECL);
536 break;
537
538 case 'p':
539 match ("print", gfc_match_print, ST_WRITE);
540 match ("pause", gfc_match_pause, ST_PAUSE);
541 match ("pointer", gfc_match_pointer, ST_ATTR_DECL);
542 if (gfc_match_private (&st) == MATCH_YES)
543 return st;
544 match ("procedure", gfc_match_procedure, ST_PROCEDURE);
545 match ("program", gfc_match_program, ST_PROGRAM);
546 if (gfc_match_public (&st) == MATCH_YES)
547 return st;
548 match ("protected", gfc_match_protected, ST_ATTR_DECL);
549 break;
550
551 case 'r':
552 match ("rank", gfc_match_rank_is, ST_RANK);
553 match ("read", gfc_match_read, ST_READ);
554 match ("return", gfc_match_return, ST_RETURN);
555 match ("rewind", gfc_match_rewind, ST_REWIND);
556 break;
557
558 case 's':
559 match ("structure", gfc_match_structure_decl, ST_STRUCTURE_DECL);
560 match ("sequence", gfc_match_eos, ST_SEQUENCE);
561 match ("stop", gfc_match_stop, ST_STOP);
562 match ("save", gfc_match_save, ST_ATTR_DECL);
563 match ("static", gfc_match_static, ST_ATTR_DECL);
564 match ("submodule", gfc_match_submodule, ST_SUBMODULE);
565 match ("sync% all", gfc_match_sync_all, ST_SYNC_ALL);
566 match ("sync% images", gfc_match_sync_images, ST_SYNC_IMAGES);
567 match ("sync% memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
568 match ("sync% team", gfc_match_sync_team, ST_SYNC_TEAM);
569 break;
570
571 case 't':
572 match ("target", gfc_match_target, ST_ATTR_DECL);
573 match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
574 match ("type% is", gfc_match_type_is, ST_TYPE_IS);
575 break;
576
577 case 'u':
578 match ("union", gfc_match_union, ST_UNION);
579 match ("unlock", gfc_match_unlock, ST_UNLOCK);
580 break;
581
582 case 'v':
583 match ("value", gfc_match_value, ST_ATTR_DECL);
584 match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
585 break;
586
587 case 'w':
588 match ("wait", gfc_match_wait, ST_WAIT);
589 match ("write", gfc_match_write, ST_WRITE);
590 break;
591 }
592
593 /* All else has failed, so give up. See if any of the matchers has
594 stored an error message of some sort. Suppress the "Unclassifiable
595 statement" if a previous error message was emitted, e.g., by
596 gfc_error_now (). */
597 if (!gfc_error_check ())
598 {
599 int ecnt;
600 gfc_get_errors (NULL__null, &ecnt);
601 if (ecnt <= 0)
602 gfc_error_now ("Unclassifiable statement at %C");
603 }
604
605 reject_statement ();
606
607 gfc_error_recovery ();
608
609 return ST_NONE;
610}
611
612/* Like match and if spec_only, goto do_spec_only without actually
613 matching. */
614/* If the directive matched but the clauses failed, do not start
615 matching the next directive in the same switch statement. */
616#define matcha(keyword, subr, st)do { match m2; if (spec_only && gfc_match (keyword) ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word (keyword
, subr, &old_locus)) == MATCH_YES) return st; else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0) \
617 do { \
618 match m2; \
619 if (spec_only && gfc_match (keyword) == MATCH_YES) \
620 goto do_spec_only; \
621 else if ((m2 = match_word (keyword, subr, &old_locus)) \
622 == MATCH_YES) \
623 return st; \
624 else if (m2 == MATCH_ERROR) \
625 goto error_handling; \
626 else \
627 undo_new_statement (); \
628 } while (0)
629
630static gfc_statement
631decode_oacc_directive (void)
632{
633 locus old_locus;
634 char c;
635 bool spec_only = false;
636
637 gfc_enforce_clean_symbol_state ();
638
639 gfc_clear_error (); /* Clear any pending errors. */
640 gfc_clear_warning (); /* Clear any pending warnings. */
641
642 gfc_matching_function = false;
643
644 if (gfc_current_state ()(gfc_state_stack->state) == COMP_FUNCTION
645 && gfc_current_block ()(gfc_state_stack->sym)->result->ts.kind == -1)
646 spec_only = true;
647
648 old_locus = gfc_current_locus;
649
650 /* General OpenACC directive matching: Instead of testing every possible
651 statement, we eliminate most possibilities by peeking at the
652 first character. */
653
654 c = gfc_peek_ascii_char ();
655
656 switch (c)
657 {
658 case 'r':
659 matcha ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE)do { match m2; if (spec_only && gfc_match ("routine")
== MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"routine", gfc_match_oacc_routine, &old_locus)) == MATCH_YES
) return ST_OACC_ROUTINE; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
660 break;
661 }
662
663 gfc_unset_implicit_pure (NULL__null);
664 if (gfc_pure (NULL__null))
665 {
666 gfc_error_now ("OpenACC directives other than ROUTINE may not appear in PURE "
667 "procedures at %C");
668 goto error_handling;
669 }
670
671 switch (c)
672 {
673 case 'a':
674 matcha ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC)do { match m2; if (spec_only && gfc_match ("atomic") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("atomic"
, gfc_match_oacc_atomic, &old_locus)) == MATCH_YES) return
ST_OACC_ATOMIC; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
675 break;
676 case 'c':
677 matcha ("cache", gfc_match_oacc_cache, ST_OACC_CACHE)do { match m2; if (spec_only && gfc_match ("cache") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("cache"
, gfc_match_oacc_cache, &old_locus)) == MATCH_YES) return
ST_OACC_CACHE; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
678 break;
679 case 'd':
680 matcha ("data", gfc_match_oacc_data, ST_OACC_DATA)do { match m2; if (spec_only && gfc_match ("data") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("data"
, gfc_match_oacc_data, &old_locus)) == MATCH_YES) return ST_OACC_DATA
; else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
681 match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
682 break;
683 case 'e':
684 matcha ("end atomic", gfc_match_omp_eos_error, ST_OACC_END_ATOMIC)do { match m2; if (spec_only && gfc_match ("end atomic"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end atomic", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_ATOMIC; else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0);
685 matcha ("end data", gfc_match_omp_eos_error, ST_OACC_END_DATA)do { match m2; if (spec_only && gfc_match ("end data"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end data", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_DATA; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
686 matcha ("end host_data", gfc_match_omp_eos_error, ST_OACC_END_HOST_DATA)do { match m2; if (spec_only && gfc_match ("end host_data"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end host_data", gfc_match_omp_eos_error, &old_locus)) ==
MATCH_YES) return ST_OACC_END_HOST_DATA; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
687 matcha ("end kernels loop", gfc_match_omp_eos_error, ST_OACC_END_KERNELS_LOOP)do { match m2; if (spec_only && gfc_match ("end kernels loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end kernels loop", gfc_match_omp_eos_error, &old_locus))
== MATCH_YES) return ST_OACC_END_KERNELS_LOOP; else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
688 matcha ("end kernels", gfc_match_omp_eos_error, ST_OACC_END_KERNELS)do { match m2; if (spec_only && gfc_match ("end kernels"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end kernels", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_KERNELS; else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0);
689 matcha ("end loop", gfc_match_omp_eos_error, ST_OACC_END_LOOP)do { match m2; if (spec_only && gfc_match ("end loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end loop", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_LOOP; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
690 matcha ("end parallel loop", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end parallel loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel loop", gfc_match_omp_eos_error, &old_locus)
) == MATCH_YES) return ST_OACC_END_PARALLEL_LOOP; else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
691 ST_OACC_END_PARALLEL_LOOP)do { match m2; if (spec_only && gfc_match ("end parallel loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel loop", gfc_match_omp_eos_error, &old_locus)
) == MATCH_YES) return ST_OACC_END_PARALLEL_LOOP; else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
692 matcha ("end parallel", gfc_match_omp_eos_error, ST_OACC_END_PARALLEL)do { match m2; if (spec_only && gfc_match ("end parallel"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_PARALLEL; else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0);
693 matcha ("end serial loop", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end serial loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end serial loop", gfc_match_omp_eos_error, &old_locus)) ==
MATCH_YES) return ST_OACC_END_SERIAL_LOOP; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
694 ST_OACC_END_SERIAL_LOOP)do { match m2; if (spec_only && gfc_match ("end serial loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end serial loop", gfc_match_omp_eos_error, &old_locus)) ==
MATCH_YES) return ST_OACC_END_SERIAL_LOOP; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
695 matcha ("end serial", gfc_match_omp_eos_error, ST_OACC_END_SERIAL)do { match m2; if (spec_only && gfc_match ("end serial"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end serial", gfc_match_omp_eos_error, &old_locus)) == MATCH_YES
) return ST_OACC_END_SERIAL; else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0);
696 matcha ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA)do { match m2; if (spec_only && gfc_match ("enter data"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"enter data", gfc_match_oacc_enter_data, &old_locus)) == MATCH_YES
) return ST_OACC_ENTER_DATA; else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0);
697 matcha ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA)do { match m2; if (spec_only && gfc_match ("exit data"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"exit data", gfc_match_oacc_exit_data, &old_locus)) == MATCH_YES
) return ST_OACC_EXIT_DATA; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
698 break;
699 case 'h':
700 matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA)do { match m2; if (spec_only && gfc_match ("host_data"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"host_data", gfc_match_oacc_host_data, &old_locus)) == MATCH_YES
) return ST_OACC_HOST_DATA; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
701 break;
702 case 'p':
703 matcha ("parallel loop", gfc_match_oacc_parallel_loop,do { match m2; if (spec_only && gfc_match ("parallel loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel loop", gfc_match_oacc_parallel_loop, &old_locus
)) == MATCH_YES) return ST_OACC_PARALLEL_LOOP; else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
704 ST_OACC_PARALLEL_LOOP)do { match m2; if (spec_only && gfc_match ("parallel loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel loop", gfc_match_oacc_parallel_loop, &old_locus
)) == MATCH_YES) return ST_OACC_PARALLEL_LOOP; else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
705 matcha ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL)do { match m2; if (spec_only && gfc_match ("parallel"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel", gfc_match_oacc_parallel, &old_locus)) == MATCH_YES
) return ST_OACC_PARALLEL; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
706 break;
707 case 'k':
708 matcha ("kernels loop", gfc_match_oacc_kernels_loop,do { match m2; if (spec_only && gfc_match ("kernels loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"kernels loop", gfc_match_oacc_kernels_loop, &old_locus))
== MATCH_YES) return ST_OACC_KERNELS_LOOP; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
709 ST_OACC_KERNELS_LOOP)do { match m2; if (spec_only && gfc_match ("kernels loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"kernels loop", gfc_match_oacc_kernels_loop, &old_locus))
== MATCH_YES) return ST_OACC_KERNELS_LOOP; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
710 matcha ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS)do { match m2; if (spec_only && gfc_match ("kernels")
== MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"kernels", gfc_match_oacc_kernels, &old_locus)) == MATCH_YES
) return ST_OACC_KERNELS; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
711 break;
712 case 'l':
713 matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP)do { match m2; if (spec_only && gfc_match ("loop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("loop"
, gfc_match_oacc_loop, &old_locus)) == MATCH_YES) return ST_OACC_LOOP
; else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
714 break;
715 case 's':
716 matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP)do { match m2; if (spec_only && gfc_match ("serial loop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"serial loop", gfc_match_oacc_serial_loop, &old_locus)) ==
MATCH_YES) return ST_OACC_SERIAL_LOOP; else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
717 matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL)do { match m2; if (spec_only && gfc_match ("serial") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("serial"
, gfc_match_oacc_serial, &old_locus)) == MATCH_YES) return
ST_OACC_SERIAL; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
718 break;
719 case 'u':
720 matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE)do { match m2; if (spec_only && gfc_match ("update") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("update"
, gfc_match_oacc_update, &old_locus)) == MATCH_YES) return
ST_OACC_UPDATE; else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
721 break;
722 case 'w':
723 matcha ("wait", gfc_match_oacc_wait, ST_OACC_WAIT)do { match m2; if (spec_only && gfc_match ("wait") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("wait"
, gfc_match_oacc_wait, &old_locus)) == MATCH_YES) return ST_OACC_WAIT
; else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
724 break;
725 }
726
727 /* Directive not found or stored an error message.
728 Check and give up. */
729
730 error_handling:
731 if (gfc_error_check () == 0)
732 gfc_error_now ("Unclassifiable OpenACC directive at %C");
733
734 reject_statement ();
735
736 gfc_error_recovery ();
737
738 return ST_NONE;
739
740 do_spec_only:
741 reject_statement ();
742 gfc_clear_error ();
743 gfc_buffer_error (false);
744 gfc_current_locus = old_locus;
745 return ST_GET_FCN_CHARACTERISTICS;
746}
747
748/* Like match, but set a flag simd_matched if keyword matched
749 and if spec_only, goto do_spec_only without actually matching. */
750#define matchs(keyword, subr, st)do { match m2; if (spec_only && gfc_match (keyword) ==
MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd (
keyword, subr, &old_locus, &simd_matched)) == MATCH_YES
) { ret = st; goto finish; } else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0) \
751 do { \
752 match m2; \
753 if (spec_only && gfc_match (keyword) == MATCH_YES) \
754 goto do_spec_only; \
755 if ((m2 = match_word_omp_simd (keyword, subr, &old_locus, \
756 &simd_matched)) == MATCH_YES) \
757 { \
758 ret = st; \
759 goto finish; \
760 } \
761 else if (m2 == MATCH_ERROR) \
762 goto error_handling; \
763 else \
764 undo_new_statement (); \
765 } while (0)
766
767/* Like match, but don't match anything if not -fopenmp
768 and if spec_only, goto do_spec_only without actually matching. */
769/* If the directive matched but the clauses failed, do not start
770 matching the next directive in the same switch statement. */
771#define matcho(keyword, subr, st)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match (keyword) == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word (keyword, subr, &old_locus)) ==
MATCH_YES) { ret = st; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
) \
772 do { \
773 match m2; \
774 if (!flag_openmpglobal_options.x_flag_openmp) \
775 ; \
776 else if (spec_only && gfc_match (keyword) == MATCH_YES) \
777 goto do_spec_only; \
778 else if ((m2 = match_word (keyword, subr, &old_locus)) \
779 == MATCH_YES) \
780 { \
781 ret = st; \
782 goto finish; \
783 } \
784 else if (m2 == MATCH_ERROR) \
785 goto error_handling; \
786 else \
787 undo_new_statement (); \
788 } while (0)
789
790/* Like match, but set a flag simd_matched if keyword matched. */
791#define matchds(keyword, subr, st)do { match m2; if ((m2 = match_word_omp_simd (keyword, subr, &
old_locus, &simd_matched)) == MATCH_YES) { ret = st; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0) \
792 do { \
793 match m2; \
794 if ((m2 = match_word_omp_simd (keyword, subr, &old_locus, \
795 &simd_matched)) == MATCH_YES) \
796 { \
797 ret = st; \
798 goto finish; \
799 } \
800 else if (m2 == MATCH_ERROR) \
801 goto error_handling; \
802 else \
803 undo_new_statement (); \
804 } while (0)
805
806/* Like match, but don't match anything if not -fopenmp. */
807#define matchdo(keyword, subr, st)do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word (keyword, subr, &old_locus)) == MATCH_YES
) { ret = st; goto finish; } else if (m2 == MATCH_ERROR) goto
error_handling; else undo_new_statement (); } while (0) \
808 do { \
809 match m2; \
810 if (!flag_openmpglobal_options.x_flag_openmp) \
811 ; \
812 else if ((m2 = match_word (keyword, subr, &old_locus)) \
813 == MATCH_YES) \
814 { \
815 ret = st; \
816 goto finish; \
817 } \
818 else if (m2 == MATCH_ERROR) \
819 goto error_handling; \
820 else \
821 undo_new_statement (); \
822 } while (0)
823
824static gfc_statement
825decode_omp_directive (void)
826{
827 locus old_locus;
828 char c;
829 bool simd_matched = false;
830 bool spec_only = false;
831 gfc_statement ret = ST_NONE;
832 bool pure_ok = true;
833
834 gfc_enforce_clean_symbol_state ();
835
836 gfc_clear_error (); /* Clear any pending errors. */
837 gfc_clear_warning (); /* Clear any pending warnings. */
838
839 gfc_matching_function = false;
840
841 if (gfc_current_state ()(gfc_state_stack->state) == COMP_FUNCTION
842 && gfc_current_block ()(gfc_state_stack->sym)->result->ts.kind == -1)
843 spec_only = true;
844
845 old_locus = gfc_current_locus;
846
847 /* General OpenMP directive matching: Instead of testing every possible
848 statement, we eliminate most possibilities by peeking at the
849 first character. */
850
851 c = gfc_peek_ascii_char ();
852
853 /* match is for directives that should be recognized only if
854 -fopenmp, matchs for directives that should be recognized
855 if either -fopenmp or -fopenmp-simd.
856 Handle only the directives allowed in PURE procedures
857 first (those also shall not turn off implicit pure). */
858 switch (c)
859 {
860 case 'd':
861 matchds ("declare simd", gfc_match_omp_declare_simd,do { match m2; if ((m2 = match_word_omp_simd ("declare simd",
gfc_match_omp_declare_simd, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_DECLARE_SIMD; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
862 ST_OMP_DECLARE_SIMD)do { match m2; if ((m2 = match_word_omp_simd ("declare simd",
gfc_match_omp_declare_simd, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_DECLARE_SIMD; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
863 matchdo ("declare target", gfc_match_omp_declare_target,do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("declare target", gfc_match_omp_declare_target
, &old_locus)) == MATCH_YES) { ret = ST_OMP_DECLARE_TARGET
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
864 ST_OMP_DECLARE_TARGET)do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("declare target", gfc_match_omp_declare_target
, &old_locus)) == MATCH_YES) { ret = ST_OMP_DECLARE_TARGET
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
865 matchdo ("declare variant", gfc_match_omp_declare_variant,do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("declare variant", gfc_match_omp_declare_variant
, &old_locus)) == MATCH_YES) { ret = ST_OMP_DECLARE_VARIANT
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
866 ST_OMP_DECLARE_VARIANT)do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("declare variant", gfc_match_omp_declare_variant
, &old_locus)) == MATCH_YES) { ret = ST_OMP_DECLARE_VARIANT
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
867 break;
868 case 's':
869 matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD)do { match m2; if (spec_only && gfc_match ("simd") ==
MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd (
"simd", gfc_match_omp_simd, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_SIMD; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
870 break;
871 }
872
873 pure_ok = false;
874 if (flag_openmpglobal_options.x_flag_openmp && gfc_pure (NULL__null))
875 {
876 gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET "
877 "at %C may not appear in PURE procedures");
878 gfc_error_recovery ();
879 return ST_NONE;
880 }
881
882 /* match is for directives that should be recognized only if
883 -fopenmp, matchs for directives that should be recognized
884 if either -fopenmp or -fopenmp-simd. */
885 switch (c)
886 {
887 case 'a':
888 /* For -fopenmp-simd, ignore 'assumes'; note no clause starts with 's'. */
889 if (!flag_openmpglobal_options.x_flag_openmp && gfc_match ("assumes") == MATCH_YES)
890 break;
891 matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("assumes") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("assumes", gfc_match_omp_assumes
, &old_locus)) == MATCH_YES) { ret = ST_OMP_ASSUMES; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
892 matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME)do { match m2; if (spec_only && gfc_match ("assume") ==
MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd (
"assume", gfc_match_omp_assume, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_ASSUME; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
893 matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("atomic") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("atomic", gfc_match_omp_atomic, &
old_locus)) == MATCH_YES) { ret = ST_OMP_ATOMIC; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
894 break;
895 case 'b':
896 matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("barrier") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("barrier", gfc_match_omp_barrier
, &old_locus)) == MATCH_YES) { ret = ST_OMP_BARRIER; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
897 break;
898 case 'c':
899 matcho ("cancellation% point", gfc_match_omp_cancellation_point,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("cancellation% point") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("cancellation% point"
, gfc_match_omp_cancellation_point, &old_locus)) == MATCH_YES
) { ret = ST_OMP_CANCELLATION_POINT; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
900 ST_OMP_CANCELLATION_POINT)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("cancellation% point") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("cancellation% point"
, gfc_match_omp_cancellation_point, &old_locus)) == MATCH_YES
) { ret = ST_OMP_CANCELLATION_POINT; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
901 matcho ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("cancel") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("cancel", gfc_match_omp_cancel, &
old_locus)) == MATCH_YES) { ret = ST_OMP_CANCEL; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
902 matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("critical") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("critical", gfc_match_omp_critical
, &old_locus)) == MATCH_YES) { ret = ST_OMP_CRITICAL; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
903 break;
904 case 'd':
905 matchds ("declare reduction", gfc_match_omp_declare_reduction,do { match m2; if ((m2 = match_word_omp_simd ("declare reduction"
, gfc_match_omp_declare_reduction, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_DECLARE_REDUCTION; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
906 ST_OMP_DECLARE_REDUCTION)do { match m2; if ((m2 = match_word_omp_simd ("declare reduction"
, gfc_match_omp_declare_reduction, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_DECLARE_REDUCTION; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
907 matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("depobj") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("depobj", gfc_match_omp_depobj, &
old_locus)) == MATCH_YES) { ret = ST_OMP_DEPOBJ; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
908 matchs ("distribute parallel do simd",do { match m2; if (spec_only && gfc_match ("distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
909 gfc_match_omp_distribute_parallel_do_simd,do { match m2; if (spec_only && gfc_match ("distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
910 ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
911 matcho ("distribute parallel do", gfc_match_omp_distribute_parallel_do,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("distribute parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("distribute parallel do"
, gfc_match_omp_distribute_parallel_do, &old_locus)) == MATCH_YES
) { ret = ST_OMP_DISTRIBUTE_PARALLEL_DO; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
912 ST_OMP_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("distribute parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("distribute parallel do"
, gfc_match_omp_distribute_parallel_do, &old_locus)) == MATCH_YES
) { ret = ST_OMP_DISTRIBUTE_PARALLEL_DO; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
913 matchs ("distribute simd", gfc_match_omp_distribute_simd,do { match m2; if (spec_only && gfc_match ("distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("distribute simd", gfc_match_omp_distribute_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
914 ST_OMP_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("distribute simd", gfc_match_omp_distribute_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
915 matcho ("distribute", gfc_match_omp_distribute, ST_OMP_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("distribute") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("distribute", gfc_match_omp_distribute
, &old_locus)) == MATCH_YES) { ret = ST_OMP_DISTRIBUTE; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
916 matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD)do { match m2; if (spec_only && gfc_match ("do simd")
== MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("do simd", gfc_match_omp_do_simd, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_DO_SIMD; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
917 matcho ("do", gfc_match_omp_do, ST_OMP_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("do") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("do", gfc_match_omp_do, &old_locus
)) == MATCH_YES) { ret = ST_OMP_DO; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
918 break;
919 case 'e':
920 matcho ("error", gfc_match_omp_error, ST_OMP_ERROR)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("error") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("error", gfc_match_omp_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_ERROR; goto finish; }
else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
921 matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME)do { match m2; if (spec_only && gfc_match ("end assume"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end assume", gfc_match_omp_eos_error, &old_locus, &
simd_matched)) == MATCH_YES) { ret = ST_OMP_END_ASSUME; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
922 matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end atomic") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end atomic", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_ATOMIC; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
923 matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end critical") == MATCH_YES)
goto do_spec_only; else if ((m2 = match_word ("end critical"
, gfc_match_omp_end_critical, &old_locus)) == MATCH_YES) {
ret = ST_OMP_END_CRITICAL; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
924 matchs ("end distribute parallel do simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end distribute parallel do simd", gfc_match_omp_eos_error,
&old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
925 ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end distribute parallel do simd", gfc_match_omp_eos_error,
&old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
926 matcho ("end distribute parallel do", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end distribute parallel do")
== MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end distribute parallel do", gfc_match_omp_eos_error, &old_locus
)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0)
927 ST_OMP_END_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end distribute parallel do")
== MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end distribute parallel do", gfc_match_omp_eos_error, &old_locus
)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
928 matchs ("end distribute simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end distribute simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
929 ST_OMP_END_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("end distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end distribute simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
930 matcho ("end distribute", gfc_match_omp_eos_error, ST_OMP_END_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end distribute") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end distribute"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_DISTRIBUTE; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
931 matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end do simd", gfc_match_omp_end_nowait, &old_locus, &
simd_matched)) == MATCH_YES) { ret = ST_OMP_END_DO_SIMD; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
932 matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end do") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("end do", gfc_match_omp_end_nowait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_DO; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
933 matchs ("end loop", gfc_match_omp_eos_error, ST_OMP_END_LOOP)do { match m2; if (spec_only && gfc_match ("end loop"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end loop", gfc_match_omp_eos_error, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_END_LOOP; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
934 matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD)do { match m2; if (spec_only && gfc_match ("end simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end simd", gfc_match_omp_eos_error, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_END_SIMD; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
935 matcho ("end masked taskloop simd", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end masked taskloop simd") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end masked taskloop simd"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASKED_TASKLOOP_SIMD; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
936 ST_OMP_END_MASKED_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end masked taskloop simd") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end masked taskloop simd"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASKED_TASKLOOP_SIMD; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
937 matcho ("end masked taskloop", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end masked taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end masked taskloop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASKED_TASKLOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
938 ST_OMP_END_MASKED_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end masked taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end masked taskloop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASKED_TASKLOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
939 matcho ("end masked", gfc_match_omp_eos_error, ST_OMP_END_MASKED)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end masked") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end masked", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_MASKED; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
940 matcho ("end master taskloop simd", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end master taskloop simd") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end master taskloop simd"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASTER_TASKLOOP_SIMD; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
941 ST_OMP_END_MASTER_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end master taskloop simd") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end master taskloop simd"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASTER_TASKLOOP_SIMD; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
942 matcho ("end master taskloop", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end master taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end master taskloop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASTER_TASKLOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
943 ST_OMP_END_MASTER_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end master taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end master taskloop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_MASTER_TASKLOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
944 matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end master") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end master", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_MASTER; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
945 matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED)do { match m2; if (spec_only && gfc_match ("end ordered"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end ordered", gfc_match_omp_eos_error, &old_locus, &
simd_matched)) == MATCH_YES) { ret = ST_OMP_END_ORDERED; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
946 matchs ("end parallel do simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end parallel do simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
947 ST_OMP_END_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end parallel do simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
948 matcho ("end parallel do", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel do"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_DO; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
949 ST_OMP_END_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel do"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_DO; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
950 matcho ("end parallel loop", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel loop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_LOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
951 ST_OMP_END_PARALLEL_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel loop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_LOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
952 matcho ("end parallel masked taskloop simd", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel masked taskloop simd", gfc_match_omp_eos_error,
&old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
953 ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel masked taskloop simd", gfc_match_omp_eos_error,
&old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
954 matcho ("end parallel masked taskloop", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked taskloop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel masked taskloop", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASKED_TASKLOOP
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
955 ST_OMP_END_PARALLEL_MASKED_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked taskloop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel masked taskloop", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASKED_TASKLOOP
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
956 matcho ("end parallel masked", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel masked"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_MASKED; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
957 ST_OMP_END_PARALLEL_MASKED)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel masked") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel masked"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_MASKED; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
958 matcho ("end parallel master taskloop simd", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel master taskloop simd", gfc_match_omp_eos_error,
&old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
959 ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel master taskloop simd", gfc_match_omp_eos_error,
&old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
960 matcho ("end parallel master taskloop", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master taskloop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel master taskloop", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASTER_TASKLOOP
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
961 ST_OMP_END_PARALLEL_MASTER_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master taskloop"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end parallel master taskloop", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_PARALLEL_MASTER_TASKLOOP
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
962 matcho ("end parallel master", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel master"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_MASTER; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
963 ST_OMP_END_PARALLEL_MASTER)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel master") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel master"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_MASTER; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
964 matcho ("end parallel sections", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel sections") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel sections"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_SECTIONS; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
965 ST_OMP_END_PARALLEL_SECTIONS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel sections") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel sections"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_SECTIONS; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
966 matcho ("end parallel workshare", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel workshare"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_WORKSHARE; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
967 ST_OMP_END_PARALLEL_WORKSHARE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end parallel workshare"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL_WORKSHARE; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
968 matcho ("end parallel", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end parallel") == MATCH_YES)
goto do_spec_only; else if ((m2 = match_word ("end parallel"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_PARALLEL; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
969 matcho ("end scope", gfc_match_omp_end_nowait, ST_OMP_END_SCOPE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end scope") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end scope", gfc_match_omp_end_nowait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_SCOPE; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
970 matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end sections") == MATCH_YES)
goto do_spec_only; else if ((m2 = match_word ("end sections"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_SECTIONS; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
971 matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end single") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end single", gfc_match_omp_end_single
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_SINGLE; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
972 matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target data") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target data"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_DATA; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
973 matchs ("end target parallel do simd", gfc_match_omp_end_nowait,do { match m2; if (spec_only && gfc_match ("end target parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target parallel do simd", gfc_match_omp_end_nowait, &
old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
974 ST_OMP_END_TARGET_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end target parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target parallel do simd", gfc_match_omp_end_nowait, &
old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
975 matcho ("end target parallel do", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target parallel do"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL_DO; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
976 ST_OMP_END_TARGET_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target parallel do"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL_DO; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
977 matcho ("end target parallel loop", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel loop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end target parallel loop"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL_LOOP; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
978 ST_OMP_END_TARGET_PARALLEL_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel loop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("end target parallel loop"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL_LOOP; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
979 matcho ("end target parallel", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target parallel"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
980 ST_OMP_END_TARGET_PARALLEL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target parallel") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target parallel"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_PARALLEL; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
981 matchs ("end target simd", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_SIMD)do { match m2; if (spec_only && gfc_match ("end target simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target simd", gfc_match_omp_end_nowait, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
982 matchs ("end target teams distribute parallel do simd",do { match m2; if (spec_only && gfc_match ("end target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target teams distribute parallel do simd", gfc_match_omp_end_nowait
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
983 gfc_match_omp_end_nowait,do { match m2; if (spec_only && gfc_match ("end target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target teams distribute parallel do simd", gfc_match_omp_end_nowait
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
984 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target teams distribute parallel do simd", gfc_match_omp_end_nowait
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
985 matcho ("end target teams distribute parallel do", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end target teams distribute parallel do", gfc_match_omp_end_nowait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
986 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end target teams distribute parallel do", gfc_match_omp_end_nowait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
987 matchs ("end target teams distribute simd", gfc_match_omp_end_nowait,do { match m2; if (spec_only && gfc_match ("end target teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target teams distribute simd", gfc_match_omp_end_nowait
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
988 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("end target teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end target teams distribute simd", gfc_match_omp_end_nowait
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
989 matcho ("end target teams distribute", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams distribute"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end target teams distribute", gfc_match_omp_end_nowait, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
990 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams distribute"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end target teams distribute", gfc_match_omp_end_nowait, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
991 matcho ("end target teams loop", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target teams loop"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_TEAMS_LOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
992 ST_OMP_END_TARGET_TEAMS_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target teams loop"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_TEAMS_LOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
993 matcho ("end target teams", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target teams"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_TEAMS; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
994 ST_OMP_END_TARGET_TEAMS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target teams") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end target teams"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TARGET_TEAMS; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
995 matcho ("end target", gfc_match_omp_end_nowait, ST_OMP_END_TARGET)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end target") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end target", gfc_match_omp_end_nowait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_TARGET; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
996 matcho ("end taskgroup", gfc_match_omp_eos_error, ST_OMP_END_TASKGROUP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end taskgroup") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end taskgroup"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TASKGROUP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
997 matchs ("end taskloop simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end taskloop simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end taskloop simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
998 ST_OMP_END_TASKLOOP_SIMD)do { match m2; if (spec_only && gfc_match ("end taskloop simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end taskloop simd", gfc_match_omp_eos_error, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
999 matcho ("end taskloop", gfc_match_omp_eos_error, ST_OMP_END_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end taskloop") == MATCH_YES)
goto do_spec_only; else if ((m2 = match_word ("end taskloop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TASKLOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1000 matcho ("end task", gfc_match_omp_eos_error, ST_OMP_END_TASK)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end task") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end task", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_TASK; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1001 matchs ("end teams distribute parallel do simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end teams distribute parallel do simd", gfc_match_omp_eos_error
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1002 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("end teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end teams distribute parallel do simd", gfc_match_omp_eos_error
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1003 matcho ("end teams distribute parallel do", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end teams distribute parallel do", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1004 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"end teams distribute parallel do", gfc_match_omp_eos_error, &
old_locus)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1005 matchs ("end teams distribute simd", gfc_match_omp_eos_error,do { match m2; if (spec_only && gfc_match ("end teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end teams distribute simd", gfc_match_omp_eos_error, &
old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1006 ST_OMP_END_TEAMS_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("end teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("end teams distribute simd", gfc_match_omp_eos_error, &
old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1007 matcho ("end teams distribute", gfc_match_omp_eos_error,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams distribute") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end teams distribute"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TEAMS_DISTRIBUTE; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1008 ST_OMP_END_TEAMS_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams distribute") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end teams distribute"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TEAMS_DISTRIBUTE; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1009 matcho ("end teams loop", gfc_match_omp_eos_error, ST_OMP_END_TEAMS_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end teams loop"
, gfc_match_omp_eos_error, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_TEAMS_LOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1010 matcho ("end teams", gfc_match_omp_eos_error, ST_OMP_END_TEAMS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end teams") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("end teams", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_END_TEAMS; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1011 matcho ("end workshare", gfc_match_omp_end_nowait,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end workshare"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_WORKSHARE; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
1012 ST_OMP_END_WORKSHARE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("end workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("end workshare"
, gfc_match_omp_end_nowait, &old_locus)) == MATCH_YES) { ret
= ST_OMP_END_WORKSHARE; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1013 break;
1014 case 'f':
1015 matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("flush") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("flush", gfc_match_omp_flush, &
old_locus)) == MATCH_YES) { ret = ST_OMP_FLUSH; goto finish; }
else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1016 break;
1017 case 'm':
1018 matcho ("masked taskloop simd", gfc_match_omp_masked_taskloop_simd,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("masked taskloop simd") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("masked taskloop simd"
, gfc_match_omp_masked_taskloop_simd, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASKED_TASKLOOP_SIMD; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1019 ST_OMP_MASKED_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("masked taskloop simd") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("masked taskloop simd"
, gfc_match_omp_masked_taskloop_simd, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASKED_TASKLOOP_SIMD; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1020 matcho ("masked taskloop", gfc_match_omp_masked_taskloop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("masked taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("masked taskloop"
, gfc_match_omp_masked_taskloop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASKED_TASKLOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1021 ST_OMP_MASKED_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("masked taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("masked taskloop"
, gfc_match_omp_masked_taskloop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASKED_TASKLOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1022 matcho ("masked", gfc_match_omp_masked, ST_OMP_MASKED)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("masked") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("masked", gfc_match_omp_masked, &
old_locus)) == MATCH_YES) { ret = ST_OMP_MASKED; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1023 matcho ("master taskloop simd", gfc_match_omp_master_taskloop_simd,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("master taskloop simd") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("master taskloop simd"
, gfc_match_omp_master_taskloop_simd, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASTER_TASKLOOP_SIMD; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1024 ST_OMP_MASTER_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("master taskloop simd") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("master taskloop simd"
, gfc_match_omp_master_taskloop_simd, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASTER_TASKLOOP_SIMD; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1025 matcho ("master taskloop", gfc_match_omp_master_taskloop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("master taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("master taskloop"
, gfc_match_omp_master_taskloop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASTER_TASKLOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1026 ST_OMP_MASTER_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("master taskloop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("master taskloop"
, gfc_match_omp_master_taskloop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_MASTER_TASKLOOP; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1027 matcho ("master", gfc_match_omp_master, ST_OMP_MASTER)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("master") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("master", gfc_match_omp_master, &
old_locus)) == MATCH_YES) { ret = ST_OMP_MASTER; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1028 break;
1029 case 'n':
1030 matcho ("nothing", gfc_match_omp_nothing, ST_NONE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("nothing") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("nothing", gfc_match_omp_nothing
, &old_locus)) == MATCH_YES) { ret = ST_NONE; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1031 break;
1032 case 'l':
1033 matchs ("loop", gfc_match_omp_loop, ST_OMP_LOOP)do { match m2; if (spec_only && gfc_match ("loop") ==
MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd (
"loop", gfc_match_omp_loop, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_LOOP; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1034 break;
1035 case 'o':
1036 if (gfc_match ("ordered depend (") == MATCH_YES
1037 || gfc_match ("ordered doacross (") == MATCH_YES)
1038 {
1039 gfc_current_locus = old_locus;
1040 if (!flag_openmpglobal_options.x_flag_openmp)
1041 break;
1042 matcho ("ordered", gfc_match_omp_ordered_depend,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("ordered") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("ordered", gfc_match_omp_ordered_depend
, &old_locus)) == MATCH_YES) { ret = ST_OMP_ORDERED_DEPEND
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1043 ST_OMP_ORDERED_DEPEND)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("ordered") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("ordered", gfc_match_omp_ordered_depend
, &old_locus)) == MATCH_YES) { ret = ST_OMP_ORDERED_DEPEND
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1044 }
1045 else
1046 matchs ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED)do { match m2; if (spec_only && gfc_match ("ordered")
== MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("ordered", gfc_match_omp_ordered, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_ORDERED; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1047 break;
1048 case 'p':
1049 matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,do { match m2; if (spec_only && gfc_match ("parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("parallel do simd", gfc_match_omp_parallel_do_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1050 ST_OMP_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("parallel do simd", gfc_match_omp_parallel_do_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1051 matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel do") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("parallel do", gfc_match_omp_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_DO; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1052 matcho ("parallel loop", gfc_match_omp_parallel_loop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel loop"
, gfc_match_omp_parallel_loop, &old_locus)) == MATCH_YES)
{ ret = ST_OMP_PARALLEL_LOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
1053 ST_OMP_PARALLEL_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel loop"
, gfc_match_omp_parallel_loop, &old_locus)) == MATCH_YES)
{ ret = ST_OMP_PARALLEL_LOOP; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1054 matcho ("parallel masked taskloop simd",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel masked taskloop simd", gfc_match_omp_parallel_masked_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1055 gfc_match_omp_parallel_masked_taskloop_simd,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel masked taskloop simd", gfc_match_omp_parallel_masked_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1056 ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel masked taskloop simd", gfc_match_omp_parallel_masked_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1057 matcho ("parallel masked taskloop",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel masked taskloop"
, gfc_match_omp_parallel_masked_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1058 gfc_match_omp_parallel_masked_taskloop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel masked taskloop"
, gfc_match_omp_parallel_masked_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1059 ST_OMP_PARALLEL_MASKED_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel masked taskloop"
, gfc_match_omp_parallel_masked_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASKED_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1060 matcho ("parallel masked", gfc_match_omp_parallel_masked,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel masked"
, gfc_match_omp_parallel_masked, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_MASKED; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1061 ST_OMP_PARALLEL_MASKED)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel masked") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel masked"
, gfc_match_omp_parallel_masked, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_MASKED; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1062 matcho ("parallel master taskloop simd",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel master taskloop simd", gfc_match_omp_parallel_master_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1063 gfc_match_omp_parallel_master_taskloop_simd,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel master taskloop simd", gfc_match_omp_parallel_master_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1064 ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop simd"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"parallel master taskloop simd", gfc_match_omp_parallel_master_taskloop_simd
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1065 matcho ("parallel master taskloop",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel master taskloop"
, gfc_match_omp_parallel_master_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1066 gfc_match_omp_parallel_master_taskloop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel master taskloop"
, gfc_match_omp_parallel_master_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1067 ST_OMP_PARALLEL_MASTER_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master taskloop") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("parallel master taskloop"
, gfc_match_omp_parallel_master_taskloop, &old_locus)) ==
MATCH_YES) { ret = ST_OMP_PARALLEL_MASTER_TASKLOOP; goto finish
; } else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1068 matcho ("parallel master", gfc_match_omp_parallel_master,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel master"
, gfc_match_omp_parallel_master, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_MASTER; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1069 ST_OMP_PARALLEL_MASTER)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel master") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel master"
, gfc_match_omp_parallel_master, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_MASTER; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1070 matcho ("parallel sections", gfc_match_omp_parallel_sections,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel sections") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel sections"
, gfc_match_omp_parallel_sections, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_SECTIONS; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1071 ST_OMP_PARALLEL_SECTIONS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel sections") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel sections"
, gfc_match_omp_parallel_sections, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_SECTIONS; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1072 matcho ("parallel workshare", gfc_match_omp_parallel_workshare,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel workshare"
, gfc_match_omp_parallel_workshare, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_WORKSHARE; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1073 ST_OMP_PARALLEL_WORKSHARE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel workshare") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("parallel workshare"
, gfc_match_omp_parallel_workshare, &old_locus)) == MATCH_YES
) { ret = ST_OMP_PARALLEL_WORKSHARE; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1074 matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("parallel") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("parallel", gfc_match_omp_parallel
, &old_locus)) == MATCH_YES) { ret = ST_OMP_PARALLEL; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1075 break;
1076 case 'r':
1077 matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("requires") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("requires", gfc_match_omp_requires
, &old_locus)) == MATCH_YES) { ret = ST_OMP_REQUIRES; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1078 break;
1079 case 's':
1080 matchs ("scan", gfc_match_omp_scan, ST_OMP_SCAN)do { match m2; if (spec_only && gfc_match ("scan") ==
MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd (
"scan", gfc_match_omp_scan, &old_locus, &simd_matched
)) == MATCH_YES) { ret = ST_OMP_SCAN; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1081 matcho ("scope", gfc_match_omp_scope, ST_OMP_SCOPE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("scope") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("scope", gfc_match_omp_scope, &
old_locus)) == MATCH_YES) { ret = ST_OMP_SCOPE; goto finish; }
else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1082 matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("sections") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("sections", gfc_match_omp_sections
, &old_locus)) == MATCH_YES) { ret = ST_OMP_SECTIONS; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1083 matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("section") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("section", gfc_match_omp_eos_error
, &old_locus)) == MATCH_YES) { ret = ST_OMP_SECTION; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1084 matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("single") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("single", gfc_match_omp_single, &
old_locus)) == MATCH_YES) { ret = ST_OMP_SINGLE; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1085 break;
1086 case 't':
1087 matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target data") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("target data", gfc_match_omp_target_data
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TARGET_DATA; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1088 matcho ("target enter data", gfc_match_omp_target_enter_data,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target enter data") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target enter data"
, gfc_match_omp_target_enter_data, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_ENTER_DATA; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1089 ST_OMP_TARGET_ENTER_DATA)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target enter data") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target enter data"
, gfc_match_omp_target_enter_data, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_ENTER_DATA; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1090 matcho ("target exit data", gfc_match_omp_target_exit_data,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target exit data") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target exit data"
, gfc_match_omp_target_exit_data, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_EXIT_DATA; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1091 ST_OMP_TARGET_EXIT_DATA)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target exit data") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target exit data"
, gfc_match_omp_target_exit_data, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_EXIT_DATA; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1092 matchs ("target parallel do simd", gfc_match_omp_target_parallel_do_simd,do { match m2; if (spec_only && gfc_match ("target parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target parallel do simd", gfc_match_omp_target_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1093 ST_OMP_TARGET_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("target parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target parallel do simd", gfc_match_omp_target_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1094 matcho ("target parallel do", gfc_match_omp_target_parallel_do,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel do"
, gfc_match_omp_target_parallel_do, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL_DO; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1095 ST_OMP_TARGET_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel do") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel do"
, gfc_match_omp_target_parallel_do, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL_DO; goto finish; } else if (
m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1096 matcho ("target parallel loop", gfc_match_omp_target_parallel_loop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel loop"
, gfc_match_omp_target_parallel_loop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL_LOOP; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1097 ST_OMP_TARGET_PARALLEL_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel loop"
, gfc_match_omp_target_parallel_loop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL_LOOP; goto finish; } else if
(m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1098 matcho ("target parallel", gfc_match_omp_target_parallel,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel"
, gfc_match_omp_target_parallel, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0)
1099 ST_OMP_TARGET_PARALLEL)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target parallel") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target parallel"
, gfc_match_omp_target_parallel, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_PARALLEL; goto finish; } else if (m2 ==
MATCH_ERROR) goto error_handling; else undo_new_statement ()
; } while (0);
1100 matchs ("target simd", gfc_match_omp_target_simd, ST_OMP_TARGET_SIMD)do { match m2; if (spec_only && gfc_match ("target simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target simd", gfc_match_omp_target_simd, &old_locus, &
simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_SIMD; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1101 matchs ("target teams distribute parallel do simd",do { match m2; if (spec_only && gfc_match ("target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute parallel do simd", gfc_match_omp_target_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1102 gfc_match_omp_target_teams_distribute_parallel_do_simd,do { match m2; if (spec_only && gfc_match ("target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute parallel do simd", gfc_match_omp_target_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1103 ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("target teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute parallel do simd", gfc_match_omp_target_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1104 matcho ("target teams distribute parallel do",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"target teams distribute parallel do", gfc_match_omp_target_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1105 gfc_match_omp_target_teams_distribute_parallel_do,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"target teams distribute parallel do", gfc_match_omp_target_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1106 ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"target teams distribute parallel do", gfc_match_omp_target_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1107 matchs ("target teams distribute simd",do { match m2; if (spec_only && gfc_match ("target teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute simd", gfc_match_omp_target_teams_distribute_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1108 gfc_match_omp_target_teams_distribute_simd,do { match m2; if (spec_only && gfc_match ("target teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute simd", gfc_match_omp_target_teams_distribute_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1109 ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("target teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("target teams distribute simd", gfc_match_omp_target_teams_distribute_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1110 matcho ("target teams distribute", gfc_match_omp_target_teams_distribute,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams distribute") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("target teams distribute"
, gfc_match_omp_target_teams_distribute, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1111 ST_OMP_TARGET_TEAMS_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams distribute") ==
MATCH_YES) goto do_spec_only; else if ((m2 = match_word ("target teams distribute"
, gfc_match_omp_target_teams_distribute, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_TEAMS_DISTRIBUTE; goto finish; } else
if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1112 matcho ("target teams loop", gfc_match_omp_target_teams_loop,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target teams loop"
, gfc_match_omp_target_teams_loop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_TEAMS_LOOP; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1113 ST_OMP_TARGET_TEAMS_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams loop") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target teams loop"
, gfc_match_omp_target_teams_loop, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TARGET_TEAMS_LOOP; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1114 matcho ("target teams", gfc_match_omp_target_teams, ST_OMP_TARGET_TEAMS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target teams") == MATCH_YES)
goto do_spec_only; else if ((m2 = match_word ("target teams"
, gfc_match_omp_target_teams, &old_locus)) == MATCH_YES) {
ret = ST_OMP_TARGET_TEAMS; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1115 matcho ("target update", gfc_match_omp_target_update,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target update") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target update"
, gfc_match_omp_target_update, &old_locus)) == MATCH_YES)
{ ret = ST_OMP_TARGET_UPDATE; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
)
1116 ST_OMP_TARGET_UPDATE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target update") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("target update"
, gfc_match_omp_target_update, &old_locus)) == MATCH_YES)
{ ret = ST_OMP_TARGET_UPDATE; goto finish; } else if (m2 == MATCH_ERROR
) goto error_handling; else undo_new_statement (); } while (0
);
1117 matcho ("target", gfc_match_omp_target, ST_OMP_TARGET)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("target") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("target", gfc_match_omp_target, &
old_locus)) == MATCH_YES) { ret = ST_OMP_TARGET; goto finish;
} else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1118 matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("taskgroup") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("taskgroup", gfc_match_omp_taskgroup
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TASKGROUP; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1119 matchs ("taskloop simd", gfc_match_omp_taskloop_simd,do { match m2; if (spec_only && gfc_match ("taskloop simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("taskloop simd", gfc_match_omp_taskloop_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1120 ST_OMP_TASKLOOP_SIMD)do { match m2; if (spec_only && gfc_match ("taskloop simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("taskloop simd", gfc_match_omp_taskloop_simd, &old_locus
, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TASKLOOP_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1121 matcho ("taskloop", gfc_match_omp_taskloop, ST_OMP_TASKLOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("taskloop") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("taskloop", gfc_match_omp_taskloop
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TASKLOOP; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1122 matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("taskwait") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("taskwait", gfc_match_omp_taskwait
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TASKWAIT; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1123 matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("taskyield") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("taskyield", gfc_match_omp_taskyield
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TASKYIELD; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1124 matcho ("task", gfc_match_omp_task, ST_OMP_TASK)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("task") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("task", gfc_match_omp_task, &
old_locus)) == MATCH_YES) { ret = ST_OMP_TASK; goto finish; }
else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1125 matchs ("teams distribute parallel do simd",do { match m2; if (spec_only && gfc_match ("teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("teams distribute parallel do simd", gfc_match_omp_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1126 gfc_match_omp_teams_distribute_parallel_do_simd,do { match m2; if (spec_only && gfc_match ("teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("teams distribute parallel do simd", gfc_match_omp_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1127 ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)do { match m2; if (spec_only && gfc_match ("teams distribute parallel do simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("teams distribute parallel do simd", gfc_match_omp_teams_distribute_parallel_do_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1128 matcho ("teams distribute parallel do",do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"teams distribute parallel do", gfc_match_omp_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1129 gfc_match_omp_teams_distribute_parallel_do,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"teams distribute parallel do", gfc_match_omp_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1130 ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams distribute parallel do"
) == MATCH_YES) goto do_spec_only; else if ((m2 = match_word (
"teams distribute parallel do", gfc_match_omp_teams_distribute_parallel_do
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1131 matchs ("teams distribute simd", gfc_match_omp_teams_distribute_simd,do { match m2; if (spec_only && gfc_match ("teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("teams distribute simd", gfc_match_omp_teams_distribute_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1132 ST_OMP_TEAMS_DISTRIBUTE_SIMD)do { match m2; if (spec_only && gfc_match ("teams distribute simd"
) == MATCH_YES) goto do_spec_only; if ((m2 = match_word_omp_simd
("teams distribute simd", gfc_match_omp_teams_distribute_simd
, &old_locus, &simd_matched)) == MATCH_YES) { ret = ST_OMP_TEAMS_DISTRIBUTE_SIMD
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1133 matcho ("teams distribute", gfc_match_omp_teams_distribute,do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams distribute") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("teams distribute"
, gfc_match_omp_teams_distribute, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TEAMS_DISTRIBUTE; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0)
1134 ST_OMP_TEAMS_DISTRIBUTE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams distribute") == MATCH_YES
) goto do_spec_only; else if ((m2 = match_word ("teams distribute"
, gfc_match_omp_teams_distribute, &old_locus)) == MATCH_YES
) { ret = ST_OMP_TEAMS_DISTRIBUTE; goto finish; } else if (m2
== MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1135 matcho ("teams loop", gfc_match_omp_teams_loop, ST_OMP_TEAMS_LOOP)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams loop") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("teams loop", gfc_match_omp_teams_loop
, &old_locus)) == MATCH_YES) { ret = ST_OMP_TEAMS_LOOP; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1136 matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("teams") == MATCH_YES) goto do_spec_only
; else if ((m2 = match_word ("teams", gfc_match_omp_teams, &
old_locus)) == MATCH_YES) { ret = ST_OMP_TEAMS; goto finish; }
else if (m2 == MATCH_ERROR) goto error_handling; else undo_new_statement
(); } while (0);
1137 matchdo ("threadprivate", gfc_match_omp_threadprivate,do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("threadprivate", gfc_match_omp_threadprivate
, &old_locus)) == MATCH_YES) { ret = ST_OMP_THREADPRIVATE
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0)
1138 ST_OMP_THREADPRIVATE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
(m2 = match_word ("threadprivate", gfc_match_omp_threadprivate
, &old_locus)) == MATCH_YES) { ret = ST_OMP_THREADPRIVATE
; goto finish; } else if (m2 == MATCH_ERROR) goto error_handling
; else undo_new_statement (); } while (0);
1139 break;
1140 case 'w':
1141 matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE)do { match m2; if (!global_options.x_flag_openmp) ; else if (
spec_only && gfc_match ("workshare") == MATCH_YES) goto
do_spec_only; else if ((m2 = match_word ("workshare", gfc_match_omp_workshare
, &old_locus)) == MATCH_YES) { ret = ST_OMP_WORKSHARE; goto
finish; } else if (m2 == MATCH_ERROR) goto error_handling; else
undo_new_statement (); } while (0);
1142 break;
1143 }
1144
1145 /* All else has failed, so give up. See if any of the matchers has
1146 stored an error message of some sort. Don't error out if
1147 not -fopenmp and simd_matched is false, i.e. if a directive other
1148 than one marked with match has been seen. */
1149
1150 error_handling:
1151 if (flag_openmpglobal_options.x_flag_openmp || simd_matched)
1152 {
1153 if (!gfc_error_check ())
1154 gfc_error_now ("Unclassifiable OpenMP directive at %C");
1155 }
1156
1157 reject_statement ();
1158
1159 gfc_error_recovery ();
1160
1161 return ST_NONE;
1162
1163 finish:
1164 if (!pure_ok)
1165 {
1166 gfc_unset_implicit_pure (NULL__null);
1167
1168 if (!flag_openmpglobal_options.x_flag_openmp && gfc_pure (NULL__null))
1169 {
1170 gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET "
1171 "at %C may not appear in PURE procedures");
1172 reject_statement ();
1173 gfc_error_recovery ();
1174 return ST_NONE;
1175 }
1176 }
1177 switch (ret)
1178 {
1179 /* Set omp_target_seen; exclude ST_OMP_DECLARE_TARGET.
1180 FIXME: Get clarification, cf. OpenMP Spec Issue #3240. */
1181 case ST_OMP_TARGET:
1182 case ST_OMP_TARGET_DATA:
1183 case ST_OMP_TARGET_ENTER_DATA:
1184 case ST_OMP_TARGET_EXIT_DATA:
1185 case ST_OMP_TARGET_TEAMS:
1186 case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
1187 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
1188 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
1189 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
1190 case ST_OMP_TARGET_TEAMS_LOOP:
1191 case ST_OMP_TARGET_PARALLEL:
1192 case ST_OMP_TARGET_PARALLEL_DO:
1193 case ST_OMP_TARGET_PARALLEL_DO_SIMD:
1194 case ST_OMP_TARGET_PARALLEL_LOOP:
1195 case ST_OMP_TARGET_SIMD:
1196 case ST_OMP_TARGET_UPDATE:
1197 {
1198 gfc_namespace *prog_unit = gfc_current_ns;
1199 while (prog_unit->parent)
1200 {
1201 if (gfc_state_stack->previous
1202 && gfc_state_stack->previous->state == COMP_INTERFACE)
1203 break;
1204 prog_unit = prog_unit->parent;
1205 }
1206 prog_unit->omp_target_seen = true;
1207 break;
1208 }
1209 case ST_OMP_ERROR:
1210 if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION)
1211 return ST_NONE;
1212 default:
1213 break;
1214 }
1215 return ret;
1216
1217 do_spec_only:
1218 reject_statement ();
1219 gfc_clear_error ();
1220 gfc_buffer_error (false);
1221 gfc_current_locus = old_locus;
1222 return ST_GET_FCN_CHARACTERISTICS;
1223}
1224
1225static gfc_statement
1226decode_gcc_attribute (void)
1227{
1228 locus old_locus;
1229
1230 gfc_enforce_clean_symbol_state ();
1231
1232 gfc_clear_error (); /* Clear any pending errors. */
1233 gfc_clear_warning (); /* Clear any pending warnings. */
1234 old_locus = gfc_current_locus;
1235
1236 match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
1237 match ("unroll", gfc_match_gcc_unroll, ST_NONE);
1238 match ("builtin", gfc_match_gcc_builtin, ST_NONE);
1239 match ("ivdep", gfc_match_gcc_ivdep, ST_NONE);
1240 match ("vector", gfc_match_gcc_vector, ST_NONE);
1241 match ("novector", gfc_match_gcc_novector, ST_NONE);
1242
1243 /* All else has failed, so give up. See if any of the matchers has
1244 stored an error message of some sort. */
1245
1246 if (!gfc_error_check ())
1247 {
1248 if (pedanticglobal_options.x_pedantic)
1249 gfc_error_now ("Unclassifiable GCC directive at %C");
1250 else
1251 gfc_warning_now (0, "Unclassifiable GCC directive at %C, ignored");
1252 }
1253
1254 reject_statement ();
1255
1256 gfc_error_recovery ();
1257
1258 return ST_NONE;
1259}
1260
1261#undef match
1262
1263/* Assert next length characters to be equal to token in free form. */
1264
1265static void
1266verify_token_free (const char* token, int length, bool last_was_use_stmt)
1267{
1268 int i;
1269 char c;
1270
1271 c = gfc_next_ascii_char ();
1272 for (i = 0; i < length; i++, c = gfc_next_ascii_char ())
1273 gcc_assert (c == token[i])((void)(!(c == token[i]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1273, __FUNCTION__), 0 : 0));
1274
1275 gcc_assert (gfc_is_whitespace(c))((void)(!(((c==' ') || (c=='\t') || (c=='\f'))) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1275, __FUNCTION__), 0 : 0));
1276 gfc_gobble_whitespace ();
1277 if (last_was_use_stmt)
1278 use_modules ();
1279}
1280
1281/* Get the next statement in free form source. */
1282
1283static gfc_statement
1284next_free (void)
1285{
1286 match m;
1287 int i, cnt, at_bol;
1288 char c;
1289
1290 at_bol = gfc_at_bol ();
1291 gfc_gobble_whitespace ();
1292
1293 c = gfc_peek_ascii_char ();
1294
1295 if (ISDIGIT (c)(_sch_istable[(c) & 0xff] & (unsigned short)(_sch_isdigit
)))
1296 {
1297 char d;
1298
1299 /* Found a statement label? */
1300 m = gfc_match_st_label (&gfc_statement_label);
1301
1302 d = gfc_peek_ascii_char ();
1303 if (m != MATCH_YES || !gfc_is_whitespace (d)((d==' ') || (d=='\t') || (d=='\f')))
1304 {
1305 gfc_match_small_literal_int (&i, &cnt);
1306
1307 if (cnt > 5)
1308 gfc_error_now ("Too many digits in statement label at %C");
1309
1310 if (i == 0)
1311 gfc_error_now ("Zero is not a valid statement label at %C");
1312
1313 do
1314 c = gfc_next_ascii_char ();
1315 while (ISDIGIT(c)(_sch_istable[(c) & 0xff] & (unsigned short)(_sch_isdigit
)));
1316
1317 if (!gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')))
1318 gfc_error_now ("Non-numeric character in statement label at %C");
1319
1320 return ST_NONE;
1321 }
1322 else
1323 {
1324 label_locus = gfc_current_locus;
1325
1326 gfc_gobble_whitespace ();
1327
1328 if (at_bol && gfc_peek_ascii_char () == ';')
1329 {
1330 gfc_error_now ("Semicolon at %C needs to be preceded by "
1331 "statement");
1332 gfc_next_ascii_char (); /* Eat up the semicolon. */
1333 return ST_NONE;
1334 }
1335
1336 if (gfc_match_eos () == MATCH_YES)
1337 gfc_error_now ("Statement label without statement at %L",
1338 &label_locus);
1339 }
1340 }
1341 else if (c == '!')
1342 {
1343 /* Comments have already been skipped by the time we get here,
1344 except for GCC attributes and OpenMP/OpenACC directives. */
1345
1346 gfc_next_ascii_char (); /* Eat up the exclamation sign. */
1347 c = gfc_peek_ascii_char ();
1348
1349 if (c == 'g')
1350 {
1351 int i;
1352
1353 c = gfc_next_ascii_char ();
1354 for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
1355 gcc_assert (c == "gcc$"[i])((void)(!(c == "gcc$"[i]) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1355, __FUNCTION__), 0 : 0));
1356
1357 gfc_gobble_whitespace ();
1358 return decode_gcc_attribute ();
1359
1360 }
1361 else if (c == '$')
1362 {
1363 /* Since both OpenMP and OpenACC directives starts with
1364 !$ character sequence, we must check all flags combinations */
1365 if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
1366 && !flag_openaccglobal_options.x_flag_openacc)
1367 {
1368 verify_token_free ("$omp", 4, last_was_use_stmt);
1369 return decode_omp_directive ();
1370 }
1371 else if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
1372 && flag_openaccglobal_options.x_flag_openacc)
1373 {
1374 gfc_next_ascii_char (); /* Eat up dollar character */
1375 c = gfc_peek_ascii_char ();
1376
1377 if (c == 'o')
1378 {
1379 verify_token_free ("omp", 3, last_was_use_stmt);
1380 return decode_omp_directive ();
1381 }
1382 else if (c == 'a')
1383 {
1384 verify_token_free ("acc", 3, last_was_use_stmt);
1385 return decode_oacc_directive ();
1386 }
1387 }
1388 else if (flag_openaccglobal_options.x_flag_openacc)
1389 {
1390 verify_token_free ("$acc", 4, last_was_use_stmt);
1391 return decode_oacc_directive ();
1392 }
1393 }
1394 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1394, __FUNCTION__));
1395 }
1396
1397 if (at_bol && c == ';')
1398 {
1399 if (!(gfc_option.allow_std & GFC_STD_F2008(1<<7)))
1400 gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
1401 "statement");
1402 gfc_next_ascii_char (); /* Eat up the semicolon. */
1403 return ST_NONE;
1404 }
1405
1406 return decode_statement ();
1407}
1408
1409/* Assert next length characters to be equal to token in fixed form. */
1410
1411static bool
1412verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
1413{
1414 int i;
1415 char c = gfc_next_char_literal (NONSTRING);
1416
1417 for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING))
1418 gcc_assert ((char) gfc_wide_tolower (c) == token[i])((void)(!((char) gfc_wide_tolower (c) == token[i]) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1418, __FUNCTION__), 0 : 0));
1419
1420 if (c != ' ' && c != '0')
1421 {
1422 gfc_buffer_error (false);
1423 gfc_error ("Bad continuation line at %C");
1424 return false;
1425 }
1426 if (last_was_use_stmt)
1427 use_modules ();
1428
1429 return true;
1430}
1431
1432/* Get the next statement in fixed-form source. */
1433
1434static gfc_statement
1435next_fixed (void)
1436{
1437 int label, digit_flag, i;
1438 locus loc;
1439 gfc_char_t c;
1440
1441 if (!gfc_at_bol ())
1442 return decode_statement ();
1443
1444 /* Skip past the current label field, parsing a statement label if
1445 one is there. This is a weird number parser, since the number is
1446 contained within five columns and can have any kind of embedded
1447 spaces. We also check for characters that make the rest of the
1448 line a comment. */
1449
1450 label = 0;
1451 digit_flag = 0;
1452
1453 for (i = 0; i < 5; i++)
1454 {
1455 c = gfc_next_char_literal (NONSTRING);
1456
1457 switch (c)
1458 {
1459 case ' ':
1460 break;
1461
1462 case '0':
1463 case '1':
1464 case '2':
1465 case '3':
1466 case '4':
1467 case '5':
1468 case '6':
1469 case '7':
1470 case '8':
1471 case '9':
1472 label = label * 10 + ((unsigned char) c - '0');
1473 label_locus = gfc_current_locus;
1474 digit_flag = 1;
1475 break;
1476
1477 /* Comments have already been skipped by the time we get
1478 here, except for GCC attributes and OpenMP directives. */
1479
1480 case '*':
1481 c = gfc_next_char_literal (NONSTRING);
1482
1483 if (TOLOWER (c)_sch_tolower[(c) & 0xff] == 'g')
1484 {
1485 for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
1486 gcc_assert (TOLOWER (c) == "gcc$"[i])((void)(!(_sch_tolower[(c) & 0xff] == "gcc$"[i]) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1486, __FUNCTION__), 0 : 0));
1487
1488 return decode_gcc_attribute ();
1489 }
1490 else if (c == '$')
1491 {
1492 if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
1493 && !flag_openaccglobal_options.x_flag_openacc)
1494 {
1495 if (!verify_token_fixed ("omp", 3, last_was_use_stmt))
1496 return ST_NONE;
1497 return decode_omp_directive ();
1498 }
1499 else if ((flag_openmpglobal_options.x_flag_openmp || flag_openmp_simdglobal_options.x_flag_openmp_simd)
1500 && flag_openaccglobal_options.x_flag_openacc)
1501 {
1502 c = gfc_next_char_literal(NONSTRING);
1503 if (c == 'o' || c == 'O')
1504 {
1505 if (!verify_token_fixed ("mp", 2, last_was_use_stmt))
1506 return ST_NONE;
1507 return decode_omp_directive ();
1508 }
1509 else if (c == 'a' || c == 'A')
1510 {
1511 if (!verify_token_fixed ("cc", 2, last_was_use_stmt))
1512 return ST_NONE;
1513 return decode_oacc_directive ();
1514 }
1515 }
1516 else if (flag_openaccglobal_options.x_flag_openacc)
1517 {
1518 if (!verify_token_fixed ("acc", 3, last_was_use_stmt))
1519 return ST_NONE;
1520 return decode_oacc_directive ();
1521 }
1522 }
1523 gcc_fallthrough ();
1524
1525 /* Comments have already been skipped by the time we get
1526 here so don't bother checking for them. */
1527
1528 default:
1529 gfc_buffer_error (false);
1530 gfc_error ("Non-numeric character in statement label at %C");
1531 return ST_NONE;
1532 }
1533 }
1534
1535 if (digit_flag)
1536 {
1537 if (label == 0)
1538 gfc_warning_now (0, "Zero is not a valid statement label at %C");
1539 else
1540 {
1541 /* We've found a valid statement label. */
1542 gfc_statement_label = gfc_get_st_label (label);
1543 }
1544 }
1545
1546 /* Since this line starts a statement, it cannot be a continuation
1547 of a previous statement. If we see something here besides a
1548 space or zero, it must be a bad continuation line. */
1549
1550 c = gfc_next_char_literal (NONSTRING);
1551 if (c == '\n')
1552 goto blank_line;
1553
1554 if (c != ' ' && c != '0')
1555 {
1556 gfc_buffer_error (false);
1557 gfc_error ("Bad continuation line at %C");
1558 return ST_NONE;
1559 }
1560
1561 /* Now that we've taken care of the statement label columns, we have
1562 to make sure that the first nonblank character is not a '!'. If
1563 it is, the rest of the line is a comment. */
1564
1565 do
1566 {
1567 loc = gfc_current_locus;
1568 c = gfc_next_char_literal (NONSTRING);
1569 }
1570 while (gfc_is_whitespace (c)((c==' ') || (c=='\t') || (c=='\f')));
1571
1572 if (c == '!')
1573 goto blank_line;
1574 gfc_current_locus = loc;
1575
1576 if (c == ';')
1577 {
1578 if (digit_flag)
1579 gfc_error_now ("Semicolon at %C needs to be preceded by statement");
1580 else if (!(gfc_option.allow_std & GFC_STD_F2008(1<<7)))
1581 gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
1582 "statement");
1583 return ST_NONE;
1584 }
1585
1586 if (gfc_match_eos () == MATCH_YES)
1587 goto blank_line;
1588
1589 /* At this point, we've got a nonblank statement to parse. */
1590 return decode_statement ();
1591
1592blank_line:
1593 if (digit_flag)
1594 gfc_error_now ("Statement label without statement at %L", &label_locus);
1595
1596 gfc_current_locus.lb->truncated = 0;
1597 gfc_advance_line ();
1598 return ST_NONE;
1599}
1600
1601
1602/* Return the next non-ST_NONE statement to the caller. We also worry
1603 about including files and the ends of include files at this stage. */
1604
1605static gfc_statement
1606next_statement (void)
1607{
1608 gfc_statement st;
1609 locus old_locus;
1610
1611 gfc_enforce_clean_symbol_state ();
1612
1613 gfc_new_block = NULL__null;
1614
1615 gfc_current_ns->old_equiv = gfc_current_ns->equiv;
1616 gfc_current_ns->old_data = gfc_current_ns->data;
1617 for (;;)
1618 {
1619 gfc_statement_label = NULL__null;
1620 gfc_buffer_error (true);
1621
1622 if (gfc_at_eol ())
1623 gfc_advance_line ();
1624
1625 gfc_skip_comments ();
1626
1627 if (gfc_at_end ())
1628 {
1629 st = ST_NONE;
1630 break;
1631 }
1632
1633 if (gfc_define_undef_line ())
1634 continue;
1635
1636 old_locus = gfc_current_locus;
1637
1638 st = (gfc_current_form == FORM_FIXED) ? next_fixed () : next_free ();
1639
1640 if (st != ST_NONE)
1641 break;
1642 }
1643
1644 gfc_buffer_error (false);
1645
1646 if (st == ST_GET_FCN_CHARACTERISTICS)
1647 {
1648 if (gfc_statement_label != NULL__null)
1649 {
1650 gfc_free_st_label (gfc_statement_label);
1651 gfc_statement_label = NULL__null;
1652 }
1653 gfc_current_locus = old_locus;
1654 }
1655
1656 if (st != ST_NONE)
1657 check_statement_label (st);
1658
1659 return st;
1660}
1661
1662
1663/****************************** Parser ***********************************/
1664
1665/* The parser subroutines are of type 'try' that fail if the file ends
1666 unexpectedly. */
1667
1668/* Macros that expand to case-labels for various classes of
1669 statements. Start with executable statements that directly do
1670 things. */
1671
1672#define case_executablecase ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: case ST_CLOSE
: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: case
ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: case
ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: case
ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: case ST_POINTER_ASSIGNMENT
: case ST_EXIT: case ST_CYCLE: case ST_ASSIGNMENT: case ST_ARITHMETIC_IF
: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT: case
ST_FLUSH: case ST_OMP_FLUSH: case ST_OMP_BARRIER: case ST_OMP_TASKWAIT
: case ST_OMP_TASKYIELD: case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT
: case ST_OMP_DEPOBJ: case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA
: case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case
ST_OMP_ERROR: case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL
: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case
ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: case ST_END_TEAM
: case ST_SYNC_TEAM: case ST_EVENT_POST: case ST_EVENT_WAIT: case
ST_FAIL_IMAGE: case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE
: case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA case ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: \
1673 case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \
1674 case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \
1675 case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \
1676 case ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: \
1677 case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
1678 case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
1679 case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
1680 case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
1681 case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
1682 case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
1683 case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
1684 case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
1685 case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
1686 case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
1687 case ST_END_TEAM: case ST_SYNC_TEAM: \
1688 case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
1689 case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
1690 case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
1691
1692/* Statements that mark other executable statements. */
1693
1694#define case_exec_markerscase ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: case ST_BLOCK
: case ST_ASSOCIATE: case ST_WHERE_BLOCK: case ST_SELECT_CASE
: case ST_SELECT_TYPE: case ST_SELECT_RANK: case ST_OMP_PARALLEL
: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASKED_TASKLOOP
: case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER
: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED
: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP
: case ST_OMP_MASKED_TASKLOOP_SIMD: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP
: case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE
: case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC
: case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: case
ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: case ST_OMP_DO_SIMD
: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA
: case ST_OMP_TARGET_TEAMS: case ST_OMP_TARGET_TEAMS_DISTRIBUTE
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS
: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_SIMD
: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
: case ST_OMP_DISTRIBUTE: case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL
: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD
: case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD
: case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP
: case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP
: case ST_OMP_ASSUME: case ST_CRITICAL: case ST_OACC_PARALLEL_LOOP
: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: case ST_OACC_DATA
: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: case ST_OACC_ATOMIC case ST_DO: case ST_FORALL_BLOCK: \
1695 case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
1696 case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
1697 case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: \
1698 case ST_OMP_PARALLEL_MASKED_TASKLOOP: \
1699 case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER: \
1700 case ST_OMP_PARALLEL_MASTER_TASKLOOP: \
1701 case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \
1702 case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
1703 case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \
1704 case ST_OMP_MASKED_TASKLOOP_SIMD: \
1705 case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
1706 case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE: \
1707 case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
1708 case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
1709 case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
1710 case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: \
1711 case ST_OMP_TARGET_DATA: case ST_OMP_TARGET_TEAMS: \
1712 case ST_OMP_TARGET_TEAMS_DISTRIBUTE: \
1713 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: \
1714 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: \
1715 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
1716 case ST_OMP_TEAMS: case ST_OMP_TEAMS_DISTRIBUTE: \
1717 case ST_OMP_TEAMS_DISTRIBUTE_SIMD: \
1718 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \
1719 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \
1720 case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \
1721 case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL: \
1722 case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \
1723 case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
1724 case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \
1725 case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \
1726 case ST_OMP_ASSUME: \
1727 case ST_CRITICAL: \
1728 case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
1729 case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
1730 case ST_OACC_KERNELS_LOOP: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: \
1731 case ST_OACC_ATOMIC
1732
1733/* Declaration statements */
1734
1735#define case_declcase ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: case ST_EQUIVALENCE
: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: case ST_TYPE:
case ST_INTERFACE: case ST_PROCEDURE case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
1736 case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
1737 case ST_TYPE: case ST_INTERFACE: case ST_PROCEDURE
1738
1739/* OpenMP and OpenACC declaration statements, which may appear anywhere in
1740 the specification part. */
1741
1742#define case_omp_declcase ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_TARGET
: case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT:
case ST_OMP_ASSUMES: case ST_OMP_REQUIRES: case ST_OACC_ROUTINE
: case ST_OACC_DECLARE case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
1743 case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
1744 case ST_OMP_DECLARE_VARIANT: case ST_OMP_ASSUMES: \
1745 case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
1746
1747/* Block end statements. Errors associated with interchanging these
1748 are detected in gfc_match_end(). */
1749
1750#define case_endcase ST_END_BLOCK_DATA: case ST_END_FUNCTION: case ST_END_PROGRAM
: case ST_END_SUBROUTINE: case ST_END_BLOCK: case ST_END_ASSOCIATE case ST_END_BLOCK_DATA: case ST_END_FUNCTION: \
1751 case ST_END_PROGRAM: case ST_END_SUBROUTINE: \
1752 case ST_END_BLOCK: case ST_END_ASSOCIATE
1753
1754
1755/* Push a new state onto the stack. */
1756
1757static void
1758push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
1759{
1760 p->state = new_state;
1761 p->previous = gfc_state_stack;
1762 p->sym = sym;
1763 p->head = p->tail = NULL__null;
1764 p->do_variable = NULL__null;
1765 if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT)
1766 p->ext.oacc_declare_clauses = NULL__null;
1767
1768 /* If this the state of a construct like BLOCK, DO or IF, the corresponding
1769 construct statement was accepted right before pushing the state. Thus,
1770 the construct's gfc_code is available as tail of the parent state. */
1771 gcc_assert (gfc_state_stack)((void)(!(gfc_state_stack) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 1771, __FUNCTION__), 0 : 0));
1772 p->construct = gfc_state_stack->tail;
1773
1774 gfc_state_stack = p;
1775}
1776
1777
1778/* Pop the current state. */
1779static void
1780pop_state (void)
1781{
1782 gfc_state_stack = gfc_state_stack->previous;
1783}
1784
1785
1786/* Try to find the given state in the state stack. */
1787
1788bool
1789gfc_find_state (gfc_compile_state state)
1790{
1791 gfc_state_data *p;
1792
1793 for (p = gfc_state_stack; p; p = p->previous)
1794 if (p->state == state)
1795 break;
1796
1797 return (p == NULL__null) ? false : true;
1798}
1799
1800
1801/* Starts a new level in the statement list. */
1802
1803static gfc_code *
1804new_level (gfc_code *q)
1805{
1806 gfc_code *p;
1807
1808 p = q->block = gfc_get_code (EXEC_NOP);
1809
1810 gfc_state_stack->head = gfc_state_stack->tail = p;
1811
1812 return p;
1813}
1814
1815
1816/* Add the current new_st code structure and adds it to the current
1817 program unit. As a side-effect, it zeroes the new_st. */
1818
1819static gfc_code *
1820add_statement (void)
1821{
1822 gfc_code *p;
1823
1824 p = XCNEW (gfc_code)((gfc_code *) xcalloc (1, sizeof (gfc_code)));
1825 *p = new_st;
1826
1827 p->loc = gfc_current_locus;
1828
1829 if (gfc_state_stack->head == NULL__null)
1830 gfc_state_stack->head = p;
1831 else
1832 gfc_state_stack->tail->next = p;
1833
1834 while (p->next != NULL__null)
1835 p = p->next;
1836
1837 gfc_state_stack->tail = p;
1838
1839 gfc_clear_new_st ();
1840
1841 return p;
1842}
1843
1844
1845/* Frees everything associated with the current statement. */
1846
1847static void
1848undo_new_statement (void)
1849{
1850 gfc_free_statements (new_st.block);
1851 gfc_free_statements (new_st.next);
1852 gfc_free_statement (&new_st);
1853 gfc_clear_new_st ();
1854}
1855
1856
1857/* If the current statement has a statement label, make sure that it
1858 is allowed to, or should have one. */
1859
1860static void
1861check_statement_label (gfc_statement st)
1862{
1863 gfc_sl_type type;
1864
1865 if (gfc_statement_label == NULL__null)
1866 {
1867 if (st == ST_FORMAT)
1868 gfc_error ("FORMAT statement at %L does not have a statement label",
1869 &new_st.loc);
1870 return;
1871 }
1872
1873 switch (st)
1874 {
1875 case ST_END_PROGRAM:
1876 case ST_END_FUNCTION:
1877 case ST_END_SUBROUTINE:
1878 case ST_ENDDO:
1879 case ST_ENDIF:
1880 case ST_END_SELECT:
1881 case ST_END_CRITICAL:
1882 case ST_END_BLOCK:
1883 case ST_END_ASSOCIATE:
1884 case_executablecase ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: case ST_CLOSE
: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: case
ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: case
ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: case
ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: case ST_POINTER_ASSIGNMENT
: case ST_EXIT: case ST_CYCLE: case ST_ASSIGNMENT: case ST_ARITHMETIC_IF
: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT: case
ST_FLUSH: case ST_OMP_FLUSH: case ST_OMP_BARRIER: case ST_OMP_TASKWAIT
: case ST_OMP_TASKYIELD: case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT
: case ST_OMP_DEPOBJ: case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA
: case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case
ST_OMP_ERROR: case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL
: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case
ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: case ST_END_TEAM
: case ST_SYNC_TEAM: case ST_EVENT_POST: case ST_EVENT_WAIT: case
ST_FAIL_IMAGE: case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE
: case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA:
1885 case_exec_markerscase ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: case ST_BLOCK
: case ST_ASSOCIATE: case ST_WHERE_BLOCK: case ST_SELECT_CASE
: case ST_SELECT_TYPE: case ST_SELECT_RANK: case ST_OMP_PARALLEL
: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASKED_TASKLOOP
: case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER
: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED
: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP
: case ST_OMP_MASKED_TASKLOOP_SIMD: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP
: case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE
: case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC
: case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: case
ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: case ST_OMP_DO_SIMD
: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA
: case ST_OMP_TARGET_TEAMS: case ST_OMP_TARGET_TEAMS_DISTRIBUTE
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS
: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_SIMD
: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
: case ST_OMP_DISTRIBUTE: case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL
: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD
: case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD
: case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP
: case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP
: case ST_OMP_ASSUME: case ST_CRITICAL: case ST_OACC_PARALLEL_LOOP
: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: case ST_OACC_DATA
: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: case ST_OACC_ATOMIC:
1886 if (st == ST_ENDDO || st == ST_CONTINUE)
1887 type = ST_LABEL_DO_TARGET;
1888 else
1889 type = ST_LABEL_TARGET;
1890 break;
1891
1892 case ST_FORMAT:
1893 type = ST_LABEL_FORMAT;
1894 break;
1895
1896 /* Statement labels are not restricted from appearing on a
1897 particular line. However, there are plenty of situations
1898 where the resulting label can't be referenced. */
1899
1900 default:
1901 type = ST_LABEL_BAD_TARGET;
1902 break;
1903 }
1904
1905 gfc_define_st_label (gfc_statement_label, type, &label_locus);
1906
1907 new_st.here = gfc_statement_label;
1908}
1909
1910
1911/* Figures out what the enclosing program unit is. This will be a
1912 function, subroutine, program, block data or module. */
1913
1914gfc_state_data *
1915gfc_enclosing_unit (gfc_compile_state * result)
1916{
1917 gfc_state_data *p;
1918
1919 for (p = gfc_state_stack; p; p = p->previous)
1920 if (p->state == COMP_FUNCTION || p->state == COMP_SUBROUTINE
1921 || p->state == COMP_MODULE || p->state == COMP_SUBMODULE
1922 || p->state == COMP_BLOCK_DATA || p->state == COMP_PROGRAM)
1923 {
1924
1925 if (result != NULL__null)
1926 *result = p->state;
1927 return p;
1928 }
1929
1930 if (result != NULL__null)
1931 *result = COMP_PROGRAM;
1932 return NULL__null;
1933}
1934
1935
1936/* Translate a statement enum to a string. If strip_sentinel is true,
1937 the !$OMP/!$ACC sentinel is excluded. */
1938
1939const char *
1940gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
1941{
1942 const char *p;
1943
1944 switch (st)
1945 {
1946 case ST_ARITHMETIC_IF:
1947 p = _("arithmetic IF")gettext ("arithmetic IF");
1948 break;
1949 case ST_ALLOCATE:
1950 p = "ALLOCATE";
1951 break;
1952 case ST_ASSOCIATE:
1953 p = "ASSOCIATE";
1954 break;
1955 case ST_ATTR_DECL:
1956 p = _("attribute declaration")gettext ("attribute declaration");
1957 break;
1958 case ST_BACKSPACE:
1959 p = "BACKSPACE";
1960 break;
1961 case ST_BLOCK:
1962 p = "BLOCK";
1963 break;
1964 case ST_BLOCK_DATA:
1965 p = "BLOCK DATA";
1966 break;
1967 case ST_CALL:
1968 p = "CALL";
1969 break;
1970 case ST_CASE:
1971 p = "CASE";
1972 break;
1973 case ST_CLOSE:
1974 p = "CLOSE";
1975 break;
1976 case ST_COMMON:
1977 p = "COMMON";
1978 break;
1979 case ST_CONTINUE:
1980 p = "CONTINUE";
1981 break;
1982 case ST_CONTAINS:
1983 p = "CONTAINS";
1984 break;
1985 case ST_CRITICAL:
1986 p = "CRITICAL";
1987 break;
1988 case ST_CYCLE:
1989 p = "CYCLE";
1990 break;
1991 case ST_DATA_DECL:
1992 p = _("data declaration")gettext ("data declaration");
1993 break;
1994 case ST_DATA:
1995 p = "DATA";
1996 break;
1997 case ST_DEALLOCATE:
1998 p = "DEALLOCATE";
1999 break;
2000 case ST_MAP:
2001 p = "MAP";
2002 break;
2003 case ST_UNION:
2004 p = "UNION";
2005 break;
2006 case ST_STRUCTURE_DECL:
2007 p = "STRUCTURE";
2008 break;
2009 case ST_DERIVED_DECL:
2010 p = _("derived type declaration")gettext ("derived type declaration");
2011 break;
2012 case ST_DO:
2013 p = "DO";
2014 break;
2015 case ST_ELSE:
2016 p = "ELSE";
2017 break;
2018 case ST_ELSEIF:
2019 p = "ELSE IF";
2020 break;
2021 case ST_ELSEWHERE:
2022 p = "ELSEWHERE";
2023 break;
2024 case ST_EVENT_POST:
2025 p = "EVENT POST";
2026 break;
2027 case ST_EVENT_WAIT:
2028 p = "EVENT WAIT";
2029 break;
2030 case ST_FAIL_IMAGE:
2031 p = "FAIL IMAGE";
2032 break;
2033 case ST_CHANGE_TEAM:
2034 p = "CHANGE TEAM";
2035 break;
2036 case ST_END_TEAM:
2037 p = "END TEAM";
2038 break;
2039 case ST_FORM_TEAM:
2040 p = "FORM TEAM";
2041 break;
2042 case ST_SYNC_TEAM:
2043 p = "SYNC TEAM";
2044 break;
2045 case ST_END_ASSOCIATE:
2046 p = "END ASSOCIATE";
2047 break;
2048 case ST_END_BLOCK:
2049 p = "END BLOCK";
2050 break;
2051 case ST_END_BLOCK_DATA:
2052 p = "END BLOCK DATA";
2053 break;
2054 case ST_END_CRITICAL:
2055 p = "END CRITICAL";
2056 break;
2057 case ST_ENDDO:
2058 p = "END DO";
2059 break;
2060 case ST_END_FILE:
2061 p = "END FILE";
2062 break;
2063 case ST_END_FORALL:
2064 p = "END FORALL";
2065 break;
2066 case ST_END_FUNCTION:
2067 p = "END FUNCTION";
2068 break;
2069 case ST_ENDIF:
2070 p = "END IF";
2071 break;
2072 case ST_END_INTERFACE:
2073 p = "END INTERFACE";
2074 break;
2075 case ST_END_MODULE:
2076 p = "END MODULE";
2077 break;
2078 case ST_END_SUBMODULE:
2079 p = "END SUBMODULE";
2080 break;
2081 case ST_END_PROGRAM:
2082 p = "END PROGRAM";
2083 break;
2084 case ST_END_SELECT:
2085 p = "END SELECT";
2086 break;
2087 case ST_END_SUBROUTINE:
2088 p = "END SUBROUTINE";
2089 break;
2090 case ST_END_WHERE:
2091 p = "END WHERE";
2092 break;
2093 case ST_END_STRUCTURE:
2094 p = "END STRUCTURE";
2095 break;
2096 case ST_END_UNION:
2097 p = "END UNION";
2098 break;
2099 case ST_END_MAP:
2100 p = "END MAP";
2101 break;
2102 case ST_END_TYPE:
2103 p = "END TYPE";
2104 break;
2105 case ST_ENTRY:
2106 p = "ENTRY";
2107 break;
2108 case ST_EQUIVALENCE:
2109 p = "EQUIVALENCE";
2110 break;
2111 case ST_ERROR_STOP:
2112 p = "ERROR STOP";
2113 break;
2114 case ST_EXIT:
2115 p = "EXIT";
2116 break;
2117 case ST_FLUSH:
2118 p = "FLUSH";
2119 break;
2120 case ST_FORALL_BLOCK: /* Fall through */
2121 case ST_FORALL:
2122 p = "FORALL";
2123 break;
2124 case ST_FORMAT:
2125 p = "FORMAT";
2126 break;
2127 case ST_FUNCTION:
2128 p = "FUNCTION";
2129 break;
2130 case ST_GENERIC:
2131 p = "GENERIC";
2132 break;
2133 case ST_GOTO:
2134 p = "GOTO";
2135 break;
2136 case ST_IF_BLOCK:
2137 p = _("block IF")gettext ("block IF");
2138 break;
2139 case ST_IMPLICIT:
2140 p = "IMPLICIT";
2141 break;
2142 case ST_IMPLICIT_NONE:
2143 p = "IMPLICIT NONE";
2144 break;
2145 case ST_IMPLIED_ENDDO:
2146 p = _("implied END DO")gettext ("implied END DO");
2147 break;
2148 case ST_IMPORT:
2149 p = "IMPORT";
2150 break;
2151 case ST_INQUIRE:
2152 p = "INQUIRE";
2153 break;
2154 case ST_INTERFACE:
2155 p = "INTERFACE";
2156 break;
2157 case ST_LOCK:
2158 p = "LOCK";
2159 break;
2160 case ST_PARAMETER:
2161 p = "PARAMETER";
2162 break;
2163 case ST_PRIVATE:
2164 p = "PRIVATE";
2165 break;
2166 case ST_PUBLIC:
2167 p = "PUBLIC";
2168 break;
2169 case ST_MODULE:
2170 p = "MODULE";
2171 break;
2172 case ST_SUBMODULE:
2173 p = "SUBMODULE";
2174 break;
2175 case ST_PAUSE:
2176 p = "PAUSE";
2177 break;
2178 case ST_MODULE_PROC:
2179 p = "MODULE PROCEDURE";
2180 break;
2181 case ST_NAMELIST:
2182 p = "NAMELIST";
2183 break;
2184 case ST_NULLIFY:
2185 p = "NULLIFY";
2186 break;
2187 case ST_OPEN:
2188 p = "OPEN";
2189 break;
2190 case ST_PROGRAM:
2191 p = "PROGRAM";
2192 break;
2193 case ST_PROCEDURE:
2194 p = "PROCEDURE";
2195 break;
2196 case ST_READ:
2197 p = "READ";
2198 break;
2199 case ST_RETURN:
2200 p = "RETURN";
2201 break;
2202 case ST_REWIND:
2203 p = "REWIND";
2204 break;
2205 case ST_STOP:
2206 p = "STOP";
2207 break;
2208 case ST_SYNC_ALL:
2209 p = "SYNC ALL";
2210 break;
2211 case ST_SYNC_IMAGES:
2212 p = "SYNC IMAGES";
2213 break;
2214 case ST_SYNC_MEMORY:
2215 p = "SYNC MEMORY";
2216 break;
2217 case ST_SUBROUTINE:
2218 p = "SUBROUTINE";
2219 break;
2220 case ST_TYPE:
2221 p = "TYPE";
2222 break;
2223 case ST_UNLOCK:
2224 p = "UNLOCK";
2225 break;
2226 case ST_USE:
2227 p = "USE";
2228 break;
2229 case ST_WHERE_BLOCK: /* Fall through */
2230 case ST_WHERE:
2231 p = "WHERE";
2232 break;
2233 case ST_WAIT:
2234 p = "WAIT";
2235 break;
2236 case ST_WRITE:
2237 p = "WRITE";
2238 break;
2239 case ST_ASSIGNMENT:
2240 p = _("assignment")gettext ("assignment");
2241 break;
2242 case ST_POINTER_ASSIGNMENT:
2243 p = _("pointer assignment")gettext ("pointer assignment");
2244 break;
2245 case ST_SELECT_CASE:
2246 p = "SELECT CASE";
2247 break;
2248 case ST_SELECT_TYPE:
2249 p = "SELECT TYPE";
2250 break;
2251 case ST_SELECT_RANK:
2252 p = "SELECT RANK";
2253 break;
2254 case ST_TYPE_IS:
2255 p = "TYPE IS";
2256 break;
2257 case ST_CLASS_IS:
2258 p = "CLASS IS";
2259 break;
2260 case ST_RANK:
2261 p = "RANK";
2262 break;
2263 case ST_SEQUENCE:
2264 p = "SEQUENCE";
2265 break;
2266 case ST_SIMPLE_IF:
2267 p = _("simple IF")gettext ("simple IF");
2268 break;
2269 case ST_STATEMENT_FUNCTION:
2270 p = "STATEMENT FUNCTION";
2271 break;
2272 case ST_LABEL_ASSIGNMENT:
2273 p = "LABEL ASSIGNMENT";
2274 break;
2275 case ST_ENUM:
2276 p = "ENUM DEFINITION";
2277 break;
2278 case ST_ENUMERATOR:
2279 p = "ENUMERATOR DEFINITION";
2280 break;
2281 case ST_END_ENUM:
2282 p = "END ENUM";
2283 break;
2284 case ST_OACC_PARALLEL_LOOP:
2285 p = "!$ACC PARALLEL LOOP";
2286 break;
2287 case ST_OACC_END_PARALLEL_LOOP:
2288 p = "!$ACC END PARALLEL LOOP";
2289 break;
2290 case ST_OACC_PARALLEL:
2291 p = "!$ACC PARALLEL";
2292 break;
2293 case ST_OACC_END_PARALLEL:
2294 p = "!$ACC END PARALLEL";
2295 break;
2296 case ST_OACC_KERNELS:
2297 p = "!$ACC KERNELS";
2298 break;
2299 case ST_OACC_END_KERNELS:
2300 p = "!$ACC END KERNELS";
2301 break;
2302 case ST_OACC_KERNELS_LOOP:
2303 p = "!$ACC KERNELS LOOP";
2304 break;
2305 case ST_OACC_END_KERNELS_LOOP:
2306 p = "!$ACC END KERNELS LOOP";
2307 break;
2308 case ST_OACC_SERIAL_LOOP:
2309 p = "!$ACC SERIAL LOOP";
2310 break;
2311 case ST_OACC_END_SERIAL_LOOP:
2312 p = "!$ACC END SERIAL LOOP";
2313 break;
2314 case ST_OACC_SERIAL:
2315 p = "!$ACC SERIAL";
2316 break;
2317 case ST_OACC_END_SERIAL:
2318 p = "!$ACC END SERIAL";
2319 break;
2320 case ST_OACC_DATA:
2321 p = "!$ACC DATA";
2322 break;
2323 case ST_OACC_END_DATA:
2324 p = "!$ACC END DATA";
2325 break;
2326 case ST_OACC_HOST_DATA:
2327 p = "!$ACC HOST_DATA";
2328 break;
2329 case ST_OACC_END_HOST_DATA:
2330 p = "!$ACC END HOST_DATA";
2331 break;
2332 case ST_OACC_LOOP:
2333 p = "!$ACC LOOP";
2334 break;
2335 case ST_OACC_END_LOOP:
2336 p = "!$ACC END LOOP";
2337 break;
2338 case ST_OACC_DECLARE:
2339 p = "!$ACC DECLARE";
2340 break;
2341 case ST_OACC_UPDATE:
2342 p = "!$ACC UPDATE";
2343 break;
2344 case ST_OACC_WAIT:
2345 p = "!$ACC WAIT";
2346 break;
2347 case ST_OACC_CACHE:
2348 p = "!$ACC CACHE";
2349 break;
2350 case ST_OACC_ENTER_DATA:
2351 p = "!$ACC ENTER DATA";
2352 break;
2353 case ST_OACC_EXIT_DATA:
2354 p = "!$ACC EXIT DATA";
2355 break;
2356 case ST_OACC_ROUTINE:
2357 p = "!$ACC ROUTINE";
2358 break;
2359 case ST_OACC_ATOMIC:
2360 p = "!$ACC ATOMIC";
2361 break;
2362 case ST_OACC_END_ATOMIC:
2363 p = "!$ACC END ATOMIC";
2364 break;
2365 case ST_OMP_ASSUME:
2366 p = "!$OMP ASSUME";
2367 break;
2368 case ST_OMP_ASSUMES:
2369 p = "!$OMP ASSUMES";
2370 break;
2371 case ST_OMP_ATOMIC:
2372 p = "!$OMP ATOMIC";
2373 break;
2374 case ST_OMP_BARRIER:
2375 p = "!$OMP BARRIER";
2376 break;
2377 case ST_OMP_CANCEL:
2378 p = "!$OMP CANCEL";
2379 break;
2380 case ST_OMP_CANCELLATION_POINT:
2381 p = "!$OMP CANCELLATION POINT";
2382 break;
2383 case ST_OMP_CRITICAL:
2384 p = "!$OMP CRITICAL";
2385 break;
2386 case ST_OMP_DECLARE_REDUCTION:
2387 p = "!$OMP DECLARE REDUCTION";
2388 break;
2389 case ST_OMP_DECLARE_SIMD:
2390 p = "!$OMP DECLARE SIMD";
2391 break;
2392 case ST_OMP_DECLARE_TARGET:
2393 p = "!$OMP DECLARE TARGET";
2394 break;
2395 case ST_OMP_DECLARE_VARIANT:
2396 p = "!$OMP DECLARE VARIANT";
2397 break;
2398 case ST_OMP_DEPOBJ:
2399 p = "!$OMP DEPOBJ";
2400 break;
2401 case ST_OMP_DISTRIBUTE:
2402 p = "!$OMP DISTRIBUTE";
2403 break;
2404 case ST_OMP_DISTRIBUTE_PARALLEL_DO:
2405 p = "!$OMP DISTRIBUTE PARALLEL DO";
2406 break;
2407 case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
2408 p = "!$OMP DISTRIBUTE PARALLEL DO SIMD";
2409 break;
2410 case ST_OMP_DISTRIBUTE_SIMD:
2411 p = "!$OMP DISTRIBUTE SIMD";
2412 break;
2413 case ST_OMP_DO:
2414 p = "!$OMP DO";
2415 break;
2416 case ST_OMP_DO_SIMD:
2417 p = "!$OMP DO SIMD";
2418 break;
2419 case ST_OMP_END_ASSUME:
2420 p = "!$OMP END ASSUME";
2421 break;
2422 case ST_OMP_END_ATOMIC:
2423 p = "!$OMP END ATOMIC";
2424 break;
2425 case ST_OMP_END_CRITICAL:
2426 p = "!$OMP END CRITICAL";
2427 break;
2428 case ST_OMP_END_DISTRIBUTE:
2429 p = "!$OMP END DISTRIBUTE";
2430 break;
2431 case ST_OMP_END_DISTRIBUTE_PARALLEL_DO:
2432 p = "!$OMP END DISTRIBUTE PARALLEL DO";
2433 break;
2434 case ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD:
2435 p = "!$OMP END DISTRIBUTE PARALLEL DO SIMD";
2436 break;
2437 case ST_OMP_END_DISTRIBUTE_SIMD:
2438 p = "!$OMP END DISTRIBUTE SIMD";
2439 break;
2440 case ST_OMP_END_DO:
2441 p = "!$OMP END DO";
2442 break;
2443 case ST_OMP_END_DO_SIMD:
2444 p = "!$OMP END DO SIMD";
2445 break;
2446 case ST_OMP_END_SCOPE:
2447 p = "!$OMP END SCOPE";
2448 break;
2449 case ST_OMP_END_SIMD:
2450 p = "!$OMP END SIMD";
2451 break;
2452 case ST_OMP_END_LOOP:
2453 p = "!$OMP END LOOP";
2454 break;
2455 case ST_OMP_END_MASKED:
2456 p = "!$OMP END MASKED";
2457 break;
2458 case ST_OMP_END_MASKED_TASKLOOP:
2459 p = "!$OMP END MASKED TASKLOOP";
2460 break;
2461 case ST_OMP_END_MASKED_TASKLOOP_SIMD:
2462 p = "!$OMP END MASKED TASKLOOP SIMD";
2463 break;
2464 case ST_OMP_END_MASTER:
2465 p = "!$OMP END MASTER";
2466 break;
2467 case ST_OMP_END_MASTER_TASKLOOP:
2468 p = "!$OMP END MASTER TASKLOOP";
2469 break;
2470 case ST_OMP_END_MASTER_TASKLOOP_SIMD:
2471 p = "!$OMP END MASTER TASKLOOP SIMD";
2472 break;
2473 case ST_OMP_END_ORDERED:
2474 p = "!$OMP END ORDERED";
2475 break;
2476 case ST_OMP_END_PARALLEL:
2477 p = "!$OMP END PARALLEL";
2478 break;
2479 case ST_OMP_END_PARALLEL_DO:
2480 p = "!$OMP END PARALLEL DO";
2481 break;
2482 case ST_OMP_END_PARALLEL_DO_SIMD:
2483 p = "!$OMP END PARALLEL DO SIMD";
2484 break;
2485 case ST_OMP_END_PARALLEL_LOOP:
2486 p = "!$OMP END PARALLEL LOOP";
2487 break;
2488 case ST_OMP_END_PARALLEL_MASKED:
2489 p = "!$OMP END PARALLEL MASKED";
2490 break;
2491 case ST_OMP_END_PARALLEL_MASKED_TASKLOOP:
2492 p = "!$OMP END PARALLEL MASKED TASKLOOP";
2493 break;
2494 case ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD:
2495 p = "!$OMP END PARALLEL MASKED TASKLOOP SIMD";
2496 break;
2497 case ST_OMP_END_PARALLEL_MASTER:
2498 p = "!$OMP END PARALLEL MASTER";
2499 break;
2500 case ST_OMP_END_PARALLEL_MASTER_TASKLOOP:
2501 p = "!$OMP END PARALLEL MASTER TASKLOOP";
2502 break;
2503 case ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD:
2504 p = "!$OMP END PARALLEL MASTER TASKLOOP SIMD";
2505 break;
2506 case ST_OMP_END_PARALLEL_SECTIONS:
2507 p = "!$OMP END PARALLEL SECTIONS";
2508 break;
2509 case ST_OMP_END_PARALLEL_WORKSHARE:
2510 p = "!$OMP END PARALLEL WORKSHARE";
2511 break;
2512 case ST_OMP_END_SECTIONS:
2513 p = "!$OMP END SECTIONS";
2514 break;
2515 case ST_OMP_END_SINGLE:
2516 p = "!$OMP END SINGLE";
2517 break;
2518 case ST_OMP_END_TASK:
2519 p = "!$OMP END TASK";
2520 break;
2521 case ST_OMP_END_TARGET:
2522 p = "!$OMP END TARGET";
2523 break;
2524 case ST_OMP_END_TARGET_DATA:
2525 p = "!$OMP END TARGET DATA";
2526 break;
2527 case ST_OMP_END_TARGET_PARALLEL:
2528 p = "!$OMP END TARGET PARALLEL";
2529 break;
2530 case ST_OMP_END_TARGET_PARALLEL_DO:
2531 p = "!$OMP END TARGET PARALLEL DO";
2532 break;
2533 case ST_OMP_END_TARGET_PARALLEL_DO_SIMD:
2534 p = "!$OMP END TARGET PARALLEL DO SIMD";
2535 break;
2536 case ST_OMP_END_TARGET_PARALLEL_LOOP:
2537 p = "!$OMP END TARGET PARALLEL LOOP";
2538 break;
2539 case ST_OMP_END_TARGET_SIMD:
2540 p = "!$OMP END TARGET SIMD";
2541 break;
2542 case ST_OMP_END_TARGET_TEAMS:
2543 p = "!$OMP END TARGET TEAMS";
2544 break;
2545 case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE:
2546 p = "!$OMP END TARGET TEAMS DISTRIBUTE";
2547 break;
2548 case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
2549 p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO";
2550 break;
2551 case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2552 p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD";
2553 break;
2554 case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD:
2555 p = "!$OMP END TARGET TEAMS DISTRIBUTE SIMD";
2556 break;
2557 case ST_OMP_END_TARGET_TEAMS_LOOP:
2558 p = "!$OMP END TARGET TEAMS LOOP";
2559 break;
2560 case ST_OMP_END_TASKGROUP:
2561 p = "!$OMP END TASKGROUP";
2562 break;
2563 case ST_OMP_END_TASKLOOP:
2564 p = "!$OMP END TASKLOOP";
2565 break;
2566 case ST_OMP_END_TASKLOOP_SIMD:
2567 p = "!$OMP END TASKLOOP SIMD";
2568 break;
2569 case ST_OMP_END_TEAMS:
2570 p = "!$OMP END TEAMS";
2571 break;
2572 case ST_OMP_END_TEAMS_DISTRIBUTE:
2573 p = "!$OMP END TEAMS DISTRIBUTE";
2574 break;
2575 case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO:
2576 p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO";
2577 break;
2578 case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2579 p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO SIMD";
2580 break;
2581 case ST_OMP_END_TEAMS_DISTRIBUTE_SIMD:
2582 p = "!$OMP END TEAMS DISTRIBUTE SIMD";
2583 break;
2584 case ST_OMP_END_TEAMS_LOOP:
2585 p = "!$OMP END TEAMS LOOP";
2586 break;
2587 case ST_OMP_END_WORKSHARE:
2588 p = "!$OMP END WORKSHARE";
2589 break;
2590 case ST_OMP_ERROR:
2591 p = "!$OMP ERROR";
2592 break;
2593 case ST_OMP_FLUSH:
2594 p = "!$OMP FLUSH";
2595 break;
2596 case ST_OMP_LOOP:
2597 p = "!$OMP LOOP";
2598 break;
2599 case ST_OMP_MASKED:
2600 p = "!$OMP MASKED";
2601 break;
2602 case ST_OMP_MASKED_TASKLOOP:
2603 p = "!$OMP MASKED TASKLOOP";
2604 break;
2605 case ST_OMP_MASKED_TASKLOOP_SIMD:
2606 p = "!$OMP MASKED TASKLOOP SIMD";
2607 break;
2608 case ST_OMP_MASTER:
2609 p = "!$OMP MASTER";
2610 break;
2611 case ST_OMP_MASTER_TASKLOOP:
2612 p = "!$OMP MASTER TASKLOOP";
2613 break;
2614 case ST_OMP_MASTER_TASKLOOP_SIMD:
2615 p = "!$OMP MASTER TASKLOOP SIMD";
2616 break;
2617 case ST_OMP_ORDERED:
2618 case ST_OMP_ORDERED_DEPEND:
2619 p = "!$OMP ORDERED";
2620 break;
2621 case ST_OMP_NOTHING:
2622 /* Note: gfc_match_omp_nothing returns ST_NONE. */
2623 p = "!$OMP NOTHING";
2624 break;
2625 case ST_OMP_PARALLEL:
2626 p = "!$OMP PARALLEL";
2627 break;
2628 case ST_OMP_PARALLEL_DO:
2629 p = "!$OMP PARALLEL DO";
2630 break;
2631 case ST_OMP_PARALLEL_LOOP:
2632 p = "!$OMP PARALLEL LOOP";
2633 break;
2634 case ST_OMP_PARALLEL_DO_SIMD:
2635 p = "!$OMP PARALLEL DO SIMD";
2636 break;
2637 case ST_OMP_PARALLEL_MASKED:
2638 p = "!$OMP PARALLEL MASKED";
2639 break;
2640 case ST_OMP_PARALLEL_MASKED_TASKLOOP:
2641 p = "!$OMP PARALLEL MASKED TASKLOOP";
2642 break;
2643 case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
2644 p = "!$OMP PARALLEL MASKED TASKLOOP SIMD";
2645 break;
2646 case ST_OMP_PARALLEL_MASTER:
2647 p = "!$OMP PARALLEL MASTER";
2648 break;
2649 case ST_OMP_PARALLEL_MASTER_TASKLOOP:
2650 p = "!$OMP PARALLEL MASTER TASKLOOP";
2651 break;
2652 case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
2653 p = "!$OMP PARALLEL MASTER TASKLOOP SIMD";
2654 break;
2655 case ST_OMP_PARALLEL_SECTIONS:
2656 p = "!$OMP PARALLEL SECTIONS";
2657 break;
2658 case ST_OMP_PARALLEL_WORKSHARE:
2659 p = "!$OMP PARALLEL WORKSHARE";
2660 break;
2661 case ST_OMP_REQUIRES:
2662 p = "!$OMP REQUIRES";
2663 break;
2664 case ST_OMP_SCAN:
2665 p = "!$OMP SCAN";
2666 break;
2667 case ST_OMP_SCOPE:
2668 p = "!$OMP SCOPE";
2669 break;
2670 case ST_OMP_SECTIONS:
2671 p = "!$OMP SECTIONS";
2672 break;
2673 case ST_OMP_SECTION:
2674 p = "!$OMP SECTION";
2675 break;
2676 case ST_OMP_SIMD:
2677 p = "!$OMP SIMD";
2678 break;
2679 case ST_OMP_SINGLE:
2680 p = "!$OMP SINGLE";
2681 break;
2682 case ST_OMP_TARGET:
2683 p = "!$OMP TARGET";
2684 break;
2685 case ST_OMP_TARGET_DATA:
2686 p = "!$OMP TARGET DATA";
2687 break;
2688 case ST_OMP_TARGET_ENTER_DATA:
2689 p = "!$OMP TARGET ENTER DATA";
2690 break;
2691 case ST_OMP_TARGET_EXIT_DATA:
2692 p = "!$OMP TARGET EXIT DATA";
2693 break;
2694 case ST_OMP_TARGET_PARALLEL:
2695 p = "!$OMP TARGET PARALLEL";
2696 break;
2697 case ST_OMP_TARGET_PARALLEL_DO:
2698 p = "!$OMP TARGET PARALLEL DO";
2699 break;
2700 case ST_OMP_TARGET_PARALLEL_DO_SIMD:
2701 p = "!$OMP TARGET PARALLEL DO SIMD";
2702 break;
2703 case ST_OMP_TARGET_PARALLEL_LOOP:
2704 p = "!$OMP TARGET PARALLEL LOOP";
2705 break;
2706 case ST_OMP_TARGET_SIMD:
2707 p = "!$OMP TARGET SIMD";
2708 break;
2709 case ST_OMP_TARGET_TEAMS:
2710 p = "!$OMP TARGET TEAMS";
2711 break;
2712 case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
2713 p = "!$OMP TARGET TEAMS DISTRIBUTE";
2714 break;
2715 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
2716 p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO";
2717 break;
2718 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2719 p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD";
2720 break;
2721 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
2722 p = "!$OMP TARGET TEAMS DISTRIBUTE SIMD";
2723 break;
2724 case ST_OMP_TARGET_TEAMS_LOOP:
2725 p = "!$OMP TARGET TEAMS LOOP";
2726 break;
2727 case ST_OMP_TARGET_UPDATE:
2728 p = "!$OMP TARGET UPDATE";
2729 break;
2730 case ST_OMP_TASK:
2731 p = "!$OMP TASK";
2732 break;
2733 case ST_OMP_TASKGROUP:
2734 p = "!$OMP TASKGROUP";
2735 break;
2736 case ST_OMP_TASKLOOP:
2737 p = "!$OMP TASKLOOP";
2738 break;
2739 case ST_OMP_TASKLOOP_SIMD:
2740 p = "!$OMP TASKLOOP SIMD";
2741 break;
2742 case ST_OMP_TASKWAIT:
2743 p = "!$OMP TASKWAIT";
2744 break;
2745 case ST_OMP_TASKYIELD:
2746 p = "!$OMP TASKYIELD";
2747 break;
2748 case ST_OMP_TEAMS:
2749 p = "!$OMP TEAMS";
2750 break;
2751 case ST_OMP_TEAMS_DISTRIBUTE:
2752 p = "!$OMP TEAMS DISTRIBUTE";
2753 break;
2754 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
2755 p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO";
2756 break;
2757 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
2758 p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO SIMD";
2759 break;
2760 case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
2761 p = "!$OMP TEAMS DISTRIBUTE SIMD";
2762 break;
2763 case ST_OMP_TEAMS_LOOP:
2764 p = "!$OMP TEAMS LOOP";
2765 break;
2766 case ST_OMP_THREADPRIVATE:
2767 p = "!$OMP THREADPRIVATE";
2768 break;
2769 case ST_OMP_WORKSHARE:
2770 p = "!$OMP WORKSHARE";
2771 break;
2772 default:
2773 gfc_internal_error ("gfc_ascii_statement(): Bad statement code");
2774 }
2775
2776 if (strip_sentinel && p[0] == '!')
2777 return p + strlen ("!$OMP ");
2778 return p;
2779}
2780
2781
2782/* Create a symbol for the main program and assign it to ns->proc_name. */
2783
2784static void
2785main_program_symbol (gfc_namespace *ns, const char *name)
2786{
2787 gfc_symbol *main_program;
2788 symbol_attribute attr;
2789
2790 gfc_get_symbol (name, ns, &main_program);
2791 gfc_clear_attr (&attr);
2792 attr.flavor = FL_PROGRAM;
2793 attr.proc = PROC_UNKNOWN;
2794 attr.subroutine = 1;
2795 attr.access = ACCESS_PUBLIC;
2796 attr.is_main_program = 1;
2797 main_program->attr = attr;
2798 main_program->declared_at = gfc_current_locus;
2799 ns->proc_name = main_program;
2800 gfc_commit_symbols ();
2801}
2802
2803
2804/* Do whatever is necessary to accept the last statement. */
2805
2806static void
2807accept_statement (gfc_statement st)
2808{
2809 switch (st)
2810 {
2811 case ST_IMPLICIT_NONE:
2812 case ST_IMPLICIT:
2813 break;
2814
2815 case ST_FUNCTION:
2816 case ST_SUBROUTINE:
2817 case ST_MODULE:
2818 case ST_SUBMODULE:
2819 gfc_current_ns->proc_name = gfc_new_block;
2820 break;
2821
2822 /* If the statement is the end of a block, lay down a special code
2823 that allows a branch to the end of the block from within the
2824 construct. IF and SELECT are treated differently from DO
2825 (where EXEC_NOP is added inside the loop) for two
2826 reasons:
2827 1. END DO has a meaning in the sense that after a GOTO to
2828 it, the loop counter must be increased.
2829 2. IF blocks and SELECT blocks can consist of multiple
2830 parallel blocks (IF ... ELSE IF ... ELSE ... END IF).
2831 Putting the label before the END IF would make the jump
2832 from, say, the ELSE IF block to the END IF illegal. */
2833
2834 case ST_ENDIF:
2835 case ST_END_SELECT:
2836 case ST_END_CRITICAL:
2837 if (gfc_statement_label != NULL__null)
2838 {
2839 new_st.op = EXEC_END_NESTED_BLOCK;
2840 add_statement ();
2841 }
2842 break;
2843
2844 /* In the case of BLOCK and ASSOCIATE blocks, there cannot be more than
2845 one parallel block. Thus, we add the special code to the nested block
2846 itself, instead of the parent one. */
2847 case ST_END_BLOCK:
2848 case ST_END_ASSOCIATE:
2849 if (gfc_statement_label != NULL__null)
2850 {
2851 new_st.op = EXEC_END_BLOCK;
2852 add_statement ();
2853 }
2854 break;
2855
2856 /* The end-of-program unit statements do not get the special
2857 marker and require a statement of some sort if they are a
2858 branch target. */
2859
2860 case ST_END_PROGRAM:
2861 case ST_END_FUNCTION:
2862 case ST_END_SUBROUTINE:
2863 if (gfc_statement_label != NULL__null)
2864 {
2865 new_st.op = EXEC_RETURN;
2866 add_statement ();
2867 }
2868 else
2869 {
2870 new_st.op = EXEC_END_PROCEDURE;
2871 add_statement ();
2872 }
2873
2874 break;
2875
2876 case ST_ENTRY:
2877 case_executablecase ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: case ST_CLOSE
: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: case
ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: case
ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: case
ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: case ST_POINTER_ASSIGNMENT
: case ST_EXIT: case ST_CYCLE: case ST_ASSIGNMENT: case ST_ARITHMETIC_IF
: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT: case
ST_FLUSH: case ST_OMP_FLUSH: case ST_OMP_BARRIER: case ST_OMP_TASKWAIT
: case ST_OMP_TASKYIELD: case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT
: case ST_OMP_DEPOBJ: case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA
: case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case
ST_OMP_ERROR: case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL
: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case
ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: case ST_END_TEAM
: case ST_SYNC_TEAM: case ST_EVENT_POST: case ST_EVENT_WAIT: case
ST_FAIL_IMAGE: case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE
: case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA:
2878 case_exec_markerscase ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: case ST_BLOCK
: case ST_ASSOCIATE: case ST_WHERE_BLOCK: case ST_SELECT_CASE
: case ST_SELECT_TYPE: case ST_SELECT_RANK: case ST_OMP_PARALLEL
: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASKED_TASKLOOP
: case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER
: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED
: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP
: case ST_OMP_MASKED_TASKLOOP_SIMD: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP
: case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE
: case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC
: case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: case
ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: case ST_OMP_DO_SIMD
: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA
: case ST_OMP_TARGET_TEAMS: case ST_OMP_TARGET_TEAMS_DISTRIBUTE
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS
: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_SIMD
: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
: case ST_OMP_DISTRIBUTE: case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL
: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD
: case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD
: case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP
: case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP
: case ST_OMP_ASSUME: case ST_CRITICAL: case ST_OACC_PARALLEL_LOOP
: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: case ST_OACC_DATA
: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: case ST_OACC_ATOMIC:
2879 add_statement ();
2880 break;
2881
2882 default:
2883 break;
2884 }
2885
2886 gfc_commit_symbols ();
2887 gfc_warning_check ();
2888 gfc_clear_new_st ();
2889}
2890
2891
2892/* Undo anything tentative that has been built for the current statement,
2893 except if a gfc_charlen structure has been added to current namespace's
2894 list of gfc_charlen structure. */
2895
2896static void
2897reject_statement (void)
2898{
2899 gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv);
2900 gfc_current_ns->equiv = gfc_current_ns->old_equiv;
2901
2902 gfc_reject_data (gfc_current_ns);
2903
2904 gfc_new_block = NULL__null;
2905 gfc_undo_symbols ();
2906 gfc_clear_warning ();
2907 undo_new_statement ();
2908}
2909
2910
2911/* Generic complaint about an out of order statement. We also do
2912 whatever is necessary to clean up. */
2913
2914static void
2915unexpected_statement (gfc_statement st)
2916{
2917 gfc_error ("Unexpected %s statement at %C", gfc_ascii_statement (st));
2918
2919 reject_statement ();
2920}
2921
2922
2923/* Given the next statement seen by the matcher, make sure that it is
2924 in proper order with the last. This subroutine is initialized by
2925 calling it with an argument of ST_NONE. If there is a problem, we
2926 issue an error and return false. Otherwise we return true.
2927
2928 Individual parsers need to verify that the statements seen are
2929 valid before calling here, i.e., ENTRY statements are not allowed in
2930 INTERFACE blocks. The following diagram is taken from the standard:
2931
2932 +---------------------------------------+
2933 | program subroutine function module |
2934 +---------------------------------------+
2935 | use |
2936 +---------------------------------------+
2937 | import |
2938 +---------------------------------------+
2939 | | implicit none |
2940 | +-----------+------------------+
2941 | | parameter | implicit |
2942 | +-----------+------------------+
2943 | format | | derived type |
2944 | entry | parameter | interface |
2945 | | data | specification |
2946 | | | statement func |
2947 | +-----------+------------------+
2948 | | data | executable |
2949 +--------+-----------+------------------+
2950 | contains |
2951 +---------------------------------------+
2952 | internal module/subprogram |
2953 +---------------------------------------+
2954 | end |
2955 +---------------------------------------+
2956
2957*/
2958
2959enum state_order
2960{
2961 ORDER_START,
2962 ORDER_USE,
2963 ORDER_IMPORT,
2964 ORDER_IMPLICIT_NONE,
2965 ORDER_IMPLICIT,
2966 ORDER_SPEC,
2967 ORDER_EXEC
2968};
2969
2970typedef struct
2971{
2972 enum state_order state;
2973 gfc_statement last_statement;
2974 locus where;
2975}
2976st_state;
2977
2978static bool
2979verify_st_order (st_state *p, gfc_statement st, bool silent)
2980{
2981
2982 switch (st)
2983 {
2984 case ST_NONE:
2985 p->state = ORDER_START;
2986 break;
2987
2988 case ST_USE:
2989 if (p->state > ORDER_USE)
2990 goto order;
2991 p->state = ORDER_USE;
2992 break;
2993
2994 case ST_IMPORT:
2995 if (p->state > ORDER_IMPORT)
2996 goto order;
2997 p->state = ORDER_IMPORT;
2998 break;
2999
3000 case ST_IMPLICIT_NONE:
3001 if (p->state > ORDER_IMPLICIT)
3002 goto order;
3003
3004 /* The '>' sign cannot be a '>=', because a FORMAT or ENTRY
3005 statement disqualifies a USE but not an IMPLICIT NONE.
3006 Duplicate IMPLICIT NONEs are caught when the implicit types
3007 are set. */
3008
3009 p->state = ORDER_IMPLICIT_NONE;
3010 break;
3011
3012 case ST_IMPLICIT:
3013 if (p->state > ORDER_IMPLICIT)
3014 goto order;
3015 p->state = ORDER_IMPLICIT;
3016 break;
3017
3018 case ST_FORMAT:
3019 case ST_ENTRY:
3020 if (p->state < ORDER_IMPLICIT_NONE)
3021 p->state = ORDER_IMPLICIT_NONE;
3022 break;
3023
3024 case ST_PARAMETER:
3025 if (p->state >= ORDER_EXEC)
3026 goto order;
3027 if (p->state < ORDER_IMPLICIT)
3028 p->state = ORDER_IMPLICIT;
3029 break;
3030
3031 case ST_DATA:
3032 if (p->state < ORDER_SPEC)
3033 p->state = ORDER_SPEC;
3034 break;
3035
3036 case ST_PUBLIC:
3037 case ST_PRIVATE:
3038 case ST_STRUCTURE_DECL:
3039 case ST_DERIVED_DECL:
3040 case_declcase ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: case ST_EQUIVALENCE
: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: case ST_TYPE:
case ST_INTERFACE: case ST_PROCEDURE:
3041 if (p->state >= ORDER_EXEC)
3042 goto order;
3043 if (p->state < ORDER_SPEC)
3044 p->state = ORDER_SPEC;
3045 break;
3046
3047 case_omp_declcase ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_TARGET
: case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT:
case ST_OMP_ASSUMES: case ST_OMP_REQUIRES: case ST_OACC_ROUTINE
: case ST_OACC_DECLARE:
3048 /* The OpenMP/OpenACC directives have to be somewhere in the specification
3049 part, but there are no further requirements on their ordering.
3050 Thus don't adjust p->state, just ignore them. */
3051 if (p->state >= ORDER_EXEC)
3052 goto order;
3053 break;
3054
3055 case_executablecase ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: case ST_CLOSE
: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: case
ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: case
ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: case
ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: case ST_POINTER_ASSIGNMENT
: case ST_EXIT: case ST_CYCLE: case ST_ASSIGNMENT: case ST_ARITHMETIC_IF
: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT: case
ST_FLUSH: case ST_OMP_FLUSH: case ST_OMP_BARRIER: case ST_OMP_TASKWAIT
: case ST_OMP_TASKYIELD: case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT
: case ST_OMP_DEPOBJ: case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA
: case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case
ST_OMP_ERROR: case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL
: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case
ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: case ST_END_TEAM
: case ST_SYNC_TEAM: case ST_EVENT_POST: case ST_EVENT_WAIT: case
ST_FAIL_IMAGE: case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE
: case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA:
3056 case_exec_markerscase ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: case ST_BLOCK
: case ST_ASSOCIATE: case ST_WHERE_BLOCK: case ST_SELECT_CASE
: case ST_SELECT_TYPE: case ST_SELECT_RANK: case ST_OMP_PARALLEL
: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASKED_TASKLOOP
: case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER
: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED
: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP
: case ST_OMP_MASKED_TASKLOOP_SIMD: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP
: case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE
: case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC
: case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: case
ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: case ST_OMP_DO_SIMD
: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA
: case ST_OMP_TARGET_TEAMS: case ST_OMP_TARGET_TEAMS_DISTRIBUTE
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS
: case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_SIMD
: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
: case ST_OMP_DISTRIBUTE: case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO
: case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL
: case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD
: case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD
: case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP
: case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP
: case ST_OMP_ASSUME: case ST_CRITICAL: case ST_OACC_PARALLEL_LOOP
: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: case ST_OACC_DATA
: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: case ST_OACC_ATOMIC:
3057 if (p->state < ORDER_EXEC)
3058 p->state = ORDER_EXEC;
3059 break;
3060
3061 default:
3062 return false;
3063 }
3064
3065 /* All is well, record the statement in case we need it next time. */
3066 p->where = gfc_current_locus;
3067 p->last_statement = st;
3068 return true;
3069
3070order:
3071 if (!silent)
3072 gfc_error ("%s statement at %C cannot follow %s statement at %L",
3073 gfc_ascii_statement (st),
3074 gfc_ascii_statement (p->last_statement), &p->where);
3075
3076 return false;
3077}
3078
3079
3080/* Handle an unexpected end of file. This is a show-stopper... */
3081
3082static void unexpected_eof (void) ATTRIBUTE_NORETURN__attribute__ ((__noreturn__));
3083
3084static void
3085unexpected_eof (void)
3086{
3087 gfc_state_data *p;
3088
3089 gfc_error ("Unexpected end of file in %qs", gfc_source_file);
3090
3091 /* Memory cleanup. Move to "second to last". */
3092 for (p = gfc_state_stack; p && p->previous && p->previous->previous;
3093 p = p->previous);
3094
3095 gfc_current_ns->code = (p && p->previous) ? p->head : NULL__null;
3096 gfc_done_2 ();
3097
3098 longjmp (eof_buf, 1);
3099
3100 /* Avoids build error on systems where longjmp is not declared noreturn. */
3101 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3101, __FUNCTION__));
3102}
3103
3104
3105/* Parse the CONTAINS section of a derived type definition. */
3106
3107gfc_access gfc_typebound_default_access;
3108
3109static bool
3110parse_derived_contains (void)
3111{
3112 gfc_state_data s;
3113 bool seen_private = false;
3114 bool seen_comps = false;
3115 bool error_flag = false;
3116 bool to_finish;
3117
3118 gcc_assert (gfc_current_state () == COMP_DERIVED)((void)(!((gfc_state_stack->state) == COMP_DERIVED) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3118, __FUNCTION__), 0 : 0));
3119 gcc_assert (gfc_current_block ())((void)(!((gfc_state_stack->sym)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3119, __FUNCTION__), 0 : 0));
3120
3121 /* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS
3122 section. */
3123 if (gfc_current_block ()(gfc_state_stack->sym)->attr.sequence)
3124 gfc_error ("Derived-type %qs with SEQUENCE must not have a CONTAINS"
3125 " section at %C", gfc_current_block ()(gfc_state_stack->sym)->name);
3126 if (gfc_current_block ()(gfc_state_stack->sym)->attr.is_bind_c)
3127 gfc_error ("Derived-type %qs with BIND(C) must not have a CONTAINS"
3128 " section at %C", gfc_current_block ()(gfc_state_stack->sym)->name);
3129
3130 accept_statement (ST_CONTAINS);
3131 push_state (&s, COMP_DERIVED_CONTAINS, NULL__null);
3132
3133 gfc_typebound_default_access = ACCESS_PUBLIC;
3134
3135 to_finish = false;
3136 while (!to_finish)
3137 {
3138 gfc_statement st;
3139 st = next_statement ();
3140 switch (st)
3141 {
3142 case ST_NONE:
3143 unexpected_eof ();
3144 break;
3145
3146 case ST_DATA_DECL:
3147 gfc_error ("Components in TYPE at %C must precede CONTAINS");
3148 goto error;
3149
3150 case ST_PROCEDURE:
3151 if (!gfc_notify_std (GFC_STD_F2003(1<<4), "Type-bound procedure at %C"))
3152 goto error;
3153
3154 accept_statement (ST_PROCEDURE);
3155 seen_comps = true;
3156 break;
3157
3158 case ST_GENERIC:
3159 if (!gfc_notify_std (GFC_STD_F2003(1<<4), "GENERIC binding at %C"))
3160 goto error;
3161
3162 accept_statement (ST_GENERIC);
3163 seen_comps = true;
3164 break;
3165
3166 case ST_FINAL:
3167 if (!gfc_notify_std (GFC_STD_F2003(1<<4), "FINAL procedure declaration"
3168 " at %C"))
3169 goto error;
3170
3171 accept_statement (ST_FINAL);
3172 seen_comps = true;
3173 break;
3174
3175 case ST_END_TYPE:
3176 to_finish = true;
3177
3178 if (!seen_comps
3179 && (!gfc_notify_std(GFC_STD_F2008(1<<7), "Derived type definition "
3180 "at %C with empty CONTAINS section")))
3181 goto error;
3182
3183 /* ST_END_TYPE is accepted by parse_derived after return. */
3184 break;
3185
3186 case ST_PRIVATE:
3187 if (!gfc_find_state (COMP_MODULE))
3188 {
3189 gfc_error ("PRIVATE statement in TYPE at %C must be inside "
3190 "a MODULE");
3191 goto error;
3192 }
3193
3194 if (seen_comps)
3195 {
3196 gfc_error ("PRIVATE statement at %C must precede procedure"
3197 " bindings");
3198 goto error;
3199 }
3200
3201 if (seen_private)
3202 {
3203 gfc_error ("Duplicate PRIVATE statement at %C");
3204 goto error;
3205 }
3206
3207 accept_statement (ST_PRIVATE);
3208 gfc_typebound_default_access = ACCESS_PRIVATE;
3209 seen_private = true;
3210 break;
3211
3212 case ST_SEQUENCE:
3213 gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
3214 goto error;
3215
3216 case ST_CONTAINS:
3217 gfc_error ("Already inside a CONTAINS block at %C");
3218 goto error;
3219
3220 default:
3221 unexpected_statement (st);
3222 break;
3223 }
3224
3225 continue;
3226
3227error:
3228 error_flag = true;
3229 reject_statement ();
3230 }
3231
3232 pop_state ();
3233 gcc_assert (gfc_current_state () == COMP_DERIVED)((void)(!((gfc_state_stack->state) == COMP_DERIVED) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3233, __FUNCTION__), 0 : 0));
3234
3235 return error_flag;
3236}
3237
3238
3239/* Set attributes for the parent symbol based on the attributes of a component
3240 and raise errors if conflicting attributes are found for the component. */
3241
3242static void
3243check_component (gfc_symbol *sym, gfc_component *c, gfc_component **lockp,
3244 gfc_component **eventp)
3245{
3246 bool coarray, lock_type, event_type, allocatable, pointer;
3247 coarray = lock_type = event_type = allocatable = pointer = false;
3248 gfc_component *lock_comp = NULL__null, *event_comp = NULL__null;
3249
3250 if (lockp) lock_comp = *lockp;
3251 if (eventp) event_comp = *eventp;
3252
3253 /* Look for allocatable components. */
3254 if (c->attr.allocatable
3255 || (c->ts.type == BT_CLASS && c->attr.class_ok
3256 && CLASS_DATA (c)c->ts.u.derived->components->attr.allocatable)
3257 || (c->ts.type == BT_DERIVED && !c->attr.pointer
3258 && c->ts.u.derived->attr.alloc_comp))
3259 {
3260 allocatable = true;
3261 sym->attr.alloc_comp = 1;
3262 }
3263
3264 /* Look for pointer components. */
3265 if (c->attr.pointer
3266 || (c->ts.type == BT_CLASS && c->attr.class_ok
3267 && CLASS_DATA (c)c->ts.u.derived->components->attr.class_pointer)
3268 || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
3269 {
3270 pointer = true;
3271 sym->attr.pointer_comp = 1;
3272 }
3273
3274 /* Look for procedure pointer components. */
3275 if (c->attr.proc_pointer
3276 || (c->ts.type == BT_DERIVED
3277 && c->ts.u.derived->attr.proc_pointer_comp))
3278 sym->attr.proc_pointer_comp = 1;
3279
3280 /* Looking for coarray components. */
3281 if (c->attr.codimension
3282 || (c->ts.type == BT_CLASS && c->attr.class_ok
3283 && CLASS_DATA (c)c->ts.u.derived->components->attr.codimension))
3284 {
3285 coarray = true;
3286 sym->attr.coarray_comp = 1;
3287 }
3288
3289 if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
3290 && !c->attr.pointer)
3291 {
3292 coarray = true;
3293 sym->attr.coarray_comp = 1;
3294 }
3295
3296 /* Looking for lock_type components. */
3297 if ((c->ts.type == BT_DERIVED
3298 && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
3299 && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
3300 || (c->ts.type == BT_CLASS && c->attr.class_ok
3301 && CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived->from_intmod
3302 == INTMOD_ISO_FORTRAN_ENV
3303 && CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived->intmod_sym_id
3304 == ISOFORTRAN_LOCK_TYPE)
3305 || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
3306 && !allocatable && !pointer))
3307 {
3308 lock_type = 1;
3309 lock_comp = c;
3310 sym->attr.lock_comp = 1;
3311 }
3312
3313 /* Looking for event_type components. */
3314 if ((c->ts.type == BT_DERIVED
3315 && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
3316 && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
3317 || (c->ts.type == BT_CLASS && c->attr.class_ok
3318 && CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived->from_intmod
3319 == INTMOD_ISO_FORTRAN_ENV
3320 && CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived->intmod_sym_id
3321 == ISOFORTRAN_EVENT_TYPE)
3322 || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.event_comp
3323 && !allocatable && !pointer))
3324 {
3325 event_type = 1;
3326 event_comp = c;
3327 sym->attr.event_comp = 1;
3328 }
3329
3330 /* Check for F2008, C1302 - and recall that pointers may not be coarrays
3331 (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
3332 unless there are nondirect [allocatable or pointer] components
3333 involved (cf. 1.3.33.1 and 1.3.33.3). */
3334
3335 if (pointer && !coarray && lock_type)
3336 gfc_error ("Component %s at %L of type LOCK_TYPE must have a "
3337 "codimension or be a subcomponent of a coarray, "
3338 "which is not possible as the component has the "
3339 "pointer attribute", c->name, &c->loc);
3340 else if (pointer && !coarray && c->ts.type == BT_DERIVED
3341 && c->ts.u.derived->attr.lock_comp)
3342 gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
3343 "of type LOCK_TYPE, which must have a codimension or be a "
3344 "subcomponent of a coarray", c->name, &c->loc);
3345
3346 if (lock_type && allocatable && !coarray)
3347 gfc_error ("Allocatable component %s at %L of type LOCK_TYPE must have "
3348 "a codimension", c->name, &c->loc);
3349 else if (lock_type && allocatable && c->ts.type == BT_DERIVED
3350 && c->ts.u.derived->attr.lock_comp)
3351 gfc_error ("Allocatable component %s at %L must have a codimension as "
3352 "it has a noncoarray subcomponent of type LOCK_TYPE",
3353 c->name, &c->loc);
3354
3355 if (sym->attr.coarray_comp && !coarray && lock_type)
3356 gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
3357 "subcomponent of type LOCK_TYPE must have a codimension or "
3358 "be a subcomponent of a coarray. (Variables of type %s may "
3359 "not have a codimension as already a coarray "
3360 "subcomponent exists)", c->name, &c->loc, sym->name);
3361
3362 if (sym->attr.lock_comp && coarray && !lock_type)
3363 gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
3364 "subcomponent of type LOCK_TYPE must have a codimension or "
3365 "be a subcomponent of a coarray. (Variables of type %s may "
3366 "not have a codimension as %s at %L has a codimension or a "
3367 "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
3368 sym->name, c->name, &c->loc);
3369
3370 /* Similarly for EVENT TYPE. */
3371
3372 if (pointer && !coarray && event_type)
3373 gfc_error ("Component %s at %L of type EVENT_TYPE must have a "
3374 "codimension or be a subcomponent of a coarray, "
3375 "which is not possible as the component has the "
3376 "pointer attribute", c->name, &c->loc);
3377 else if (pointer && !coarray && c->ts.type == BT_DERIVED
3378 && c->ts.u.derived->attr.event_comp)
3379 gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
3380 "of type EVENT_TYPE, which must have a codimension or be a "
3381 "subcomponent of a coarray", c->name, &c->loc);
3382
3383 if (event_type && allocatable && !coarray)
3384 gfc_error ("Allocatable component %s at %L of type EVENT_TYPE must have "
3385 "a codimension", c->name, &c->loc);
3386 else if (event_type && allocatable && c->ts.type == BT_DERIVED
3387 && c->ts.u.derived->attr.event_comp)
3388 gfc_error ("Allocatable component %s at %L must have a codimension as "
3389 "it has a noncoarray subcomponent of type EVENT_TYPE",
3390 c->name, &c->loc);
3391
3392 if (sym->attr.coarray_comp && !coarray && event_type)
3393 gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
3394 "subcomponent of type EVENT_TYPE must have a codimension or "
3395 "be a subcomponent of a coarray. (Variables of type %s may "
3396 "not have a codimension as already a coarray "
3397 "subcomponent exists)", c->name, &c->loc, sym->name);
3398
3399 if (sym->attr.event_comp && coarray && !event_type)
3400 gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
3401 "subcomponent of type EVENT_TYPE must have a codimension or "
3402 "be a subcomponent of a coarray. (Variables of type %s may "
3403 "not have a codimension as %s at %L has a codimension or a "
3404 "coarray subcomponent)", event_comp->name, &event_comp->loc,
3405 sym->name, c->name, &c->loc);
3406
3407 /* Look for private components. */
3408 if (sym->component_access == ACCESS_PRIVATE
3409 || c->attr.access == ACCESS_PRIVATE
3410 || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
3411 sym->attr.private_comp = 1;
3412
3413 if (lockp) *lockp = lock_comp;
3414 if (eventp) *eventp = event_comp;
3415}
3416
3417
3418static void parse_struct_map (gfc_statement);
3419
3420/* Parse a union component definition within a structure definition. */
3421
3422static void
3423parse_union (void)
3424{
3425 int compiling;
3426 gfc_statement st;
3427 gfc_state_data s;
3428 gfc_component *c, *lock_comp = NULL__null, *event_comp = NULL__null;
3429 gfc_symbol *un;
3430
3431 accept_statement(ST_UNION);
3432 push_state (&s, COMP_UNION, gfc_new_block);
3433 un = gfc_new_block;
3434
3435 compiling = 1;
3436
3437 while (compiling)
3438 {
3439 st = next_statement ();
3440 /* Only MAP declarations valid within a union. */
3441 switch (st)
3442 {
3443 case ST_NONE:
3444 unexpected_eof ();
3445
3446 case ST_MAP:
3447 accept_statement (ST_MAP);
3448 parse_struct_map (ST_MAP);
3449 /* Add a component to the union for each map. */
3450 if (!gfc_add_component (un, gfc_new_block->name, &c))
3451 {
3452 gfc_internal_error ("failed to create map component '%s'",
3453 gfc_new_block->name);
3454 reject_statement ();
3455 return;
3456 }
3457 c->ts.type = BT_DERIVED;
3458 c->ts.u.derived = gfc_new_block;
3459 /* Normally components get their initialization expressions when they
3460 are created in decl.cc (build_struct) so we can look through the
3461 flat component list for initializers during resolution. Unions and
3462 maps create components along with their type definitions so we
3463 have to generate initializers here. */
3464 c->initializer = gfc_default_initializer (&c->ts);
3465 break;
3466
3467 case ST_END_UNION:
3468 compiling = 0;
3469 accept_statement (ST_END_UNION);
3470 break;
3471
3472 default:
3473 unexpected_statement (st);
3474 break;
3475 }
3476 }
3477
3478 for (c = un->components; c; c = c->next)
3479 check_component (un, c, &lock_comp, &event_comp);
3480
3481 /* Add the union as a component in its parent structure. */
3482 pop_state ();
3483 if (!gfc_add_component (gfc_current_block ()(gfc_state_stack->sym), un->name, &c))
3484 {
3485 gfc_internal_error ("failed to create union component '%s'", un->name);
3486 reject_statement ();
3487 return;
3488 }
3489 c->ts.type = BT_UNION;
3490 c->ts.u.derived = un;
3491 c->initializer = gfc_default_initializer (&c->ts);
3492
3493 un->attr.zero_comp = un->components == NULL__null;
3494}
3495
3496
3497/* Parse a STRUCTURE or MAP. */
3498
3499static void
3500parse_struct_map (gfc_statement block)
3501{
3502 int compiling_type;
3503 gfc_statement st;
3504 gfc_state_data s;
3505 gfc_symbol *sym;
3506 gfc_component *c, *lock_comp = NULL__null, *event_comp = NULL__null;
3507 gfc_compile_state comp;
3508 gfc_statement ends;
3509
3510 if (block == ST_STRUCTURE_DECL)
3511 {
3512 comp = COMP_STRUCTURE;
3513 ends = ST_END_STRUCTURE;
3514 }
3515 else
3516 {
3517 gcc_assert (block == ST_MAP)((void)(!(block == ST_MAP) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3517, __FUNCTION__), 0 : 0));
3518 comp = COMP_MAP;
3519 ends = ST_END_MAP;
3520 }
3521
3522 accept_statement(block);
3523 push_state (&s, comp, gfc_new_block);
3524
3525 gfc_new_block->component_access = ACCESS_PUBLIC;
3526 compiling_type = 1;
3527
3528 while (compiling_type)
3529 {
3530 st = next_statement ();
3531 switch (st)
3532 {
3533 case ST_NONE:
3534 unexpected_eof ();
3535
3536 /* Nested structure declarations will be captured as ST_DATA_DECL. */
3537 case ST_STRUCTURE_DECL:
3538 /* Let a more specific error make it to decode_statement(). */
3539 if (gfc_error_check () == 0)
3540 gfc_error ("Syntax error in nested structure declaration at %C");
3541 reject_statement ();
3542 /* Skip the rest of this statement. */
3543 gfc_error_recovery ();
3544 break;
3545
3546 case ST_UNION:
3547 accept_statement (ST_UNION);
3548 parse_union ();
3549 break;
3550
3551 case ST_DATA_DECL:
3552 /* The data declaration was a nested/ad-hoc STRUCTURE field. */
3553 accept_statement (ST_DATA_DECL);
3554 if (gfc_new_block && gfc_new_block != gfc_current_block ()(gfc_state_stack->sym)
3555 && gfc_new_block->attr.flavor == FL_STRUCT)
3556 parse_struct_map (ST_STRUCTURE_DECL);
3557 break;
3558
3559 case ST_END_STRUCTURE:
3560 case ST_END_MAP:
3561 if (st == ends)
3562 {
3563 accept_statement (st);
3564 compiling_type = 0;
3565 }
3566 else
3567 unexpected_statement (st);
3568 break;
3569
3570 default:
3571 unexpected_statement (st);
3572 break;
3573 }
3574 }
3575
3576 /* Validate each component. */
3577 sym = gfc_current_block ()(gfc_state_stack->sym);
3578 for (c = sym->components; c; c = c->next)
3579 check_component (sym, c, &lock_comp, &event_comp);
3580
3581 sym->attr.zero_comp = (sym->components == NULL__null);
3582
3583 /* Allow parse_union to find this structure to add to its list of maps. */
3584 if (block == ST_MAP)
3585 gfc_new_block = gfc_current_block ()(gfc_state_stack->sym);
3586
3587 pop_state ();
3588}
3589
3590
3591/* Parse a derived type. */
3592
3593static void
3594parse_derived (void)
3595{
3596 int compiling_type, seen_private, seen_sequence, seen_component;
3597 gfc_statement st;
3598 gfc_state_data s;
3599 gfc_symbol *sym;
3600 gfc_component *c, *lock_comp = NULL__null, *event_comp = NULL__null;
3601
3602 accept_statement (ST_DERIVED_DECL);
3603 push_state (&s, COMP_DERIVED, gfc_new_block);
3604
3605 gfc_new_block->component_access = ACCESS_PUBLIC;
3606 seen_private = 0;
3607 seen_sequence = 0;
3608 seen_component = 0;
3609
3610 compiling_type = 1;
3611
3612 while (compiling_type)
3613 {
3614 st = next_statement ();
3615 switch (st)
3616 {
3617 case ST_NONE:
3618 unexpected_eof ();
3619
3620 case ST_DATA_DECL:
3621 case ST_PROCEDURE:
3622 accept_statement (st);
3623 seen_component = 1;
3624 break;
3625
3626 case ST_FINAL:
3627 gfc_error ("FINAL declaration at %C must be inside CONTAINS");
3628 break;
3629
3630 case ST_END_TYPE:
3631endType:
3632 compiling_type = 0;
3633
3634 if (!seen_component)
3635 gfc_notify_std (GFC_STD_F2003(1<<4), "Derived type "
3636 "definition at %C without components");
3637
3638 accept_statement (ST_END_TYPE);
3639 break;
3640
3641 case ST_PRIVATE:
3642 if (!gfc_find_state (COMP_MODULE))
3643 {
3644 gfc_error ("PRIVATE statement in TYPE at %C must be inside "
3645 "a MODULE");
3646 break;
3647 }
3648
3649 if (seen_component)
3650 {
3651 gfc_error ("PRIVATE statement at %C must precede "
3652 "structure components");
3653 break;
3654 }
3655
3656 if (seen_private)
3657 gfc_error ("Duplicate PRIVATE statement at %C");
3658
3659 s.sym->component_access = ACCESS_PRIVATE;
3660
3661 accept_statement (ST_PRIVATE);
3662 seen_private = 1;
3663 break;
3664
3665 case ST_SEQUENCE:
3666 if (seen_component)
3667 {
3668 gfc_error ("SEQUENCE statement at %C must precede "
3669 "structure components");
3670 break;
3671 }
3672
3673 if (gfc_current_block ()(gfc_state_stack->sym)->attr.sequence)
3674 gfc_warning (0, "SEQUENCE attribute at %C already specified in "
3675 "TYPE statement");
3676
3677 if (seen_sequence)
3678 {
3679 gfc_error ("Duplicate SEQUENCE statement at %C");
3680 }
3681
3682 seen_sequence = 1;
3683 gfc_add_sequence (&gfc_current_block ()(gfc_state_stack->sym)->attr,
3684 gfc_current_block ()(gfc_state_stack->sym)->name, NULL__null);
3685 break;
3686
3687 case ST_CONTAINS:
3688 gfc_notify_std (GFC_STD_F2003(1<<4),
3689 "CONTAINS block in derived type"
3690 " definition at %C");
3691
3692 accept_statement (ST_CONTAINS);
3693 parse_derived_contains ();
3694 goto endType;
3695
3696 default:
3697 unexpected_statement (st);
3698 break;
3699 }
3700 }
3701
3702 /* need to verify that all fields of the derived type are
3703 * interoperable with C if the type is declared to be bind(c)
3704 */
3705 sym = gfc_current_block ()(gfc_state_stack->sym);
3706 for (c = sym->components; c; c = c->next)
3707 check_component (sym, c, &lock_comp, &event_comp);
3708
3709 if (!seen_component)
3710 sym->attr.zero_comp = 1;
3711
3712 pop_state ();
3713}
3714
3715
3716/* Parse an ENUM. */
3717
3718static void
3719parse_enum (void)
3720{
3721 gfc_statement st;
3722 int compiling_enum;
3723 gfc_state_data s;
3724 int seen_enumerator = 0;
3725
3726 push_state (&s, COMP_ENUM, gfc_new_block);
3727
3728 compiling_enum = 1;
3729
3730 while (compiling_enum)
3731 {
3732 st = next_statement ();
3733 switch (st)
3734 {
3735 case ST_NONE:
3736 unexpected_eof ();
3737 break;
3738
3739 case ST_ENUMERATOR:
3740 seen_enumerator = 1;
3741 accept_statement (st);
3742 break;
3743
3744 case ST_END_ENUM:
3745 compiling_enum = 0;
3746 if (!seen_enumerator)
3747 gfc_error ("ENUM declaration at %C has no ENUMERATORS");
3748 accept_statement (st);
3749 break;
3750
3751 default:
3752 gfc_free_enum_history ();
3753 unexpected_statement (st);
3754 break;
3755 }
3756 }
3757 pop_state ();
3758}
3759
3760
3761/* Parse an interface. We must be able to deal with the possibility
3762 of recursive interfaces. The parse_spec() subroutine is mutually
3763 recursive with parse_interface(). */
3764
3765static gfc_statement parse_spec (gfc_statement);
3766
3767static void
3768parse_interface (void)
3769{
3770 gfc_compile_state new_state = COMP_NONE, current_state;
3771 gfc_symbol *prog_unit, *sym;
3772 gfc_interface_info save;
3773 gfc_state_data s1, s2;
3774 gfc_statement st;
3775
3776 accept_statement (ST_INTERFACE);
3777
3778 current_interface.ns = gfc_current_ns;
3779 save = current_interface;
3780
3781 sym = (current_interface.type == INTERFACE_GENERIC
3782 || current_interface.type == INTERFACE_USER_OP)
3783 ? gfc_new_block : NULL__null;
3784
3785 push_state (&s1, COMP_INTERFACE, sym);
3786 current_state = COMP_NONE;
3787
3788loop:
3789 gfc_current_ns = gfc_get_namespace (current_interface.ns, 0);
3790
3791 st = next_statement ();
3792 switch (st)
3793 {
3794 case ST_NONE:
3795 unexpected_eof ();
3796
3797 case ST_SUBROUTINE:
3798 case ST_FUNCTION:
3799 if (st == ST_SUBROUTINE)
3800 new_state = COMP_SUBROUTINE;
3801 else if (st == ST_FUNCTION)
3802 new_state = COMP_FUNCTION;
3803 if (gfc_new_block->attr.pointer)
3804 {
3805 gfc_new_block->attr.pointer = 0;
3806 gfc_new_block->attr.proc_pointer = 1;
3807 }
3808 if (!gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
3809 gfc_new_block->formal, NULL__null))
3810 {
3811 reject_statement ();
3812 gfc_free_namespace (gfc_current_ns);
3813 goto loop;
3814 }
3815 /* F2008 C1210 forbids the IMPORT statement in module procedure
3816 interface bodies and the flag is set to import symbols. */
3817 if (gfc_new_block->attr.module_procedure)
3818 gfc_current_ns->has_import_set = 1;
3819 break;
3820
3821 case ST_PROCEDURE:
3822 case ST_MODULE_PROC: /* The module procedure matcher makes
3823 sure the context is correct. */
3824 accept_statement (st);
3825 gfc_free_namespace (gfc_current_ns);
3826 goto loop;
3827
3828 case ST_END_INTERFACE:
3829 gfc_free_namespace (gfc_current_ns);
3830 gfc_current_ns = current_interface.ns;
3831 goto done;
3832
3833 default:
3834 gfc_error ("Unexpected %s statement in INTERFACE block at %C",
3835 gfc_ascii_statement (st));
3836 reject_statement ();
3837 gfc_free_namespace (gfc_current_ns);
3838 goto loop;
3839 }
3840
3841
3842 /* Make sure that the generic name has the right attribute. */
3843 if (current_interface.type == INTERFACE_GENERIC
3844 && current_state == COMP_NONE)
3845 {
3846 if (new_state == COMP_FUNCTION && sym)
3847 gfc_add_function (&sym->attr, sym->name, NULL__null);
3848 else if (new_state == COMP_SUBROUTINE && sym)
3849 gfc_add_subroutine (&sym->attr, sym->name, NULL__null);
3850
3851 current_state = new_state;
3852 }
3853
3854 if (current_interface.type == INTERFACE_ABSTRACT)
3855 {
3856 gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus);
3857 if (gfc_is_intrinsic_typename (gfc_new_block->name))
3858 gfc_error ("Name %qs of ABSTRACT INTERFACE at %C "
3859 "cannot be the same as an intrinsic type",
3860 gfc_new_block->name);
3861 }
3862
3863 push_state (&s2, new_state, gfc_new_block);
3864 accept_statement (st);
3865 prog_unit = gfc_new_block;
3866 prog_unit->formal_ns = gfc_current_ns;
3867 if (prog_unit == prog_unit->formal_ns->proc_name
3868 && prog_unit->ns != prog_unit->formal_ns)
3869 prog_unit->refs++;
3870
3871decl:
3872 /* Read data declaration statements. */
3873 st = parse_spec (ST_NONE);
3874 in_specification_block = true;
3875
3876 /* Since the interface block does not permit an IMPLICIT statement,
3877 the default type for the function or the result must be taken
3878 from the formal namespace. */
3879 if (new_state == COMP_FUNCTION)
3880 {
3881 if (prog_unit->result == prog_unit
3882 && prog_unit->ts.type == BT_UNKNOWN)
3883 gfc_set_default_type (prog_unit, 1, prog_unit->formal_ns);
3884 else if (prog_unit->result != prog_unit
3885 && prog_unit->result->ts.type == BT_UNKNOWN)
3886 gfc_set_default_type (prog_unit->result, 1,
3887 prog_unit->formal_ns);
3888 }
3889
3890 if (st != ST_END_SUBROUTINE && st != ST_END_FUNCTION)
3891 {
3892 gfc_error ("Unexpected %s statement at %C in INTERFACE body",
3893 gfc_ascii_statement (st));
3894 reject_statement ();
3895 goto decl;
3896 }
3897
3898 /* Add EXTERNAL attribute to function or subroutine. */
3899 if (current_interface.type != INTERFACE_ABSTRACT && !prog_unit->attr.dummy)
3900 gfc_add_external (&prog_unit->attr, &gfc_current_locus);
3901
3902 current_interface = save;
3903 gfc_add_interface (prog_unit);
3904 pop_state ();
3905
3906 if (current_interface.ns
3907 && current_interface.ns->proc_name
3908 && strcmp (current_interface.ns->proc_name->name,
3909 prog_unit->name) == 0)
3910 gfc_error ("INTERFACE procedure %qs at %L has the same name as the "
3911 "enclosing procedure", prog_unit->name,
3912 &current_interface.ns->proc_name->declared_at);
3913
3914 goto loop;
3915
3916done:
3917 pop_state ();
3918}
3919
3920
3921/* Associate function characteristics by going back to the function
3922 declaration and rematching the prefix. */
3923
3924static match
3925match_deferred_characteristics (gfc_typespec * ts)
3926{
3927 locus loc;
3928 match m = MATCH_ERROR;
3929 char name[GFC_MAX_SYMBOL_LEN63 + 1];
3930
3931 loc = gfc_current_locus;
3932
3933 gfc_current_locus = gfc_current_block ()(gfc_state_stack->sym)->declared_at;
3934
3935 gfc_clear_error ();
3936 gfc_buffer_error (true);
3937 m = gfc_match_prefix (ts);
3938 gfc_buffer_error (false);
3939
3940 if (ts->type == BT_DERIVED || ts->type == BT_CLASS)
3941 {
3942 ts->kind = 0;
3943
3944 if (!ts->u.derived)
3945 m = MATCH_ERROR;
3946 }
3947
3948 /* Only permit one go at the characteristic association. */
3949 if (ts->kind == -1)
3950 ts->kind = 0;
3951
3952 /* Set the function locus correctly. If we have not found the
3953 function name, there is an error. */
3954 if (m == MATCH_YES
3955 && gfc_match ("function% %n", name) == MATCH_YES
3956 && strcmp (name, gfc_current_block ()(gfc_state_stack->sym)->name) == 0)
3957 {
3958 gfc_current_block ()(gfc_state_stack->sym)->declared_at = gfc_current_locus;
3959 gfc_commit_symbols ();
3960 }
3961 else
3962 {
3963 gfc_error_check ();
3964 gfc_undo_symbols ();
3965 }
3966
3967 gfc_current_locus =loc;
3968 return m;
3969}
3970
3971
3972/* Check specification-expressions in the function result of the currently
3973 parsed block and ensure they are typed (give an IMPLICIT type if necessary).
3974 For return types specified in a FUNCTION prefix, the IMPLICIT rules of the
3975 scope are not yet parsed so this has to be delayed up to parse_spec. */
3976
3977static bool
3978check_function_result_typed (void)
3979{
3980 gfc_typespec ts;
3981
3982 gcc_assert (gfc_current_state () == COMP_FUNCTION)((void)(!((gfc_state_stack->state) == COMP_FUNCTION) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 3982, __FUNCTION__), 0 : 0));
3983
3984 if (!gfc_current_ns->proc_name->result)
3985 return true;
3986
3987 ts = gfc_current_ns->proc_name->result->ts;
3988
3989 /* Check type-parameters, at the moment only CHARACTER lengths possible. */
3990 /* TODO: Extend when KIND type parameters are implemented. */
3991 if (ts.type == BT_CHARACTER && ts.u.cl && ts.u.cl->length)
3992 {
3993 /* Reject invalid type of specification expression for length. */
3994 if (ts.u.cl->length->ts.type != BT_INTEGER)
3995 return false;
3996
3997 gfc_expr_check_typed (ts.u.cl->length, gfc_current_ns, true);
3998 }
3999
4000 return true;
4001}
4002
4003
4004/* Parse a set of specification statements. Returns the statement
4005 that doesn't fit. */
4006
4007static gfc_statement
4008parse_spec (gfc_statement st)
4009{
4010 st_state ss;
4011 bool function_result_typed = false;
4012 bool bad_characteristic = false;
4013 gfc_typespec *ts;
4014
4015 in_specification_block = true;
4016
4017 verify_st_order (&ss, ST_NONE, false);
4018 if (st == ST_NONE)
4019 st = next_statement ();
4020
4021 /* If we are not inside a function or don't have a result specified so far,
4022 do nothing special about it. */
4023 if (gfc_current_state ()(gfc_state_stack->state) != COMP_FUNCTION)
4024 function_result_typed = true;
4025 else
4026 {
4027 gfc_symbol* proc = gfc_current_ns->proc_name;
4028 gcc_assert (proc)((void)(!(proc) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 4028, __FUNCTION__), 0 : 0));
4029
4030 if (proc->result && proc->result->ts.type == BT_UNKNOWN)
4031 function_result_typed = true;
4032 }
4033
4034loop:
4035
4036 /* If we're inside a BLOCK construct, some statements are disallowed.
4037 Check this here. Attribute declaration statements like INTENT, OPTIONAL
4038 or VALUE are also disallowed, but they don't have a particular ST_*
4039 key so we have to check for them individually in their matcher routine. */
4040 if (gfc_current_state ()(gfc_state_stack->state) == COMP_BLOCK)
4041 switch (st)
4042 {
4043 case ST_IMPLICIT:
4044 case ST_IMPLICIT_NONE:
4045 case ST_NAMELIST:
4046 case ST_COMMON:
4047 case ST_EQUIVALENCE:
4048 case ST_STATEMENT_FUNCTION:
4049 gfc_error ("%s statement is not allowed inside of BLOCK at %C",
4050 gfc_ascii_statement (st));
4051 reject_statement ();
4052 break;
4053
4054 default:
4055 break;
4056 }
4057 else if (gfc_current_state ()(gfc_state_stack->state) == COMP_BLOCK_DATA)
4058 /* Fortran 2008, C1116. */
4059 switch (st)
4060 {
4061 case ST_ATTR_DECL:
4062 case ST_COMMON:
4063 case ST_DATA:
4064 case ST_DATA_DECL:
4065 case ST_DERIVED_DECL:
4066 case ST_END_BLOCK_DATA:
4067 case ST_EQUIVALENCE:
4068 case ST_IMPLICIT:
4069 case ST_IMPLICIT_NONE:
4070 case ST_OMP_THREADPRIVATE:
4071 case ST_PARAMETER:
4072 case ST_STRUCTURE_DECL:
4073 case ST_TYPE:
4074 case ST_USE:
4075 break;
4076
4077 case ST_NONE:
4078 break;
4079
4080 default:
4081 gfc_error ("%s statement is not allowed inside of BLOCK DATA at %C",
4082 gfc_ascii_statement (st));
4083 reject_statement ();
4084 break;
4085 }
4086
4087 /* If we find a statement that cannot be followed by an IMPLICIT statement
4088 (and thus we can expect to see none any further), type the function result
4089 if it has not yet been typed. Be careful not to give the END statement
4090 to verify_st_order! */
4091 if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS)
4092 {
4093 bool verify_now = false;
4094
4095 if (st == ST_END_FUNCTION || st == ST_CONTAINS)
4096 verify_now = true;
4097 else
4098 {
4099 st_state dummyss;
4100 verify_st_order (&dummyss, ST_NONE, false);
4101 verify_st_order (&dummyss, st, false);
4102
4103 if (!verify_st_order (&dummyss, ST_IMPLICIT, true))
4104 verify_now = true;
4105 }
4106
4107 if (verify_now)
4108 function_result_typed = check_function_result_typed ();
4109 }
4110
4111 switch (st)
4112 {
4113 case ST_NONE:
4114 unexpected_eof ();
4115
4116 case ST_IMPLICIT_NONE:
4117 case ST_IMPLICIT:
4118 if (!function_result_typed)
4119 function_result_typed = check_function_result_typed ();
4120 goto declSt;
4121
4122 case ST_FORMAT:
4123 case ST_ENTRY:
4124 case ST_DATA: /* Not allowed in interfaces */
4125 if (gfc_current_state ()(gfc_state_stack->state) == COMP_INTERFACE)
4126 break;
4127
4128 /* Fall through */
4129
4130 case ST_USE:
4131 case ST_IMPORT:
4132 case ST_PARAMETER:
4133 case ST_PUBLIC:
4134 case ST_PRIVATE:
4135 case ST_STRUCTURE_DECL:
4136 case ST_DERIVED_DECL:
4137 case_declcase ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: case ST_EQUIVALENCE
: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: case ST_TYPE:
case ST_INTERFACE: case ST_PROCEDURE:
4138 case_omp_declcase ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_TARGET
: case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT:
case ST_OMP_ASSUMES: case ST_OMP_REQUIRES: case ST_OACC_ROUTINE
: case ST_OACC_DECLARE:
4139declSt:
4140 if (!verify_st_order (&ss, st, false))
4141 {
4142 reject_statement ();
4143 st = next_statement ();
4144 goto loop;
4145 }
4146
4147 switch (st)
4148 {
4149 case ST_INTERFACE:
4150 parse_interface ();
4151 break;
4152
4153 case ST_STRUCTURE_DECL:
4154 parse_struct_map (ST_STRUCTURE_DECL);
4155 break;
4156
4157 case ST_DERIVED_DECL:
4158 parse_derived ();
4159 break;
4160
4161 case ST_PUBLIC:
4162 case ST_PRIVATE:
4163 if (gfc_current_state ()(gfc_state_stack->state) != COMP_MODULE)
4164 {
4165 gfc_error ("%s statement must appear in a MODULE",
4166 gfc_ascii_statement (st));
4167 reject_statement ();
4168 break;
4169 }
4170
4171 if (gfc_current_ns->default_access != ACCESS_UNKNOWN)
4172 {
4173 gfc_error ("%s statement at %C follows another accessibility "
4174 "specification", gfc_ascii_statement (st));
4175 reject_statement ();
4176 break;
4177 }
4178
4179 gfc_current_ns->default_access = (st == ST_PUBLIC)
4180 ? ACCESS_PUBLIC : ACCESS_PRIVATE;
4181
4182 break;
4183
4184 case ST_STATEMENT_FUNCTION:
4185 if (gfc_current_state ()(gfc_state_stack->state) == COMP_MODULE
4186 || gfc_current_state ()(gfc_state_stack->state) == COMP_SUBMODULE)
4187 {
4188 unexpected_statement (st);
4189 break;
4190 }
4191
4192 default:
4193 break;
4194 }
4195
4196 accept_statement (st);
4197 st = next_statement ();
4198 goto loop;
4199
4200 case ST_ENUM:
4201 accept_statement (st);
4202 parse_enum();
4203 st = next_statement ();
4204 goto loop;
4205
4206 case ST_GET_FCN_CHARACTERISTICS:
4207 /* This statement triggers the association of a function's result
4208 characteristics. */
4209 ts = &gfc_current_block ()(gfc_state_stack->sym)->result->ts;
4210 if (match_deferred_characteristics (ts) != MATCH_YES)
4211 bad_characteristic = true;
4212
4213 st = next_statement ();
4214 goto loop;
4215
4216 default:
4217 break;
4218 }
4219
4220 /* If match_deferred_characteristics failed, then there is an error. */
4221 if (bad_characteristic)
4222 {
4223 ts = &gfc_current_block ()(gfc_state_stack->sym)->result->ts;
4224 if (ts->type != BT_DERIVED && ts->type != BT_CLASS)
4225 gfc_error ("Bad kind expression for function %qs at %L",
4226 gfc_current_block ()(gfc_state_stack->sym)->name,
4227 &gfc_current_block ()(gfc_state_stack->sym)->declared_at);
4228 else
4229 gfc_error ("The type for function %qs at %L is not accessible",
4230 gfc_current_block ()(gfc_state_stack->sym)->name,
4231 &gfc_current_block ()(gfc_state_stack->sym)->declared_at);
4232
4233 gfc_current_block ()(gfc_state_stack->sym)->ts.kind = 0;
4234 /* Keep the derived type; if it's bad, it will be discovered later. */
4235 if (!(ts->type == BT_DERIVED && ts->u.derived))
4236 ts->type = BT_UNKNOWN;
4237 }
4238
4239 in_specification_block = false;
4240
4241 return st;
4242}
4243
4244
4245/* Parse a WHERE block, (not a simple WHERE statement). */
4246
4247static void
4248parse_where_block (void)
4249{
4250 int seen_empty_else;
4251 gfc_code *top, *d;
4252 gfc_state_data s;
4253 gfc_statement st;
4254
4255 accept_statement (ST_WHERE_BLOCK);
4256 top = gfc_state_stack->tail;
4257
4258 push_state (&s, COMP_WHERE, gfc_new_block);
4259
4260 d = add_statement ();
4261 d->expr1 = top->expr1;
4262 d->op = EXEC_WHERE;
4263
4264 top->expr1 = NULL__null;
4265 top->block = d;
4266
4267 seen_empty_else = 0;
4268
4269 do
4270 {
4271 st = next_statement ();
4272 switch (st)
4273 {
4274 case ST_NONE:
4275 unexpected_eof ();
4276
4277 case ST_WHERE_BLOCK:
4278 parse_where_block ();
4279 break;
4280
4281 case ST_ASSIGNMENT:
4282 case ST_WHERE:
4283 accept_statement (st);
4284 break;
4285
4286 case ST_ELSEWHERE:
4287 if (seen_empty_else)
4288 {
4289 gfc_error ("ELSEWHERE statement at %C follows previous "
4290 "unmasked ELSEWHERE");
4291 reject_statement ();
4292 break;
4293 }
4294
4295 if (new_st.expr1 == NULL__null)
4296 seen_empty_else = 1;
4297
4298 d = new_level (gfc_state_stack->head);
4299 d->op = EXEC_WHERE;
4300 d->expr1 = new_st.expr1;
4301
4302 accept_statement (st);
4303
4304 break;
4305
4306 case ST_END_WHERE:
4307 accept_statement (st);
4308 break;
4309
4310 default:
4311 gfc_error ("Unexpected %s statement in WHERE block at %C",
4312 gfc_ascii_statement (st));
4313 reject_statement ();
4314 break;
4315 }
4316 }
4317 while (st != ST_END_WHERE);
4318
4319 pop_state ();
4320}
4321
4322
4323/* Parse a FORALL block (not a simple FORALL statement). */
4324
4325static void
4326parse_forall_block (void)
4327{
4328 gfc_code *top, *d;
4329 gfc_state_data s;
4330 gfc_statement st;
4331
4332 accept_statement (ST_FORALL_BLOCK);
4333 top = gfc_state_stack->tail;
4334
4335 push_state (&s, COMP_FORALL, gfc_new_block);
4336
4337 d = add_statement ();
4338 d->op = EXEC_FORALL;
4339 top->block = d;
4340
4341 do
4342 {
4343 st = next_statement ();
4344 switch (st)
4345 {
4346
4347 case ST_ASSIGNMENT:
4348 case ST_POINTER_ASSIGNMENT:
4349 case ST_WHERE:
4350 case ST_FORALL:
4351 accept_statement (st);
4352 break;
4353
4354 case ST_WHERE_BLOCK:
4355 parse_where_block ();
4356 break;
4357
4358 case ST_FORALL_BLOCK:
4359 parse_forall_block ();
4360 break;
4361
4362 case ST_END_FORALL:
4363 accept_statement (st);
4364 break;
4365
4366 case ST_NONE:
4367 unexpected_eof ();
4368
4369 default:
4370 gfc_error ("Unexpected %s statement in FORALL block at %C",
4371 gfc_ascii_statement (st));
4372
4373 reject_statement ();
4374 break;
4375 }
4376 }
4377 while (st != ST_END_FORALL);
4378
4379 pop_state ();
4380}
4381
4382
4383static gfc_statement parse_executable (gfc_statement);
4384
4385/* parse the statements of an IF-THEN-ELSEIF-ELSE-ENDIF block. */
4386
4387static void
4388parse_if_block (void)
4389{
4390 gfc_code *top, *d;
4391 gfc_statement st;
4392 locus else_locus;
4393 gfc_state_data s;
4394 int seen_else;
4395
4396 seen_else = 0;
4397 accept_statement (ST_IF_BLOCK);
4398
4399 top = gfc_state_stack->tail;
4400 push_state (&s, COMP_IF, gfc_new_block);
4401
4402 new_st.op = EXEC_IF;
4403 d = add_statement ();
4404
4405 d->expr1 = top->expr1;
4406 top->expr1 = NULL__null;
4407 top->block = d;
4408
4409 do
4410 {
4411 st = parse_executable (ST_NONE);
4412
4413 switch (st)
4414 {
4415 case ST_NONE:
4416 unexpected_eof ();
4417
4418 case ST_ELSEIF:
4419 if (seen_else)
4420 {
4421 gfc_error ("ELSE IF statement at %C cannot follow ELSE "
4422 "statement at %L", &else_locus);
4423
4424 reject_statement ();
4425 break;
4426 }
4427
4428 d = new_level (gfc_state_stack->head);
4429 d->op = EXEC_IF;
4430 d->expr1 = new_st.expr1;
4431
4432 accept_statement (st);
4433
4434 break;
4435
4436 case ST_ELSE:
4437 if (seen_else)
4438 {
4439 gfc_error ("Duplicate ELSE statements at %L and %C",
4440 &else_locus);
4441 reject_statement ();
4442 break;
4443 }
4444
4445 seen_else = 1;
4446 else_locus = gfc_current_locus;
4447
4448 d = new_level (gfc_state_stack->head);
4449 d->op = EXEC_IF;
4450
4451 accept_statement (st);
4452
4453 break;
4454
4455 case ST_ENDIF:
4456 break;
4457
4458 default:
4459 unexpected_statement (st);
4460 break;
4461 }
4462 }
4463 while (st != ST_ENDIF);
4464
4465 pop_state ();
4466 accept_statement (st);
4467}
4468
4469
4470/* Parse a SELECT block. */
4471
4472static void
4473parse_select_block (void)
4474{
4475 gfc_statement st;
4476 gfc_code *cp;
4477 gfc_state_data s;
4478
4479 accept_statement (ST_SELECT_CASE);
4480
4481 cp = gfc_state_stack->tail;
4482 push_state (&s, COMP_SELECT, gfc_new_block);
4483
4484 /* Make sure that the next statement is a CASE or END SELECT. */
4485 for (;;)
4486 {
4487 st = next_statement ();
4488 if (st == ST_NONE)
4489 unexpected_eof ();
4490 if (st == ST_END_SELECT)
4491 {
4492 /* Empty SELECT CASE is OK. */
4493 accept_statement (st);
4494 pop_state ();
4495 return;
4496 }
4497 if (st == ST_CASE)
4498 break;
4499
4500 gfc_error ("Expected a CASE or END SELECT statement following SELECT "
4501 "CASE at %C");
4502
4503 reject_statement ();
4504 }
4505
4506 /* At this point, we've got a nonempty select block. */
4507 cp = new_level (cp);
4508 *cp = new_st;
4509
4510 accept_statement (st);
4511
4512 do
4513 {
4514 st = parse_executable (ST_NONE);
4515 switch (st)
4516 {
4517 case ST_NONE:
4518 unexpected_eof ();
4519
4520 case ST_CASE:
4521 cp = new_level (gfc_state_stack->head);
4522 *cp = new_st;
4523 gfc_clear_new_st ();
4524
4525 accept_statement (st);
4526 /* Fall through */
4527
4528 case ST_END_SELECT:
4529 break;
4530
4531 /* Can't have an executable statement because of
4532 parse_executable(). */
4533 default:
4534 unexpected_statement (st);
4535 break;
4536 }
4537 }
4538 while (st != ST_END_SELECT);
4539
4540 pop_state ();
4541 accept_statement (st);
4542}
4543
4544
4545/* Pop the current selector from the SELECT TYPE stack. */
4546
4547static void
4548select_type_pop (void)
4549{
4550 gfc_select_type_stack *old = select_type_stack;
4551 select_type_stack = old->prev;
4552 free (old);
4553}
4554
4555
4556/* Parse a SELECT TYPE construct (F03:R821). */
4557
4558static void
4559parse_select_type_block (void)
4560{
4561 gfc_statement st;
4562 gfc_code *cp;
4563 gfc_state_data s;
4564
4565 gfc_current_ns = new_st.ext.block.ns;
4566 accept_statement (ST_SELECT_TYPE);
4567
4568 cp = gfc_state_stack->tail;
4569 push_state (&s, COMP_SELECT_TYPE, gfc_new_block);
4570
4571 /* Make sure that the next statement is a TYPE IS, CLASS IS, CLASS DEFAULT
4572 or END SELECT. */
4573 for (;;)
4574 {
4575 st = next_statement ();
4576 if (st == ST_NONE)
4577 unexpected_eof ();
4578 if (st == ST_END_SELECT)
4579 /* Empty SELECT CASE is OK. */
4580 goto done;
4581 if (st == ST_TYPE_IS || st == ST_CLASS_IS)
4582 break;
4583
4584 gfc_error ("Expected TYPE IS, CLASS IS or END SELECT statement "
4585 "following SELECT TYPE at %C");
4586
4587 reject_statement ();
4588 }
4589
4590 /* At this point, we've got a nonempty select block. */
4591 cp = new_level (cp);
4592 *cp = new_st;
4593
4594 accept_statement (st);
4595
4596 do
4597 {
4598 st = parse_executable (ST_NONE);
4599 switch (st)
4600 {
4601 case ST_NONE:
4602 unexpected_eof ();
4603
4604 case ST_TYPE_IS:
4605 case ST_CLASS_IS:
4606 cp = new_level (gfc_state_stack->head);
4607 *cp = new_st;
4608 gfc_clear_new_st ();
4609
4610 accept_statement (st);
4611 /* Fall through */
4612
4613 case ST_END_SELECT:
4614 break;
4615
4616 /* Can't have an executable statement because of
4617 parse_executable(). */
4618 default:
4619 unexpected_statement (st);
4620 break;
4621 }
4622 }
4623 while (st != ST_END_SELECT);
4624
4625done:
4626 pop_state ();
4627 accept_statement (st);
4628 gfc_current_ns = gfc_current_ns->parent;
4629 select_type_pop ();
4630}
4631
4632
4633/* Parse a SELECT RANK construct. */
4634
4635static void
4636parse_select_rank_block (void)
4637{
4638 gfc_statement st;
4639 gfc_code *cp;
4640 gfc_state_data s;
4641
4642 gfc_current_ns = new_st.ext.block.ns;
4643 accept_statement (ST_SELECT_RANK);
4644
4645 cp = gfc_state_stack->tail;
4646 push_state (&s, COMP_SELECT_RANK, gfc_new_block);
4647
4648 /* Make sure that the next statement is a RANK IS or RANK DEFAULT. */
4649 for (;;)
4650 {
4651 st = next_statement ();
4652 if (st == ST_NONE)
4653 unexpected_eof ();
4654 if (st == ST_END_SELECT)
4655 /* Empty SELECT CASE is OK. */
4656 goto done;
4657 if (st == ST_RANK)
4658 break;
4659
4660 gfc_error ("Expected RANK or RANK DEFAULT "
4661 "following SELECT RANK at %C");
4662
4663 reject_statement ();
4664 }
4665
4666 /* At this point, we've got a nonempty select block. */
4667 cp = new_level (cp);
4668 *cp = new_st;
4669
4670 accept_statement (st);
4671
4672 do
4673 {
4674 st = parse_executable (ST_NONE);
4675 switch (st)
4676 {
4677 case ST_NONE:
4678 unexpected_eof ();
4679
4680 case ST_RANK:
4681 cp = new_level (gfc_state_stack->head);
4682 *cp = new_st;
4683 gfc_clear_new_st ();
4684
4685 accept_statement (st);
4686 /* Fall through */
4687
4688 case ST_END_SELECT:
4689 break;
4690
4691 /* Can't have an executable statement because of
4692 parse_executable(). */
4693 default:
4694 unexpected_statement (st);
4695 break;
4696 }
4697 }
4698 while (st != ST_END_SELECT);
4699
4700done:
4701 pop_state ();
4702 accept_statement (st);
4703 gfc_current_ns = gfc_current_ns->parent;
4704 select_type_pop ();
4705}
4706
4707
4708/* Given a symbol, make sure it is not an iteration variable for a DO
4709 statement. This subroutine is called when the symbol is seen in a
4710 context that causes it to become redefined. If the symbol is an
4711 iterator, we generate an error message and return nonzero. */
4712
4713int
4714gfc_check_do_variable (gfc_symtree *st)
4715{
4716 gfc_state_data *s;
4717
4718 if (!st)
4719 return 0;
4720
4721 for (s=gfc_state_stack; s; s = s->previous)
4722 if (s->do_variable == st)
4723 {
4724 gfc_error_now ("Variable %qs at %C cannot be redefined inside "
4725 "loop beginning at %L", st->name, &s->head->loc);
4726 return 1;
4727 }
4728
4729 return 0;
4730}
4731
4732
4733/* Checks to see if the current statement label closes an enddo.
4734 Returns 0 if not, 1 if closes an ENDDO correctly, or 2 (and issues
4735 an error) if it incorrectly closes an ENDDO. */
4736
4737static int
4738check_do_closure (void)
4739{
4740 gfc_state_data *p;
4741
4742 if (gfc_statement_label == NULL__null)
4743 return 0;
4744
4745 for (p = gfc_state_stack; p; p = p->previous)
4746 if (p->state == COMP_DO || p->state == COMP_DO_CONCURRENT)
4747 break;
4748
4749 if (p == NULL__null)
4750 return 0; /* No loops to close */
4751
4752 if (p->ext.end_do_label == gfc_statement_label)
4753 {
4754 if (p == gfc_state_stack)
4755 return 1;
4756
4757 gfc_error ("End of nonblock DO statement at %C is within another block");
4758 return 2;
4759 }
4760
4761 /* At this point, the label doesn't terminate the innermost loop.
4762 Make sure it doesn't terminate another one. */
4763 for (; p; p = p->previous)
4764 if ((p->state == COMP_DO || p->state == COMP_DO_CONCURRENT)
4765 && p->ext.end_do_label == gfc_statement_label)
4766 {
4767 gfc_error ("End of nonblock DO statement at %C is interwoven "
4768 "with another DO loop");
4769 return 2;
4770 }
4771
4772 return 0;
4773}
4774
4775
4776/* Parse a series of contained program units. */
4777
4778static void parse_progunit (gfc_statement);
4779
4780
4781/* Parse a CRITICAL block. */
4782
4783static void
4784parse_critical_block (void)
4785{
4786 gfc_code *top, *d;
4787 gfc_state_data s, *sd;
4788 gfc_statement st;
4789
4790 for (sd = gfc_state_stack; sd; sd = sd->previous)
4791 if (sd->state == COMP_OMP_STRUCTURED_BLOCK)
4792 gfc_error_now (is_oacc (sd)
4793 ? G_("CRITICAL block inside of OpenACC region at %C")"CRITICAL block inside of OpenACC region at %C"
4794 : G_("CRITICAL block inside of OpenMP region at %C")"CRITICAL block inside of OpenMP region at %C");
4795
4796 s.ext.end_do_label = new_st.label1;
4797
4798 accept_statement (ST_CRITICAL);
4799 top = gfc_state_stack->tail;
4800
4801 push_state (&s, COMP_CRITICAL, gfc_new_block);
4802
4803 d = add_statement ();
4804 d->op = EXEC_CRITICAL;
4805 top->block = d;
4806
4807 do
4808 {
4809 st = parse_executable (ST_NONE);
4810
4811 switch (st)
4812 {
4813 case ST_NONE:
4814 unexpected_eof ();
4815 break;
4816
4817 case ST_END_CRITICAL:
4818 if (s.ext.end_do_label != NULL__null
4819 && s.ext.end_do_label != gfc_statement_label)
4820 gfc_error_now ("Statement label in END CRITICAL at %C does not "
4821 "match CRITICAL label");
4822
4823 if (gfc_statement_label != NULL__null)
4824 {
4825 new_st.op = EXEC_NOP;
4826 add_statement ();
4827 }
4828 break;
4829
4830 default:
4831 unexpected_statement (st);
4832 break;
4833 }
4834 }
4835 while (st != ST_END_CRITICAL);
4836
4837 pop_state ();
4838 accept_statement (st);
4839}
4840
4841
4842/* Set up the local namespace for a BLOCK construct. */
4843
4844gfc_namespace*
4845gfc_build_block_ns (gfc_namespace *parent_ns)
4846{
4847 gfc_namespace* my_ns;
4848 static int numblock = 1;
4849
4850 my_ns = gfc_get_namespace (parent_ns, 1);
4851 my_ns->construct_entities = 1;
4852
4853 /* Give the BLOCK a symbol of flavor LABEL; this is later needed for correct
4854 code generation (so it must not be NULL).
4855 We set its recursive argument if our container procedure is recursive, so
4856 that local variables are accordingly placed on the stack when it
4857 will be necessary. */
4858 if (gfc_new_block)
4859 my_ns->proc_name = gfc_new_block;
4860 else
4861 {
4862 bool t;
4863 char buffer[20]; /* Enough to hold "block@2147483648\n". */
4864
4865 snprintf(buffer, sizeof(buffer), "block@%d", numblock++);
4866 gfc_get_symbol (buffer, my_ns, &my_ns->proc_name);
4867 t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL,
4868 my_ns->proc_name->name, NULL__null);
4869 gcc_assert (t)((void)(!(t) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 4869, __FUNCTION__), 0 : 0));
4870 gfc_commit_symbol (my_ns->proc_name);
4871 }
4872
4873 if (parent_ns->proc_name)
4874 my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive;
4875
4876 return my_ns;
4877}
4878
4879
4880/* Parse a BLOCK construct. */
4881
4882static void
4883parse_block_construct (void)
4884{
4885 gfc_namespace* my_ns;
4886 gfc_namespace* my_parent;
4887 gfc_state_data s;
4888
4889 gfc_notify_std (GFC_STD_F2008(1<<7), "BLOCK construct at %C");
4890
4891 my_ns = gfc_build_block_ns (gfc_current_ns);
4892
4893 new_st.op = EXEC_BLOCK;
4894 new_st.ext.block.ns = my_ns;
4895 new_st.ext.block.assoc = NULL__null;
4896 accept_statement (ST_BLOCK);
4897
4898 push_state (&s, COMP_BLOCK, my_ns->proc_name);
4899 gfc_current_ns = my_ns;
4900 my_parent = my_ns->parent;
4901
4902 parse_progunit (ST_NONE);
4903
4904 /* Don't depend on the value of gfc_current_ns; it might have been
4905 reset if the block had errors and was cleaned up. */
4906 gfc_current_ns = my_parent;
4907
4908 pop_state ();
4909}
4910
4911
4912/* Parse an ASSOCIATE construct. This is essentially a BLOCK construct
4913 behind the scenes with compiler-generated variables. */
4914
4915static void
4916parse_associate (void)
4917{
4918 gfc_namespace* my_ns;
4919 gfc_state_data s;
4920 gfc_statement st;
4921 gfc_association_list* a;
4922
4923 gfc_notify_std (GFC_STD_F2003(1<<4), "ASSOCIATE construct at %C");
4924
4925 my_ns = gfc_build_block_ns (gfc_current_ns);
4926
4927 new_st.op = EXEC_BLOCK;
4928 new_st.ext.block.ns = my_ns;
4929 gcc_assert (new_st.ext.block.assoc)((void)(!(new_st.ext.block.assoc) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 4929, __FUNCTION__), 0 : 0));
4930
4931 /* Add all associate-names as BLOCK variables. Creating them is enough
4932 for now, they'll get their values during trans-* phase. */
4933 gfc_current_ns = my_ns;
4934 for (a = new_st.ext.block.assoc; a; a = a->next)
4935 {
4936 gfc_symbol* sym;
4937 gfc_ref *ref;
4938 gfc_array_ref *array_ref;
4939
4940 if (gfc_get_sym_tree (a->name, NULL__null, &a->st, false))
4941 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 4941, __FUNCTION__));
4942
4943 sym = a->st->n.sym;
4944 sym->attr.flavor = FL_VARIABLE;
4945 sym->assoc = a;
4946 sym->declared_at = a->where;
4947 gfc_set_sym_referenced (sym);
4948
4949 /* Initialize the typespec. It is not available in all cases,
4950 however, as it may only be set on the target during resolution.
4951 Still, sometimes it helps to have it right now -- especially
4952 for parsing component references on the associate-name
4953 in case of association to a derived-type. */
4954 sym->ts = a->target->ts;
4955
4956 /* Don’t share the character length information between associate
4957 variable and target if the length is not a compile-time constant,
4958 as we don’t want to touch some other character length variable when
4959 we try to initialize the associate variable’s character length
4960 variable.
4961 We do it here rather than later so that expressions referencing the
4962 associate variable will automatically have the correctly setup length
4963 information. If we did it at resolution stage the expressions would
4964 use the original length information, and the variable a new different
4965 one, but only the latter one would be correctly initialized at
4966 translation stage, and the former one would need some additional setup
4967 there. */
4968 if (sym->ts.type == BT_CHARACTER
4969 && sym->ts.u.cl
4970 && !(sym->ts.u.cl->length
4971 && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT))
4972 sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL__null);
4973
4974 /* Check if the target expression is array valued. This cannot always
4975 be done by looking at target.rank, because that might not have been
4976 set yet. Therefore traverse the chain of refs, looking for the last
4977 array ref and evaluate that. */
4978 array_ref = NULL__null;
4979 for (ref = a->target->ref; ref; ref = ref->next)
4980 if (ref->type == REF_ARRAY)
4981 array_ref = &ref->u.ar;
4982 if (array_ref || a->target->rank)
4983 {
4984 gfc_array_spec *as;
4985 int dim, rank = 0;
4986 if (array_ref)
4987 {
4988 a->rankguessed = 1;
4989 /* Count the dimension, that have a non-scalar extend. */
4990 for (dim = 0; dim < array_ref->dimen; ++dim)
4991 if (array_ref->dimen_type[dim] != DIMEN_ELEMENT
4992 && !(array_ref->dimen_type[dim] == DIMEN_UNKNOWN
4993 && array_ref->end[dim] == NULL__null
4994 && array_ref->start[dim] != NULL__null))
4995 ++rank;
4996 }
4997 else
4998 rank = a->target->rank;
4999 /* When the rank is greater than zero then sym will be an array. */
5000 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components)
5001 {
5002 if ((!CLASS_DATA (sym)sym->ts.u.derived->components->as && rank != 0)
5003 || (CLASS_DATA (sym)sym->ts.u.derived->components->as
5004 && CLASS_DATA (sym)sym->ts.u.derived->components->as->rank != rank))
5005 {
5006 /* Don't just (re-)set the attr and as in the sym.ts,
5007 because this modifies the target's attr and as. Copy the
5008 data and do a build_class_symbol. */
5009 symbol_attribute attr = CLASS_DATA (a->target)a->target->ts.u.derived->components->attr;
5010 int corank = gfc_get_corank (a->target);
5011 gfc_typespec type;
5012
5013 if (rank || corank)
5014 {
5015 as = gfc_get_array_spec ()((gfc_array_spec *) xcalloc (1, sizeof (gfc_array_spec)));
5016 as->type = AS_DEFERRED;
5017 as->rank = rank;
5018 as->corank = corank;
5019 attr.dimension = rank ? 1 : 0;
5020 attr.codimension = corank ? 1 : 0;
5021 }
5022 else
5023 {
5024 as = NULL__null;
5025 attr.dimension = attr.codimension = 0;
5026 }
5027 attr.class_ok = 0;
5028 type = CLASS_DATA (sym)sym->ts.u.derived->components->ts;
5029 if (!gfc_build_class_symbol (&type,
5030 &attr, &as))
5031 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5031, __FUNCTION__));
5032 sym->ts = type;
5033 sym->ts.type = BT_CLASS;
5034 sym->attr.class_ok = 1;
5035 }
5036 else
5037 sym->attr.class_ok = 1;
5038 }
5039 else if ((!sym->as && rank != 0)
5040 || (sym->as && sym->as->rank != rank))
5041 {
5042 as = gfc_get_array_spec ()((gfc_array_spec *) xcalloc (1, sizeof (gfc_array_spec)));
5043 as->type = AS_DEFERRED;
5044 as->rank = rank;
5045 as->corank = gfc_get_corank (a->target);
5046 sym->as = as;
5047 sym->attr.dimension = 1;
5048 if (as->corank)
5049 sym->attr.codimension = 1;
5050 }
5051 }
5052 }
5053
5054 accept_statement (ST_ASSOCIATE);
5055 push_state (&s, COMP_ASSOCIATE, my_ns->proc_name);
5056
5057loop:
5058 st = parse_executable (ST_NONE);
5059 switch (st)
5060 {
5061 case ST_NONE:
5062 unexpected_eof ();
5063
5064 case_endcase ST_END_BLOCK_DATA: case ST_END_FUNCTION: case ST_END_PROGRAM
: case ST_END_SUBROUTINE: case ST_END_BLOCK: case ST_END_ASSOCIATE:
5065 accept_statement (st);
5066 my_ns->code = gfc_state_stack->head;
5067 break;
5068
5069 default:
5070 unexpected_statement (st);
5071 goto loop;
5072 }
5073
5074 gfc_current_ns = gfc_current_ns->parent;
5075 pop_state ();
5076}
5077
5078
5079/* Parse a DO loop. Note that the ST_CYCLE and ST_EXIT statements are
5080 handled inside of parse_executable(), because they aren't really
5081 loop statements. */
5082
5083static void
5084parse_do_block (void)
5085{
5086 gfc_statement st;
5087 gfc_code *top;
5088 gfc_state_data s;
5089 gfc_symtree *stree;
5090 gfc_exec_op do_op;
5091
5092 do_op = new_st.op;
5093 s.ext.end_do_label = new_st.label1;
5094
5095 if (new_st.ext.iterator != NULL__null)
5096 {
5097 stree = new_st.ext.iterator->var->symtree;
5098 if (directive_unroll != -1)
5099 {
5100 new_st.ext.iterator->unroll = directive_unroll;
5101 directive_unroll = -1;
5102 }
5103 if (directive_ivdep)
5104 {
5105 new_st.ext.iterator->ivdep = directive_ivdep;
5106 directive_ivdep = false;
5107 }
5108 if (directive_vector)
5109 {
5110 new_st.ext.iterator->vector = directive_vector;
5111 directive_vector = false;
5112 }
5113 if (directive_novector)
5114 {
5115 new_st.ext.iterator->novector = directive_novector;
5116 directive_novector = false;
5117 }
5118 }
5119 else
5120 stree = NULL__null;
5121
5122 accept_statement (ST_DO);
5123
5124 top = gfc_state_stack->tail;
5125 push_state (&s, do_op == EXEC_DO_CONCURRENT ? COMP_DO_CONCURRENT : COMP_DO,
5126 gfc_new_block);
5127
5128 s.do_variable = stree;
5129
5130 top->block = new_level (top);
5131 top->block->op = EXEC_DO;
5132
5133loop:
5134 st = parse_executable (ST_NONE);
5135
5136 switch (st)
5137 {
5138 case ST_NONE:
5139 unexpected_eof ();
5140
5141 case ST_ENDDO:
5142 if (s.ext.end_do_label != NULL__null
5143 && s.ext.end_do_label != gfc_statement_label)
5144 gfc_error_now ("Statement label in ENDDO at %C doesn't match "
5145 "DO label");
5146
5147 if (gfc_statement_label != NULL__null)
5148 {
5149 new_st.op = EXEC_NOP;
5150 add_statement ();
5151 }
5152 break;
5153
5154 case ST_IMPLIED_ENDDO:
5155 /* If the do-stmt of this DO construct has a do-construct-name,
5156 the corresponding end-do must be an end-do-stmt (with a matching
5157 name, but in that case we must have seen ST_ENDDO first).
5158 We only complain about this in pedantic mode. */
5159 if (gfc_current_block ()(gfc_state_stack->sym) != NULL__null)
5160 gfc_error_now ("Named block DO at %L requires matching ENDDO name",
5161 &gfc_current_block()(gfc_state_stack->sym)->declared_at);
5162
5163 break;
5164
5165 default:
5166 unexpected_statement (st);
5167 goto loop;
5168 }
5169
5170 pop_state ();
5171 accept_statement (st);
5172}
5173
5174
5175/* Parse the statements of OpenMP do/parallel do. */
5176
5177static gfc_statement
5178parse_omp_do (gfc_statement omp_st)
5179{
5180 gfc_statement st;
5181 gfc_code *cp, *np;
5182 gfc_state_data s;
5183
5184 accept_statement (omp_st);
5185
5186 cp = gfc_state_stack->tail;
5187 push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL__null);
5188 np = new_level (cp);
5189 np->op = cp->op;
5190 np->block = NULL__null;
5191
5192 for (;;)
5193 {
5194 st = next_statement ();
5195 if (st == ST_NONE)
5196 unexpected_eof ();
5197 else if (st == ST_DO)
5198 break;
5199 else
5200 unexpected_statement (st);
5201 }
5202
5203 parse_do_block ();
5204 if (gfc_statement_label != NULL__null
5205 && gfc_state_stack->previous != NULL__null
5206 && gfc_state_stack->previous->state == COMP_DO
5207 && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
5208 {
5209 /* In
5210 DO 100 I=1,10
5211 !$OMP DO
5212 DO J=1,10
5213 ...
5214 100 CONTINUE
5215 there should be no !$OMP END DO. */
5216 pop_state ();
5217 return ST_IMPLIED_ENDDO;
5218 }
5219
5220 check_do_closure ();
5221 pop_state ();
5222
5223 st = next_statement ();
5224 gfc_statement omp_end_st = ST_OMP_END_DO;
5225 switch (omp_st)
5226 {
5227 case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break;
5228 case ST_OMP_DISTRIBUTE_PARALLEL_DO:
5229 omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
5230 break;
5231 case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
5232 omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
5233 break;
5234 case ST_OMP_DISTRIBUTE_SIMD:
5235 omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD;
5236 break;
5237 case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break;
5238 case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break;
5239 case ST_OMP_LOOP: omp_end_st = ST_OMP_END_LOOP; break;
5240 case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break;
5241 case ST_OMP_PARALLEL_DO_SIMD:
5242 omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD;
5243 break;
5244 case ST_OMP_PARALLEL_LOOP:
5245 omp_end_st = ST_OMP_END_PARALLEL_LOOP;
5246 break;
5247 case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break;
5248 case ST_OMP_TARGET_PARALLEL_DO:
5249 omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO;
5250 break;
5251 case ST_OMP_TARGET_PARALLEL_DO_SIMD:
5252 omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
5253 break;
5254 case ST_OMP_TARGET_PARALLEL_LOOP:
5255 omp_end_st = ST_OMP_END_TARGET_PARALLEL_LOOP;
5256 break;
5257 case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break;
5258 case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
5259 omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
5260 break;
5261 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
5262 omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
5263 break;
5264 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
5265 omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
5266 break;
5267 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
5268 omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
5269 break;
5270 case ST_OMP_TARGET_TEAMS_LOOP:
5271 omp_end_st = ST_OMP_END_TARGET_TEAMS_LOOP;
5272 break;
5273 case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
5274 case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
5275 case ST_OMP_MASKED_TASKLOOP: omp_end_st = ST_OMP_END_MASKED_TASKLOOP; break;
5276 case ST_OMP_MASKED_TASKLOOP_SIMD:
5277 omp_end_st = ST_OMP_END_MASKED_TASKLOOP_SIMD;
5278 break;
5279 case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
5280 case ST_OMP_MASTER_TASKLOOP_SIMD:
5281 omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
5282 break;
5283 case ST_OMP_PARALLEL_MASKED_TASKLOOP:
5284 omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
5285 break;
5286 case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
5287 omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
5288 break;
5289 case ST_OMP_PARALLEL_MASTER_TASKLOOP:
5290 omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
5291 break;
5292 case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
5293 omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
5294 break;
5295 case ST_OMP_TEAMS_DISTRIBUTE:
5296 omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
5297 break;
5298 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
5299 omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
5300 break;
5301 case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
5302 omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
5303 break;
5304 case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
5305 omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
5306 break;
5307 case ST_OMP_TEAMS_LOOP:
5308 omp_end_st = ST_OMP_END_TEAMS_LOOP;
5309 break;
5310 default: gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5310, __FUNCTION__));
5311 }
5312 if (st == omp_end_st)
5313 {
5314 if (new_st.op == EXEC_OMP_END_NOWAIT)
5315 {
5316 if (cp->ext.omp_clauses->nowait && new_st.ext.omp_bool)
5317 gfc_error_now ("Duplicated NOWAIT clause on %s and %s at %C",
5318 gfc_ascii_statement (omp_st),
5319 gfc_ascii_statement (omp_end_st));
5320 cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
5321 }
5322 else
5323 gcc_assert (new_st.op == EXEC_NOP)((void)(!(new_st.op == EXEC_NOP) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5323, __FUNCTION__), 0 : 0));
5324 gfc_clear_new_st ();
5325 gfc_commit_symbols ();
5326 gfc_warning_check ();
5327 st = next_statement ();
5328 }
5329 return st;
5330}
5331
5332
5333/* Parse the statements of OpenMP atomic directive. */
5334
5335static gfc_statement
5336parse_omp_oacc_atomic (bool omp_p)
5337{
5338 gfc_statement st, st_atomic, st_end_atomic;
5339 gfc_code *cp, *np;
5340 gfc_state_data s;
5341 int count;
5342
5343 if (omp_p)
5344 {
5345 st_atomic = ST_OMP_ATOMIC;
5346 st_end_atomic = ST_OMP_END_ATOMIC;
5347 }
5348 else
5349 {
5350 st_atomic = ST_OACC_ATOMIC;
5351 st_end_atomic = ST_OACC_END_ATOMIC;
5352 }
5353 accept_statement (st_atomic);
5354
5355 cp = gfc_state_stack->tail;
5356 push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL__null);
5357 np = new_level (cp);
5358 np->op = cp->op;
5359 np->block = NULL__null;
5360 np->ext.omp_clauses = cp->ext.omp_clauses;
5361 cp->ext.omp_clauses = NULL__null;
5362 count = 1 + np->ext.omp_clauses->capture;
5363
5364 while (count)
5365 {
5366 st = next_statement ();
5367 if (st == ST_NONE)
5368 unexpected_eof ();
5369 else if (np->ext.omp_clauses->compare
5370 && (st == ST_SIMPLE_IF || st == ST_IF_BLOCK))
5371 {
5372 count--;
5373 if (st == ST_IF_BLOCK)
5374 {
5375 parse_if_block ();
5376 /* With else (or elseif). */
5377 if (gfc_state_stack->tail->block->block)
5378 count--;
5379 }
5380 accept_statement (st);
5381 }
5382 else if (st == ST_ASSIGNMENT
5383 && (!np->ext.omp_clauses->compare
5384 || np->ext.omp_clauses->capture))
5385 {
5386 accept_statement (st);
5387 count--;
5388 }
5389 else
5390 unexpected_statement (st);
5391 }
5392
5393 pop_state ();
5394
5395 st = next_statement ();
5396 if (st == st_end_atomic)
5397 {
5398 gfc_clear_new_st ();
5399 gfc_commit_symbols ();
5400 gfc_warning_check ();
5401 st = next_statement ();
5402 }
5403 return st;
5404}
5405
5406
5407/* Parse the statements of an OpenACC structured block. */
5408
5409static void
5410parse_oacc_structured_block (gfc_statement acc_st)
5411{
5412 gfc_statement st, acc_end_st;
5413 gfc_code *cp, *np;
5414 gfc_state_data s, *sd;
5415
5416 for (sd = gfc_state_stack; sd; sd = sd->previous)
5417 if (sd->state == COMP_CRITICAL)
5418 gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
5419
5420 accept_statement (acc_st);
5421
5422 cp = gfc_state_stack->tail;
5423 push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL__null);
5424 np = new_level (cp);
5425 np->op = cp->op;
5426 np->block = NULL__null;
5427 switch (acc_st)
5428 {
5429 case ST_OACC_PARALLEL:
5430 acc_end_st = ST_OACC_END_PARALLEL;
5431 break;
5432 case ST_OACC_KERNELS:
5433 acc_end_st = ST_OACC_END_KERNELS;
5434 break;
5435 case ST_OACC_SERIAL:
5436 acc_end_st = ST_OACC_END_SERIAL;
5437 break;
5438 case ST_OACC_DATA:
5439 acc_end_st = ST_OACC_END_DATA;
5440 break;
5441 case ST_OACC_HOST_DATA:
5442 acc_end_st = ST_OACC_END_HOST_DATA;
5443 break;
5444 default:
5445 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5445, __FUNCTION__));
5446 }
5447
5448 do
5449 {
5450 st = parse_executable (ST_NONE);
5451 if (st == ST_NONE)
5452 unexpected_eof ();
5453 else if (st != acc_end_st)
5454 {
5455 gfc_error ("Expecting %s at %C", gfc_ascii_statement (acc_end_st));
5456 reject_statement ();
5457 }
5458 }
5459 while (st != acc_end_st);
5460
5461 gcc_assert (new_st.op == EXEC_NOP)((void)(!(new_st.op == EXEC_NOP) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5461, __FUNCTION__), 0 : 0));
5462
5463 gfc_clear_new_st ();
5464 gfc_commit_symbols ();
5465 gfc_warning_check ();
5466 pop_state ();
5467}
5468
5469/* Parse the statements of OpenACC 'loop', or combined compute 'loop'. */
5470
5471static gfc_statement
5472parse_oacc_loop (gfc_statement acc_st)
5473{
5474 gfc_statement st;
5475 gfc_code *cp, *np;
5476 gfc_state_data s, *sd;
5477
5478 for (sd = gfc_state_stack; sd; sd = sd->previous)
5479 if (sd->state == COMP_CRITICAL)
5480 gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
5481
5482 accept_statement (acc_st);
5483
5484 cp = gfc_state_stack->tail;
5485 push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL__null);
5486 np = new_level (cp);
5487 np->op = cp->op;
5488 np->block = NULL__null;
5489
5490 for (;;)
5491 {
5492 st = next_statement ();
5493 if (st == ST_NONE)
5494 unexpected_eof ();
5495 else if (st == ST_DO)
5496 break;
5497 else
5498 {
5499 gfc_error ("Expected DO loop at %C");
5500 reject_statement ();
5501 }
5502 }
5503
5504 parse_do_block ();
5505 if (gfc_statement_label != NULL__null
5506 && gfc_state_stack->previous != NULL__null
5507 && gfc_state_stack->previous->state == COMP_DO
5508 && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
5509 {
5510 pop_state ();
5511 return ST_IMPLIED_ENDDO;
5512 }
5513
5514 check_do_closure ();
5515 pop_state ();
5516
5517 st = next_statement ();
5518 if (st == ST_OACC_END_LOOP)
5519 gfc_warning (0, "Redundant !$ACC END LOOP at %C");
5520 if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
5521 (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) ||
5522 (acc_st == ST_OACC_SERIAL_LOOP && st == ST_OACC_END_SERIAL_LOOP) ||
5523 (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP))
5524 {
5525 gcc_assert (new_st.op == EXEC_NOP)((void)(!(new_st.op == EXEC_NOP) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5525, __FUNCTION__), 0 : 0));
5526 gfc_clear_new_st ();
5527 gfc_commit_symbols ();
5528 gfc_warning_check ();
5529 st = next_statement ();
5530 }
5531 return st;
5532}
5533
5534
5535/* Parse the statements of an OpenMP structured block. */
5536
5537static gfc_statement
5538parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
5539{
5540 gfc_statement st, omp_end_st;
5541 gfc_code *cp, *np;
5542 gfc_state_data s;
5543
5544 accept_statement (omp_st);
5545
5546 cp = gfc_state_stack->tail;
5547 push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL__null);
5548 np = new_level (cp);
5549 np->op = cp->op;
5550 np->block = NULL__null;
5551
5552 switch (omp_st)
5553 {
5554 case ST_OMP_ASSUME:
5555 omp_end_st = ST_OMP_END_ASSUME;
5556 break;
5557 case ST_OMP_PARALLEL:
5558 omp_end_st = ST_OMP_END_PARALLEL;
5559 break;
5560 case ST_OMP_PARALLEL_MASKED:
5561 omp_end_st = ST_OMP_END_PARALLEL_MASKED;
5562 break;
5563 case ST_OMP_PARALLEL_MASTER:
5564 omp_end_st = ST_OMP_END_PARALLEL_MASTER;
5565 break;
5566 case ST_OMP_PARALLEL_SECTIONS:
5567 omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
5568 break;
5569 case ST_OMP_SCOPE:
5570 omp_end_st = ST_OMP_END_SCOPE;
5571 break;
5572 case ST_OMP_SECTIONS:
5573 omp_end_st = ST_OMP_END_SECTIONS;
5574 break;
5575 case ST_OMP_ORDERED:
5576 omp_end_st = ST_OMP_END_ORDERED;
5577 break;
5578 case ST_OMP_CRITICAL:
5579 omp_end_st = ST_OMP_END_CRITICAL;
5580 break;
5581 case ST_OMP_MASKED:
5582 omp_end_st = ST_OMP_END_MASKED;
5583 break;
5584 case ST_OMP_MASTER:
5585 omp_end_st = ST_OMP_END_MASTER;
5586 break;
5587 case ST_OMP_SINGLE:
5588 omp_end_st = ST_OMP_END_SINGLE;
5589 break;
5590 case ST_OMP_TARGET:
5591 omp_end_st = ST_OMP_END_TARGET;
5592 break;
5593 case ST_OMP_TARGET_DATA:
5594 omp_end_st = ST_OMP_END_TARGET_DATA;
5595 break;
5596 case ST_OMP_TARGET_PARALLEL:
5597 omp_end_st = ST_OMP_END_TARGET_PARALLEL;
5598 break;
5599 case ST_OMP_TARGET_TEAMS:
5600 omp_end_st = ST_OMP_END_TARGET_TEAMS;
5601 break;
5602 case ST_OMP_TASK:
5603 omp_end_st = ST_OMP_END_TASK;
5604 break;
5605 case ST_OMP_TASKGROUP:
5606 omp_end_st = ST_OMP_END_TASKGROUP;
5607 break;
5608 case ST_OMP_TEAMS:
5609 omp_end_st = ST_OMP_END_TEAMS;
5610 break;
5611 case ST_OMP_TEAMS_DISTRIBUTE:
5612 omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
5613 break;
5614 case ST_OMP_DISTRIBUTE:
5615 omp_end_st = ST_OMP_END_DISTRIBUTE;
5616 break;
5617 case ST_OMP_WORKSHARE:
5618 omp_end_st = ST_OMP_END_WORKSHARE;
5619 break;
5620 case ST_OMP_PARALLEL_WORKSHARE:
5621 omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
5622 break;
5623 default:
5624 gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/parse.cc"
, 5624, __FUNCTION__));
5625 }
5626
5627 bool block_construct = false;
5628 gfc_namespace *my_ns = NULL__null;
5629 gfc_namespace *my_parent = NULL__null;
5630
5631 st = next_statement ();
5632
5633 if (st == ST_BLOCK)
5634 {
5635 /* Adjust state to a strictly-structured block, now that we found that
5636 the body starts with a BLOCK construct. */
5637 s.state = COMP_OMP_STRICTLY_STRUCTURED_BLOCK;
5638
5639 block_construct = true;
5640 gfc_notify_std (GFC_STD_F2008(1<<7), "BLOCK construct at %C");
5641
5642 my_ns = gfc_build_block_ns (gfc_current_ns);
5643 gfc_current_ns = my_ns;
5644 my_parent = my_ns->parent;
5645
5646 new_st.op = EXEC_BLOCK;
5647 new_st.ext.block.ns = my_ns;
5648 new_st.ext.block.assoc = NULL__null;
5649 accept_statement (ST_BLOCK);
5650 st = parse_spec (ST_NONE);
5651 }
5652
5653 do
5654 {
5655 if (workshare_stmts_only)
5656 {
5657 /* Inside of !$omp workshare, only
5658 scalar assignments
5659 array assignments
5660 where statements and constructs
5661 forall statements and constructs
5662 !$omp atomic
5663 !$omp critical
5664 !$omp parallel
5665 are allowed. For !$omp critical these
5666 restrictions apply recursively. */
5667 bool cycle = true;
5668
5669 for (;;)
5670 {