LCOV - code coverage report
Current view: top level - gcc/fortran - openmp.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 93.1 % 6294 5862
Test Date: 2023-09-09 13:19:57 Functions: 97.5 % 202 197
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* OpenMP directive matching and resolving.
       2                 :             :    Copyright (C) 2005-2023 Free Software Foundation, Inc.
       3                 :             :    Contributed by Jakub Jelinek
       4                 :             : 
       5                 :             : This file is part of GCC.
       6                 :             : 
       7                 :             : GCC is free software; you can redistribute it and/or modify it under
       8                 :             : the terms of the GNU General Public License as published by the Free
       9                 :             : Software Foundation; either version 3, or (at your option) any later
      10                 :             : version.
      11                 :             : 
      12                 :             : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
      13                 :             : WARRANTY; without even the implied warranty of MERCHANTABILITY or
      14                 :             : FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
      15                 :             : for more details.
      16                 :             : 
      17                 :             : You should have received a copy of the GNU General Public License
      18                 :             : along 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 "gfortran.h"
      25                 :             : #include "arith.h"
      26                 :             : #include "match.h"
      27                 :             : #include "parse.h"
      28                 :             : #include "constructor.h"
      29                 :             : #include "diagnostic.h"
      30                 :             : #include "gomp-constants.h"
      31                 :             : #include "target-memory.h"  /* For gfc_encode_character.  */
      32                 :             : #include "bitmap.h"
      33                 :             : #include "omp-api.h"  /* For omp_runtime_api_procname.  */
      34                 :             : 
      35                 :             : 
      36                 :             : static gfc_statement omp_code_to_statement (gfc_code *);
      37                 :             : 
      38                 :             : enum gfc_omp_directive_kind {
      39                 :             :   GFC_OMP_DIR_DECLARATIVE,
      40                 :             :   GFC_OMP_DIR_EXECUTABLE,
      41                 :             :   GFC_OMP_DIR_INFORMATIONAL,
      42                 :             :   GFC_OMP_DIR_META,
      43                 :             :   GFC_OMP_DIR_SUBSIDIARY,
      44                 :             :   GFC_OMP_DIR_UTILITY
      45                 :             : };
      46                 :             : 
      47                 :             : struct gfc_omp_directive {
      48                 :             :   const char *name;
      49                 :             :   enum gfc_omp_directive_kind kind;
      50                 :             :   gfc_statement st;
      51                 :             : };
      52                 :             : 
      53                 :             : /* Alphabetically sorted OpenMP clauses, except that longer strings are before
      54                 :             :    substrings; excludes combined/composite directives. See note for "ordered"
      55                 :             :    and "nothing".  */
      56                 :             : 
      57                 :             : static const struct gfc_omp_directive gfc_omp_directives[] = {
      58                 :             :   {"allocate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_ALLOCATE},
      59                 :             :   {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS},
      60                 :             :   {"assumes", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUMES},
      61                 :             :   {"assume", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUME},
      62                 :             :   {"atomic", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ATOMIC},
      63                 :             :   {"barrier", GFC_OMP_DIR_EXECUTABLE, ST_OMP_BARRIER},
      64                 :             :   {"cancellation point", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CANCELLATION_POINT},
      65                 :             :   {"cancel", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CANCEL},
      66                 :             :   {"critical", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CRITICAL},
      67                 :             :   /* {"declare mapper", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_MAPPER}, */
      68                 :             :   {"declare reduction", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_REDUCTION},
      69                 :             :   {"declare simd", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_SIMD},
      70                 :             :   {"declare target", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_TARGET},
      71                 :             :   {"declare variant", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_VARIANT},
      72                 :             :   {"depobj", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DEPOBJ},
      73                 :             :   /* {"dispatch", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DISPATCH}, */
      74                 :             :   {"distribute", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DISTRIBUTE},
      75                 :             :   {"do", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DO},
      76                 :             :   /* "error" becomes GFC_OMP_DIR_EXECUTABLE with at(execution) */
      77                 :             :   {"error", GFC_OMP_DIR_UTILITY, ST_OMP_ERROR},
      78                 :             :   {"flush", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSH},
      79                 :             :   /* {"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP}, */
      80                 :             :   {"loop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_LOOP},
      81                 :             :   {"masked", GFC_OMP_DIR_EXECUTABLE, ST_OMP_MASKED},
      82                 :             :   /* {"metadirective", GFC_OMP_DIR_META, ST_OMP_METADIRECTIVE}, */
      83                 :             :   /* Note: gfc_match_omp_nothing returns ST_NONE.  */
      84                 :             :   {"nothing", GFC_OMP_DIR_UTILITY, ST_OMP_NOTHING},
      85                 :             :   /* Special case; for now map to the first one.
      86                 :             :      ordered-blockassoc = ST_OMP_ORDERED
      87                 :             :      ordered-standalone = ST_OMP_ORDERED_DEPEND + depend/doacross.  */
      88                 :             :   {"ordered", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ORDERED},
      89                 :             :   {"parallel", GFC_OMP_DIR_EXECUTABLE, ST_OMP_PARALLEL},
      90                 :             :   {"requires", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_REQUIRES},
      91                 :             :   {"scan", GFC_OMP_DIR_SUBSIDIARY, ST_OMP_SCAN},
      92                 :             :   {"scope", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SCOPE},
      93                 :             :   {"sections", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SECTIONS},
      94                 :             :   {"section", GFC_OMP_DIR_SUBSIDIARY, ST_OMP_SECTION},
      95                 :             :   {"simd", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SIMD},
      96                 :             :   {"single", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SINGLE},
      97                 :             :   {"target data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_DATA},
      98                 :             :   {"target enter data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_ENTER_DATA},
      99                 :             :   {"target exit data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_EXIT_DATA},
     100                 :             :   {"target update", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_UPDATE},
     101                 :             :   {"target", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET},
     102                 :             :   {"taskloop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKLOOP},
     103                 :             :   {"taskwait", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKWAIT},
     104                 :             :   {"taskyield", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKYIELD},
     105                 :             :   {"task", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASK},
     106                 :             :   {"teams", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TEAMS},
     107                 :             :   {"threadprivate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_THREADPRIVATE},
     108                 :             :   /* {"tile", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TILE}, */
     109                 :             :   /* {"unroll", GFC_OMP_DIR_EXECUTABLE, ST_OMP_UNROLL}, */
     110                 :             :   {"workshare", GFC_OMP_DIR_EXECUTABLE, ST_OMP_WORKSHARE},
     111                 :             : };
     112                 :             : 
     113                 :             : 
     114                 :             : /* Match an end of OpenMP directive.  End of OpenMP directive is optional
     115                 :             :    whitespace, followed by '\n' or comment '!'.  */
     116                 :             : 
     117                 :             : static match
     118                 :       48142 : gfc_match_omp_eos (void)
     119                 :             : {
     120                 :       48142 :   locus old_loc;
     121                 :       48142 :   char c;
     122                 :             : 
     123                 :       48142 :   old_loc = gfc_current_locus;
     124                 :       48142 :   gfc_gobble_whitespace ();
     125                 :             : 
     126                 :       48142 :   c = gfc_next_ascii_char ();
     127                 :       48142 :   switch (c)
     128                 :             :     {
     129                 :           0 :     case '!':
     130                 :           0 :       do
     131                 :           0 :         c = gfc_next_ascii_char ();
     132                 :           0 :       while (c != '\n');
     133                 :             :       /* Fall through */
     134                 :             : 
     135                 :             :     case '\n':
     136                 :             :       return MATCH_YES;
     137                 :             :     }
     138                 :             : 
     139                 :        1293 :   gfc_current_locus = old_loc;
     140                 :        1293 :   return MATCH_NO;
     141                 :             : }
     142                 :             : 
     143                 :             : match
     144                 :       12153 : gfc_match_omp_eos_error (void)
     145                 :             : {
     146                 :       12153 :   if (gfc_match_omp_eos() == MATCH_YES)
     147                 :             :     return MATCH_YES;
     148                 :             : 
     149                 :          35 :   gfc_error ("Unexpected junk at %C");
     150                 :          35 :   return MATCH_ERROR;
     151                 :             : }
     152                 :             : 
     153                 :             : 
     154                 :             : /* Free an omp_clauses structure.  */
     155                 :             : 
     156                 :             : void
     157                 :       53935 : gfc_free_omp_clauses (gfc_omp_clauses *c)
     158                 :             : {
     159                 :       53935 :   int i;
     160                 :       53935 :   if (c == NULL)
     161                 :             :     return;
     162                 :             : 
     163                 :       30299 :   gfc_free_expr (c->if_expr);
     164                 :       30299 :   gfc_free_expr (c->final_expr);
     165                 :       30299 :   gfc_free_expr (c->num_threads);
     166                 :       30299 :   gfc_free_expr (c->chunk_size);
     167                 :       30299 :   gfc_free_expr (c->safelen_expr);
     168                 :       30299 :   gfc_free_expr (c->simdlen_expr);
     169                 :       30299 :   gfc_free_expr (c->num_teams_lower);
     170                 :       30299 :   gfc_free_expr (c->num_teams_upper);
     171                 :       30299 :   gfc_free_expr (c->device);
     172                 :       30299 :   gfc_free_expr (c->thread_limit);
     173                 :       30299 :   gfc_free_expr (c->dist_chunk_size);
     174                 :       30299 :   gfc_free_expr (c->grainsize);
     175                 :       30299 :   gfc_free_expr (c->hint);
     176                 :       30299 :   gfc_free_expr (c->num_tasks);
     177                 :       30299 :   gfc_free_expr (c->priority);
     178                 :       30299 :   gfc_free_expr (c->detach);
     179                 :      363588 :   for (i = 0; i < OMP_IF_LAST; i++)
     180                 :      302990 :     gfc_free_expr (c->if_exprs[i]);
     181                 :       30299 :   gfc_free_expr (c->async_expr);
     182                 :       30299 :   gfc_free_expr (c->gang_num_expr);
     183                 :       30299 :   gfc_free_expr (c->gang_static_expr);
     184                 :       30299 :   gfc_free_expr (c->worker_expr);
     185                 :       30299 :   gfc_free_expr (c->vector_expr);
     186                 :       30299 :   gfc_free_expr (c->num_gangs_expr);
     187                 :       30299 :   gfc_free_expr (c->num_workers_expr);
     188                 :       30299 :   gfc_free_expr (c->vector_length_expr);
     189                 :     1060465 :   for (i = 0; i < OMP_LIST_NUM; i++)
     190                 :      999867 :     gfc_free_omp_namelist (c->lists[i],
     191                 :      999867 :                            i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
     192                 :             :                            i == OMP_LIST_ALLOCATE,
     193                 :             :                            i == OMP_LIST_USES_ALLOCATORS);
     194                 :       30299 :   gfc_free_expr_list (c->wait_list);
     195                 :       30299 :   gfc_free_expr_list (c->tile_list);
     196                 :       30299 :   free (CONST_CAST (char *, c->critical_name));
     197                 :       30299 :   if (c->assume)
     198                 :             :     {
     199                 :          18 :       free (c->assume->absent);
     200                 :          18 :       free (c->assume->contains);
     201                 :          18 :       gfc_free_expr_list (c->assume->holds);
     202                 :          18 :       free (c->assume);
     203                 :             :     }
     204                 :       30299 :   free (c);
     205                 :             : }
     206                 :             : 
     207                 :             : /* Free oacc_declare structures.  */
     208                 :             : 
     209                 :             : void
     210                 :          71 : gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc)
     211                 :             : {
     212                 :          71 :   struct gfc_oacc_declare *decl = oc;
     213                 :             : 
     214                 :          71 :   do
     215                 :             :     {
     216                 :          71 :       struct gfc_oacc_declare *next;
     217                 :             : 
     218                 :          71 :       next = decl->next;
     219                 :          71 :       gfc_free_omp_clauses (decl->clauses);
     220                 :          71 :       free (decl);
     221                 :          71 :       decl = next;
     222                 :             :     }
     223                 :          71 :   while (decl);
     224                 :          71 : }
     225                 :             : 
     226                 :             : /* Free expression list. */
     227                 :             : void
     228                 :       60656 : gfc_free_expr_list (gfc_expr_list *list)
     229                 :             : {
     230                 :       60656 :   gfc_expr_list *n;
     231                 :             : 
     232                 :       61301 :   for (; list; list = n)
     233                 :             :     {
     234                 :         645 :       n = list->next;
     235                 :         645 :       free (list);
     236                 :             :     }
     237                 :       60656 : }
     238                 :             : 
     239                 :             : /* Free an !$omp declare simd construct list.  */
     240                 :             : 
     241                 :             : void
     242                 :         219 : gfc_free_omp_declare_simd (gfc_omp_declare_simd *ods)
     243                 :             : {
     244                 :         219 :   if (ods)
     245                 :             :     {
     246                 :         219 :       gfc_free_omp_clauses (ods->clauses);
     247                 :         219 :       free (ods);
     248                 :             :     }
     249                 :         219 : }
     250                 :             : 
     251                 :             : void
     252                 :      414316 : gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list)
     253                 :             : {
     254                 :      414535 :   while (list)
     255                 :             :     {
     256                 :         219 :       gfc_omp_declare_simd *current = list;
     257                 :         219 :       list = list->next;
     258                 :         219 :       gfc_free_omp_declare_simd (current);
     259                 :             :     }
     260                 :      414316 : }
     261                 :             : 
     262                 :             : static void
     263                 :         410 : gfc_free_omp_trait_property_list (gfc_omp_trait_property *list)
     264                 :             : {
     265                 :         670 :   while (list)
     266                 :             :     {
     267                 :         260 :       gfc_omp_trait_property *current = list;
     268                 :         260 :       list = list->next;
     269                 :         260 :       switch (current->property_kind)
     270                 :             :         {
     271                 :          23 :         case CTX_PROPERTY_ID:
     272                 :          23 :           free (current->name);
     273                 :          23 :           break;
     274                 :         185 :         case CTX_PROPERTY_NAME_LIST:
     275                 :         185 :           if (current->is_name)
     276                 :         138 :             free (current->name);
     277                 :             :           break;
     278                 :          15 :         case CTX_PROPERTY_SIMD:
     279                 :          15 :           gfc_free_omp_clauses (current->clauses);
     280                 :          15 :           break;
     281                 :             :         default:
     282                 :             :           break;
     283                 :             :         }
     284                 :         260 :       free (current);
     285                 :             :     }
     286                 :         410 : }
     287                 :             : 
     288                 :             : static void
     289                 :         320 : gfc_free_omp_selector_list (gfc_omp_selector *list)
     290                 :             : {
     291                 :         730 :   while (list)
     292                 :             :     {
     293                 :         410 :       gfc_omp_selector *current = list;
     294                 :         410 :       list = list->next;
     295                 :         410 :       gfc_free_omp_trait_property_list (current->properties);
     296                 :         410 :       free (current);
     297                 :             :     }
     298                 :         320 : }
     299                 :             : 
     300                 :             : static void
     301                 :         288 : gfc_free_omp_set_selector_list (gfc_omp_set_selector *list)
     302                 :             : {
     303                 :         608 :   while (list)
     304                 :             :     {
     305                 :         320 :       gfc_omp_set_selector *current = list;
     306                 :         320 :       list = list->next;
     307                 :         320 :       gfc_free_omp_selector_list (current->trait_selectors);
     308                 :         320 :       free (current);
     309                 :             :     }
     310                 :         288 : }
     311                 :             : 
     312                 :             : /* Free an !$omp declare variant construct list.  */
     313                 :             : 
     314                 :             : void
     315                 :      414316 : gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list)
     316                 :             : {
     317                 :      414604 :   while (list)
     318                 :             :     {
     319                 :         288 :       gfc_omp_declare_variant *current = list;
     320                 :         288 :       list = list->next;
     321                 :         288 :       gfc_free_omp_set_selector_list (current->set_selectors);
     322                 :         288 :       free (current);
     323                 :             :     }
     324                 :      414316 : }
     325                 :             : 
     326                 :             : /* Free an !$omp declare reduction.  */
     327                 :             : 
     328                 :             : void
     329                 :        1118 : gfc_free_omp_udr (gfc_omp_udr *omp_udr)
     330                 :             : {
     331                 :        1118 :   if (omp_udr)
     332                 :             :     {
     333                 :         607 :       gfc_free_omp_udr (omp_udr->next);
     334                 :         607 :       gfc_free_namespace (omp_udr->combiner_ns);
     335                 :         607 :       if (omp_udr->initializer_ns)
     336                 :         377 :         gfc_free_namespace (omp_udr->initializer_ns);
     337                 :         607 :       free (omp_udr);
     338                 :             :     }
     339                 :        1118 : }
     340                 :             : 
     341                 :             : 
     342                 :             : static gfc_omp_udr *
     343                 :        4338 : gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
     344                 :             : {
     345                 :        4338 :   gfc_symtree *st;
     346                 :             : 
     347                 :        4338 :   if (ns == NULL)
     348                 :         467 :     ns = gfc_current_ns;
     349                 :        5188 :   do
     350                 :             :     {
     351                 :        5188 :       gfc_omp_udr *omp_udr;
     352                 :             : 
     353                 :        5188 :       st = gfc_find_symtree (ns->omp_udr_root, name);
     354                 :        5188 :       if (st != NULL)
     355                 :             :         {
     356                 :         934 :           for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
     357                 :         934 :             if (ts == NULL)
     358                 :         367 :               return omp_udr;
     359                 :         567 :             else if (gfc_compare_types (&omp_udr->ts, ts))
     360                 :             :               {
     361                 :         479 :                 if (ts->type == BT_CHARACTER)
     362                 :             :                   {
     363                 :          60 :                     if (omp_udr->ts.u.cl->length == NULL)
     364                 :          24 :                       return omp_udr;
     365                 :          36 :                     if (ts->u.cl->length == NULL)
     366                 :           0 :                       continue;
     367                 :          36 :                     if (gfc_compare_expr (omp_udr->ts.u.cl->length,
     368                 :             :                                           ts->u.cl->length,
     369                 :             :                                           INTRINSIC_EQ) != 0)
     370                 :          12 :                       continue;
     371                 :             :                   }
     372                 :         443 :                 return omp_udr;
     373                 :             :               }
     374                 :             :         }
     375                 :             : 
     376                 :             :       /* Don't escape an interface block.  */
     377                 :        4354 :       if (ns && !ns->has_import_set
     378                 :        4354 :           && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY)
     379                 :             :         break;
     380                 :             : 
     381                 :        4354 :       ns = ns->parent;
     382                 :             :     }
     383                 :        4354 :   while (ns != NULL);
     384                 :             : 
     385                 :             :   return NULL;
     386                 :             : }
     387                 :             : 
     388                 :             : 
     389                 :             : /* Match a variable/common block list and construct a namelist from it;
     390                 :             :    if has_all_memory != NULL, *has_all_memory is set and omp_all_memory
     391                 :             :    yields a list->sym NULL entry. */
     392                 :             : 
     393                 :             : static match
     394                 :       27679 : gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
     395                 :             :                              bool allow_common, bool *end_colon = NULL,
     396                 :             :                              gfc_omp_namelist ***headp = NULL,
     397                 :             :                              bool allow_sections = false,
     398                 :             :                              bool allow_derived = false,
     399                 :             :                              bool *has_all_memory = NULL,
     400                 :             :                              bool reject_common_vars = false)
     401                 :             : {
     402                 :       27679 :   gfc_omp_namelist *head, *tail, *p;
     403                 :       27679 :   locus old_loc, cur_loc;
     404                 :       27679 :   char n[GFC_MAX_SYMBOL_LEN+1];
     405                 :       27679 :   gfc_symbol *sym;
     406                 :       27679 :   match m;
     407                 :       27679 :   gfc_symtree *st;
     408                 :             : 
     409                 :       27679 :   head = tail = NULL;
     410                 :             : 
     411                 :       27679 :   old_loc = gfc_current_locus;
     412                 :       27679 :   if (has_all_memory)
     413                 :         683 :     *has_all_memory = false;
     414                 :       27679 :   m = gfc_match (str);
     415                 :       27679 :   if (m != MATCH_YES)
     416                 :             :     return m;
     417                 :             : 
     418                 :       33263 :   for (;;)
     419                 :             :     {
     420                 :       33263 :       cur_loc = gfc_current_locus;
     421                 :             : 
     422                 :       33263 :       m = gfc_match_name (n);
     423                 :       33263 :       if (m == MATCH_YES && strcmp (n, "omp_all_memory") == 0)
     424                 :             :         {
     425                 :          23 :           if (!has_all_memory)
     426                 :             :             {
     427                 :           2 :               gfc_error ("%<omp_all_memory%> at %C not permitted in this "
     428                 :             :                          "clause");
     429                 :           2 :               goto cleanup;
     430                 :             :             }
     431                 :          21 :           *has_all_memory = true;
     432                 :          21 :           p = gfc_get_omp_namelist ();
     433                 :          21 :           if (head == NULL)
     434                 :             :             head = tail = p;
     435                 :             :           else
     436                 :             :             {
     437                 :           3 :               tail->next = p;
     438                 :           3 :               tail = tail->next;
     439                 :             :             }
     440                 :          21 :           tail->where = cur_loc;
     441                 :          21 :           goto next_item;
     442                 :             :         }
     443                 :       33059 :       if (m == MATCH_YES)
     444                 :             :         {
     445                 :       33059 :           gfc_symtree *st;
     446                 :       33059 :           if ((m = gfc_get_ha_sym_tree (n, &st) ? MATCH_ERROR : MATCH_YES)
     447                 :             :               == MATCH_YES)
     448                 :       33059 :             sym = st->n.sym;
     449                 :             :         }
     450                 :       33240 :       switch (m)
     451                 :             :         {
     452                 :       33059 :         case MATCH_YES:
     453                 :       33059 :           gfc_expr *expr;
     454                 :       33059 :           expr = NULL;
     455                 :       33059 :           gfc_gobble_whitespace ();
     456                 :       19600 :           if ((allow_sections && gfc_peek_ascii_char () == '(')
     457                 :       49476 :               || (allow_derived && gfc_peek_ascii_char () == '%'))
     458                 :             :             {
     459                 :        4304 :               gfc_current_locus = cur_loc;
     460                 :        4304 :               m = gfc_match_variable (&expr, 0);
     461                 :        4304 :               switch (m)
     462                 :             :                 {
     463                 :           4 :                 case MATCH_ERROR:
     464                 :          11 :                   goto cleanup;
     465                 :           0 :                 case MATCH_NO:
     466                 :           0 :                   goto syntax;
     467                 :        4300 :                 default:
     468                 :        4300 :                   break;
     469                 :             :                 }
     470                 :        4300 :               if (gfc_is_coindexed (expr))
     471                 :             :                 {
     472                 :           5 :                   gfc_error ("List item shall not be coindexed at %C");
     473                 :           5 :                   goto cleanup;
     474                 :             :                 }
     475                 :             :             }
     476                 :       33050 :           gfc_set_sym_referenced (sym);
     477                 :       33050 :           p = gfc_get_omp_namelist ();
     478                 :       33050 :           if (head == NULL)
     479                 :             :             head = tail = p;
     480                 :             :           else
     481                 :             :             {
     482                 :        8975 :               tail->next = p;
     483                 :        8975 :               tail = tail->next;
     484                 :             :             }
     485                 :       33050 :           tail->sym = sym;
     486                 :       33050 :           tail->expr = expr;
     487                 :       33050 :           tail->where = cur_loc;
     488                 :       33050 :           if (reject_common_vars && sym->attr.in_common)
     489                 :             :             {
     490                 :           2 :               gcc_assert (allow_common);
     491                 :           2 :               gfc_error ("%qs at %L is part of the common block %</%s/%> and "
     492                 :             :                          "may only be specificed implicitly via the named "
     493                 :             :                          "common block", sym->name, &cur_loc,
     494                 :           2 :                          sym->common_head->name);
     495                 :           2 :               goto cleanup;
     496                 :             :             }
     497                 :       33048 :           goto next_item;
     498                 :         181 :         case MATCH_NO:
     499                 :         181 :           break;
     500                 :           0 :         case MATCH_ERROR:
     501                 :           0 :           goto cleanup;
     502                 :             :         }
     503                 :             : 
     504                 :         181 :       if (!allow_common)
     505                 :           8 :         goto syntax;
     506                 :             : 
     507                 :         173 :       m = gfc_match (" / %n /", n);
     508                 :         173 :       if (m == MATCH_ERROR)
     509                 :           0 :         goto cleanup;
     510                 :         173 :       if (m == MATCH_NO)
     511                 :          13 :         goto syntax;
     512                 :             : 
     513                 :         160 :       st = gfc_find_symtree (gfc_current_ns->common_root, n);
     514                 :         160 :       if (st == NULL)
     515                 :             :         {
     516                 :           2 :           gfc_error ("COMMON block /%s/ not found at %C", n);
     517                 :           2 :           goto cleanup;
     518                 :             :         }
     519                 :         569 :       for (sym = st->n.common->head; sym; sym = sym->common_next)
     520                 :             :         {
     521                 :         411 :           gfc_set_sym_referenced (sym);
     522                 :         411 :           p = gfc_get_omp_namelist ();
     523                 :         411 :           if (head == NULL)
     524                 :             :             head = tail = p;
     525                 :             :           else
     526                 :             :             {
     527                 :         294 :               tail->next = p;
     528                 :         294 :               tail = tail->next;
     529                 :             :             }
     530                 :         411 :           tail->sym = sym;
     531                 :         411 :           tail->where = cur_loc;
     532                 :             :         }
     533                 :             : 
     534                 :         158 :     next_item:
     535                 :       33227 :       if (end_colon && gfc_match_char (':') == MATCH_YES)
     536                 :             :         {
     537                 :         790 :           *end_colon = true;
     538                 :         790 :           break;
     539                 :             :         }
     540                 :       32437 :       if (gfc_match_char (')') == MATCH_YES)
     541                 :             :         break;
     542                 :        9032 :       if (gfc_match_char (',') != MATCH_YES)
     543                 :          13 :         goto syntax;
     544                 :             :     }
     545                 :             : 
     546                 :       30184 :   while (*list)
     547                 :        5989 :     list = &(*list)->next;
     548                 :             : 
     549                 :       24195 :   *list = head;
     550                 :       24195 :   if (headp)
     551                 :       19013 :     *headp = list;
     552                 :             :   return MATCH_YES;
     553                 :             : 
     554                 :          34 : syntax:
     555                 :          34 :   gfc_error ("Syntax error in OpenMP variable list at %C");
     556                 :             : 
     557                 :          49 : cleanup:
     558                 :          49 :   gfc_free_omp_namelist (head, false, false, false);
     559                 :          49 :   gfc_current_locus = old_loc;
     560                 :          49 :   return MATCH_ERROR;
     561                 :             : }
     562                 :             : 
     563                 :             : /* Match a variable/procedure/common block list and construct a namelist
     564                 :             :    from it.  */
     565                 :             : 
     566                 :             : static match
     567                 :         243 : gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
     568                 :             : {
     569                 :         243 :   gfc_omp_namelist *head, *tail, *p;
     570                 :         243 :   locus old_loc, cur_loc;
     571                 :         243 :   char n[GFC_MAX_SYMBOL_LEN+1];
     572                 :         243 :   gfc_symbol *sym;
     573                 :         243 :   match m;
     574                 :         243 :   gfc_symtree *st;
     575                 :             : 
     576                 :         243 :   head = tail = NULL;
     577                 :             : 
     578                 :         243 :   old_loc = gfc_current_locus;
     579                 :             : 
     580                 :         243 :   m = gfc_match (str);
     581                 :         243 :   if (m != MATCH_YES)
     582                 :             :     return m;
     583                 :             : 
     584                 :         427 :   for (;;)
     585                 :             :     {
     586                 :         427 :       cur_loc = gfc_current_locus;
     587                 :         427 :       m = gfc_match_symbol (&sym, 1);
     588                 :         427 :       switch (m)
     589                 :             :         {
     590                 :         402 :         case MATCH_YES:
     591                 :         402 :           p = gfc_get_omp_namelist ();
     592                 :         402 :           if (head == NULL)
     593                 :             :             head = tail = p;
     594                 :             :           else
     595                 :             :             {
     596                 :         181 :               tail->next = p;
     597                 :         181 :               tail = tail->next;
     598                 :             :             }
     599                 :         402 :           tail->sym = sym;
     600                 :         402 :           tail->where = cur_loc;
     601                 :         402 :           goto next_item;
     602                 :             :         case MATCH_NO:
     603                 :             :           break;
     604                 :           0 :         case MATCH_ERROR:
     605                 :           0 :           goto cleanup;
     606                 :             :         }
     607                 :             : 
     608                 :          25 :       m = gfc_match (" / %n /", n);
     609                 :          25 :       if (m == MATCH_ERROR)
     610                 :           0 :         goto cleanup;
     611                 :          25 :       if (m == MATCH_NO)
     612                 :           0 :         goto syntax;
     613                 :             : 
     614                 :          25 :       st = gfc_find_symtree (gfc_current_ns->common_root, n);
     615                 :          25 :       if (st == NULL)
     616                 :             :         {
     617                 :           0 :           gfc_error ("COMMON block /%s/ not found at %C", n);
     618                 :           0 :           goto cleanup;
     619                 :             :         }
     620                 :          25 :       p = gfc_get_omp_namelist ();
     621                 :          25 :       if (head == NULL)
     622                 :             :         head = tail = p;
     623                 :             :       else
     624                 :             :         {
     625                 :           3 :           tail->next = p;
     626                 :           3 :           tail = tail->next;
     627                 :             :         }
     628                 :          25 :       tail->u.common = st->n.common;
     629                 :          25 :       tail->where = cur_loc;
     630                 :             : 
     631                 :         427 :     next_item:
     632                 :         427 :       if (gfc_match_char (')') == MATCH_YES)
     633                 :             :         break;
     634                 :         184 :       if (gfc_match_char (',') != MATCH_YES)
     635                 :           0 :         goto syntax;
     636                 :             :     }
     637                 :             : 
     638                 :         254 :   while (*list)
     639                 :          11 :     list = &(*list)->next;
     640                 :             : 
     641                 :         243 :   *list = head;
     642                 :         243 :   return MATCH_YES;
     643                 :             : 
     644                 :           0 : syntax:
     645                 :           0 :   gfc_error ("Syntax error in OpenMP variable list at %C");
     646                 :             : 
     647                 :           0 : cleanup:
     648                 :           0 :   gfc_free_omp_namelist (head, false, false, false);
     649                 :           0 :   gfc_current_locus = old_loc;
     650                 :           0 :   return MATCH_ERROR;
     651                 :             : }
     652                 :             : 
     653                 :             : /* Match detach(event-handle).  */
     654                 :             : 
     655                 :             : static match
     656                 :         126 : gfc_match_omp_detach (gfc_expr **expr)
     657                 :             : {
     658                 :         126 :   locus old_loc = gfc_current_locus;
     659                 :             : 
     660                 :         126 :   if (gfc_match ("detach ( ") != MATCH_YES)
     661                 :           0 :     goto syntax_error;
     662                 :             : 
     663                 :         126 :   if (gfc_match_variable (expr, 0) != MATCH_YES)
     664                 :           0 :     goto syntax_error;
     665                 :             : 
     666                 :         126 :   if (gfc_match_char (')') != MATCH_YES)
     667                 :           0 :     goto syntax_error;
     668                 :             : 
     669                 :             :   return MATCH_YES;
     670                 :             : 
     671                 :           0 : syntax_error:
     672                 :           0 :    gfc_error ("Syntax error in OpenMP detach clause at %C");
     673                 :           0 :    gfc_current_locus = old_loc;
     674                 :           0 :    return MATCH_ERROR;
     675                 :             : 
     676                 :             : }
     677                 :             : 
     678                 :             : /* Match doacross(sink : ...) construct a namelist from it;
     679                 :             :    if depend is true, match legacy 'depend(sink : ...)'.  */
     680                 :             : 
     681                 :             : static match
     682                 :         240 : gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend)
     683                 :             : {
     684                 :         240 :   char n[GFC_MAX_SYMBOL_LEN+1];
     685                 :         240 :   gfc_omp_namelist *head, *tail, *p;
     686                 :         240 :   locus old_loc, cur_loc;
     687                 :         240 :   gfc_symbol *sym;
     688                 :             : 
     689                 :         240 :   head = tail = NULL;
     690                 :             : 
     691                 :         240 :   old_loc = gfc_current_locus;
     692                 :             : 
     693                 :        1235 :   for (;;)
     694                 :             :     {
     695                 :        1235 :       cur_loc = gfc_current_locus;
     696                 :             : 
     697                 :        1235 :       if (gfc_match_name (n) != MATCH_YES)
     698                 :           1 :         goto syntax;
     699                 :        1234 :       if (UNLIKELY (strcmp (n, "omp_all_memory") == 0))
     700                 :             :         {
     701                 :           1 :           gfc_error ("%<omp_all_memory%> used with dependence-type "
     702                 :             :                      "other than OUT or INOUT at %C");
     703                 :           1 :           goto cleanup;
     704                 :             :         }
     705                 :        1233 :       sym = NULL;
     706                 :        1233 :       if (!(strcmp (n, "omp_cur_iteration") == 0))
     707                 :             :         {
     708                 :        1228 :           gfc_symtree *st;
     709                 :        1228 :           if (gfc_get_ha_sym_tree (n, &st))
     710                 :           0 :             goto syntax;
     711                 :        1228 :           sym = st->n.sym;
     712                 :        1228 :           gfc_set_sym_referenced (sym);
     713                 :             :         }
     714                 :        1233 :       p = gfc_get_omp_namelist ();
     715                 :        1233 :       if (head == NULL)
     716                 :             :         {
     717                 :         238 :           head = tail = p;
     718                 :         252 :           head->u.depend_doacross_op = (depend ? OMP_DEPEND_SINK_FIRST
     719                 :             :                                                : OMP_DOACROSS_SINK_FIRST);
     720                 :             :         }
     721                 :             :       else
     722                 :             :         {
     723                 :         995 :           tail->next = p;
     724                 :         995 :           tail = tail->next;
     725                 :         995 :           tail->u.depend_doacross_op = OMP_DOACROSS_SINK;
     726                 :             :         }
     727                 :        1233 :       tail->sym = sym;
     728                 :        1233 :       tail->expr = NULL;
     729                 :        1233 :       tail->where = cur_loc;
     730                 :        1233 :       if (gfc_match_char ('+') == MATCH_YES)
     731                 :             :         {
     732                 :         154 :           if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
     733                 :           0 :             goto syntax;
     734                 :             :         }
     735                 :        1079 :       else if (gfc_match_char ('-') == MATCH_YES)
     736                 :             :         {
     737                 :         418 :           if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
     738                 :           1 :             goto syntax;
     739                 :         417 :           tail->expr = gfc_uminus (tail->expr);
     740                 :             :         }
     741                 :        1232 :       if (gfc_match_char (')') == MATCH_YES)
     742                 :             :         break;
     743                 :         995 :       if (gfc_match_char (',') != MATCH_YES)
     744                 :           0 :         goto syntax;
     745                 :             :     }
     746                 :             : 
     747                 :        1029 :   while (*list)
     748                 :         792 :     list = &(*list)->next;
     749                 :             : 
     750                 :         237 :   *list = head;
     751                 :         237 :   return MATCH_YES;
     752                 :             : 
     753                 :           2 : syntax:
     754                 :           2 :   gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
     755                 :             : 
     756                 :           3 : cleanup:
     757                 :           3 :   gfc_free_omp_namelist (head, false, false, false);
     758                 :           3 :   gfc_current_locus = old_loc;
     759                 :           3 :   return MATCH_ERROR;
     760                 :             : }
     761                 :             : 
     762                 :             : static match
     763                 :         574 : match_oacc_expr_list (const char *str, gfc_expr_list **list,
     764                 :             :                       bool allow_asterisk)
     765                 :             : {
     766                 :         574 :   gfc_expr_list *head, *tail, *p;
     767                 :         574 :   locus old_loc;
     768                 :         574 :   gfc_expr *expr;
     769                 :         574 :   match m;
     770                 :             : 
     771                 :         574 :   head = tail = NULL;
     772                 :             : 
     773                 :         574 :   old_loc = gfc_current_locus;
     774                 :             : 
     775                 :         574 :   m = gfc_match (str);
     776                 :         574 :   if (m != MATCH_YES)
     777                 :             :     return m;
     778                 :             : 
     779                 :         595 :   for (;;)
     780                 :             :     {
     781                 :         595 :       m = gfc_match_expr (&expr);
     782                 :         595 :       if (m == MATCH_YES || allow_asterisk)
     783                 :             :         {
     784                 :         589 :           p = gfc_get_expr_list ();
     785                 :         589 :           if (head == NULL)
     786                 :             :             head = tail = p;
     787                 :             :           else
     788                 :             :             {
     789                 :         144 :               tail->next = p;
     790                 :         144 :               tail = tail->next;
     791                 :             :             }
     792                 :         589 :           if (m == MATCH_YES)
     793                 :         473 :             tail->expr = expr;
     794                 :         116 :           else if (gfc_match (" *") != MATCH_YES)
     795                 :          16 :             goto syntax;
     796                 :         573 :           goto next_item;
     797                 :             :         }
     798                 :           6 :       if (m == MATCH_ERROR)
     799                 :           0 :         goto cleanup;
     800                 :           6 :       goto syntax;
     801                 :             : 
     802                 :         573 :     next_item:
     803                 :         573 :       if (gfc_match_char (')') == MATCH_YES)
     804                 :             :         break;
     805                 :         152 :       if (gfc_match_char (',') != MATCH_YES)
     806                 :           5 :         goto syntax;
     807                 :             :     }
     808                 :             : 
     809                 :         427 :   while (*list)
     810                 :           6 :     list = &(*list)->next;
     811                 :             : 
     812                 :         421 :   *list = head;
     813                 :         421 :   return MATCH_YES;
     814                 :             : 
     815                 :          27 : syntax:
     816                 :          27 :   gfc_error ("Syntax error in OpenACC expression list at %C");
     817                 :             : 
     818                 :          27 : cleanup:
     819                 :          27 :   gfc_free_expr_list (head);
     820                 :          27 :   gfc_current_locus = old_loc;
     821                 :          27 :   return MATCH_ERROR;
     822                 :             : }
     823                 :             : 
     824                 :             : static match
     825                 :        2877 : match_oacc_clause_gwv (gfc_omp_clauses *cp, unsigned gwv)
     826                 :             : {
     827                 :        2877 :   match ret = MATCH_YES;
     828                 :             : 
     829                 :        2877 :   if (gfc_match (" ( ") != MATCH_YES)
     830                 :             :     return MATCH_NO;
     831                 :             : 
     832                 :         449 :   if (gwv == GOMP_DIM_GANG)
     833                 :             :     {
     834                 :             :         /* The gang clause accepts two optional arguments, num and static.
     835                 :             :          The num argument may either be explicit (num: <val>) or
     836                 :             :          implicit without (<val> without num:).  */
     837                 :             : 
     838                 :         431 :       while (ret == MATCH_YES)
     839                 :             :         {
     840                 :         223 :           if (gfc_match (" static :") == MATCH_YES)
     841                 :             :             {
     842                 :         105 :               if (cp->gang_static)
     843                 :             :                 return MATCH_ERROR;
     844                 :             :               else
     845                 :         104 :                 cp->gang_static = true;
     846                 :         104 :               if (gfc_match_char ('*') == MATCH_YES)
     847                 :          15 :                 cp->gang_static_expr = NULL;
     848                 :          89 :               else if (gfc_match (" %e ", &cp->gang_static_expr) != MATCH_YES)
     849                 :             :                 return MATCH_ERROR;
     850                 :             :             }
     851                 :             :           else
     852                 :             :             {
     853                 :         118 :               if (cp->gang_num_expr)
     854                 :             :                 return MATCH_ERROR;
     855                 :             : 
     856                 :             :               /* The 'num' argument is optional.  */
     857                 :         117 :               gfc_match (" num :");
     858                 :             : 
     859                 :         117 :               if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES)
     860                 :             :                 return MATCH_ERROR;
     861                 :             :             }
     862                 :             : 
     863                 :         218 :           ret = gfc_match (" , ");
     864                 :             :         }
     865                 :             :     }
     866                 :         236 :   else if (gwv == GOMP_DIM_WORKER)
     867                 :             :     {
     868                 :             :       /* The 'num' argument is optional.  */
     869                 :         103 :       gfc_match (" num :");
     870                 :             : 
     871                 :         103 :       if (gfc_match (" %e ", &cp->worker_expr) != MATCH_YES)
     872                 :             :         return MATCH_ERROR;
     873                 :             :     }
     874                 :         133 :   else if (gwv == GOMP_DIM_VECTOR)
     875                 :             :     {
     876                 :             :       /* The 'length' argument is optional.  */
     877                 :         133 :       gfc_match (" length :");
     878                 :             : 
     879                 :         133 :       if (gfc_match (" %e ", &cp->vector_expr) != MATCH_YES)
     880                 :             :         return MATCH_ERROR;
     881                 :             :     }
     882                 :             :   else
     883                 :           0 :     gfc_fatal_error ("Unexpected OpenACC parallelism.");
     884                 :             : 
     885                 :         438 :   return gfc_match (" )");
     886                 :             : }
     887                 :             : 
     888                 :             : static match
     889                 :           8 : gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
     890                 :             : {
     891                 :           8 :   gfc_omp_namelist *head = NULL;
     892                 :           8 :   gfc_omp_namelist *tail, *p;
     893                 :           8 :   locus old_loc;
     894                 :           8 :   char n[GFC_MAX_SYMBOL_LEN+1];
     895                 :           8 :   gfc_symbol *sym;
     896                 :           8 :   match m;
     897                 :           8 :   gfc_symtree *st;
     898                 :             : 
     899                 :           8 :   old_loc = gfc_current_locus;
     900                 :             : 
     901                 :           8 :   m = gfc_match (str);
     902                 :           8 :   if (m != MATCH_YES)
     903                 :             :     return m;
     904                 :             : 
     905                 :           8 :   m = gfc_match (" (");
     906                 :             : 
     907                 :          14 :   for (;;)
     908                 :             :     {
     909                 :          14 :       m = gfc_match_symbol (&sym, 0);
     910                 :          14 :       switch (m)
     911                 :             :         {
     912                 :           8 :         case MATCH_YES:
     913                 :           8 :           if (sym->attr.in_common)
     914                 :             :             {
     915                 :           2 :               gfc_error_now ("Variable at %C is an element of a COMMON block");
     916                 :           2 :               goto cleanup;
     917                 :             :             }
     918                 :           6 :           gfc_set_sym_referenced (sym);
     919                 :           6 :           p = gfc_get_omp_namelist ();
     920                 :           6 :           if (head == NULL)
     921                 :             :             head = tail = p;
     922                 :             :           else
     923                 :             :             {
     924                 :           4 :               tail->next = p;
     925                 :           4 :               tail = tail->next;
     926                 :             :             }
     927                 :           6 :           tail->sym = sym;
     928                 :           6 :           tail->expr = NULL;
     929                 :           6 :           tail->where = gfc_current_locus;
     930                 :           6 :           goto next_item;
     931                 :             :         case MATCH_NO:
     932                 :             :           break;
     933                 :             : 
     934                 :           0 :         case MATCH_ERROR:
     935                 :           0 :           goto cleanup;
     936                 :             :         }
     937                 :             : 
     938                 :           6 :       m = gfc_match (" / %n /", n);
     939                 :           6 :       if (m == MATCH_ERROR)
     940                 :           0 :         goto cleanup;
     941                 :           6 :       if (m == MATCH_NO || n[0] == '\0')
     942                 :           0 :         goto syntax;
     943                 :             : 
     944                 :           6 :       st = gfc_find_symtree (gfc_current_ns->common_root, n);
     945                 :           6 :       if (st == NULL)
     946                 :             :         {
     947                 :           1 :           gfc_error ("COMMON block /%s/ not found at %C", n);
     948                 :           1 :           goto cleanup;
     949                 :             :         }
     950                 :             : 
     951                 :          20 :       for (sym = st->n.common->head; sym; sym = sym->common_next)
     952                 :             :         {
     953                 :          15 :           gfc_set_sym_referenced (sym);
     954                 :          15 :           p = gfc_get_omp_namelist ();
     955                 :          15 :           if (head == NULL)
     956                 :             :             head = tail = p;
     957                 :             :           else
     958                 :             :             {
     959                 :          12 :               tail->next = p;
     960                 :          12 :               tail = tail->next;
     961                 :             :             }
     962                 :          15 :           tail->sym = sym;
     963                 :          15 :           tail->where = gfc_current_locus;
     964                 :             :         }
     965                 :             : 
     966                 :           5 :     next_item:
     967                 :          11 :       if (gfc_match_char (')') == MATCH_YES)
     968                 :             :         break;
     969                 :           6 :       if (gfc_match_char (',') != MATCH_YES)
     970                 :           0 :         goto syntax;
     971                 :             :     }
     972                 :             : 
     973                 :           5 :   if (gfc_match_omp_eos () != MATCH_YES)
     974                 :             :     {
     975                 :           1 :       gfc_error ("Unexpected junk after !$ACC DECLARE at %C");
     976                 :           1 :       goto cleanup;
     977                 :             :     }
     978                 :             : 
     979                 :           4 :   while (*list)
     980                 :           0 :     list = &(*list)->next;
     981                 :           4 :   *list = head;
     982                 :           4 :   return MATCH_YES;
     983                 :             : 
     984                 :           0 : syntax:
     985                 :           0 :   gfc_error ("Syntax error in !$ACC DECLARE list at %C");
     986                 :             : 
     987                 :           4 : cleanup:
     988                 :           4 :   gfc_current_locus = old_loc;
     989                 :           4 :   return MATCH_ERROR;
     990                 :             : }
     991                 :             : 
     992                 :             : /* OpenMP clauses.  */
     993                 :             : enum omp_mask1
     994                 :             : {
     995                 :             :   OMP_CLAUSE_PRIVATE,
     996                 :             :   OMP_CLAUSE_FIRSTPRIVATE,
     997                 :             :   OMP_CLAUSE_LASTPRIVATE,
     998                 :             :   OMP_CLAUSE_COPYPRIVATE,
     999                 :             :   OMP_CLAUSE_SHARED,
    1000                 :             :   OMP_CLAUSE_COPYIN,
    1001                 :             :   OMP_CLAUSE_REDUCTION,
    1002                 :             :   OMP_CLAUSE_IN_REDUCTION,
    1003                 :             :   OMP_CLAUSE_TASK_REDUCTION,
    1004                 :             :   OMP_CLAUSE_IF,
    1005                 :             :   OMP_CLAUSE_NUM_THREADS,
    1006                 :             :   OMP_CLAUSE_SCHEDULE,
    1007                 :             :   OMP_CLAUSE_DEFAULT,
    1008                 :             :   OMP_CLAUSE_ORDER,
    1009                 :             :   OMP_CLAUSE_ORDERED,
    1010                 :             :   OMP_CLAUSE_COLLAPSE,
    1011                 :             :   OMP_CLAUSE_UNTIED,
    1012                 :             :   OMP_CLAUSE_FINAL,
    1013                 :             :   OMP_CLAUSE_MERGEABLE,
    1014                 :             :   OMP_CLAUSE_ALIGNED,
    1015                 :             :   OMP_CLAUSE_DEPEND,
    1016                 :             :   OMP_CLAUSE_INBRANCH,
    1017                 :             :   OMP_CLAUSE_LINEAR,
    1018                 :             :   OMP_CLAUSE_NOTINBRANCH,
    1019                 :             :   OMP_CLAUSE_PROC_BIND,
    1020                 :             :   OMP_CLAUSE_SAFELEN,
    1021                 :             :   OMP_CLAUSE_SIMDLEN,
    1022                 :             :   OMP_CLAUSE_UNIFORM,
    1023                 :             :   OMP_CLAUSE_DEVICE,
    1024                 :             :   OMP_CLAUSE_MAP,
    1025                 :             :   OMP_CLAUSE_TO,
    1026                 :             :   OMP_CLAUSE_FROM,
    1027                 :             :   OMP_CLAUSE_NUM_TEAMS,
    1028                 :             :   OMP_CLAUSE_THREAD_LIMIT,
    1029                 :             :   OMP_CLAUSE_DIST_SCHEDULE,
    1030                 :             :   OMP_CLAUSE_DEFAULTMAP,
    1031                 :             :   OMP_CLAUSE_GRAINSIZE,
    1032                 :             :   OMP_CLAUSE_HINT,
    1033                 :             :   OMP_CLAUSE_IS_DEVICE_PTR,
    1034                 :             :   OMP_CLAUSE_LINK,
    1035                 :             :   OMP_CLAUSE_NOGROUP,
    1036                 :             :   OMP_CLAUSE_NOTEMPORAL,
    1037                 :             :   OMP_CLAUSE_NUM_TASKS,
    1038                 :             :   OMP_CLAUSE_PRIORITY,
    1039                 :             :   OMP_CLAUSE_SIMD,
    1040                 :             :   OMP_CLAUSE_THREADS,
    1041                 :             :   OMP_CLAUSE_USE_DEVICE_PTR,
    1042                 :             :   OMP_CLAUSE_USE_DEVICE_ADDR,  /* OpenMP 5.0.  */
    1043                 :             :   OMP_CLAUSE_DEVICE_TYPE,  /* OpenMP 5.0.  */
    1044                 :             :   OMP_CLAUSE_ATOMIC,  /* OpenMP 5.0.  */
    1045                 :             :   OMP_CLAUSE_CAPTURE,  /* OpenMP 5.0.  */
    1046                 :             :   OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
    1047                 :             :   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
    1048                 :             :   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
    1049                 :             :   OMP_CLAUSE_ALLOCATE,  /* OpenMP 5.0.  */
    1050                 :             :   OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
    1051                 :             :   OMP_CLAUSE_FILTER,  /* OpenMP 5.1.  */
    1052                 :             :   OMP_CLAUSE_AT,  /* OpenMP 5.1.  */
    1053                 :             :   OMP_CLAUSE_MESSAGE,  /* OpenMP 5.1.  */
    1054                 :             :   OMP_CLAUSE_SEVERITY,  /* OpenMP 5.1.  */
    1055                 :             :   OMP_CLAUSE_COMPARE,  /* OpenMP 5.1.  */
    1056                 :             :   OMP_CLAUSE_FAIL,  /* OpenMP 5.1.  */
    1057                 :             :   OMP_CLAUSE_WEAK,  /* OpenMP 5.1.  */
    1058                 :             :   OMP_CLAUSE_NOWAIT,
    1059                 :             :   /* This must come last.  */
    1060                 :             :   OMP_MASK1_LAST
    1061                 :             : };
    1062                 :             : 
    1063                 :             : /* More OpenMP clauses and OpenACC 2.0+ specific clauses. */
    1064                 :             : enum omp_mask2
    1065                 :             : {
    1066                 :             :   OMP_CLAUSE_ASYNC,
    1067                 :             :   OMP_CLAUSE_NUM_GANGS,
    1068                 :             :   OMP_CLAUSE_NUM_WORKERS,
    1069                 :             :   OMP_CLAUSE_VECTOR_LENGTH,
    1070                 :             :   OMP_CLAUSE_COPY,
    1071                 :             :   OMP_CLAUSE_COPYOUT,
    1072                 :             :   OMP_CLAUSE_CREATE,
    1073                 :             :   OMP_CLAUSE_NO_CREATE,
    1074                 :             :   OMP_CLAUSE_PRESENT,
    1075                 :             :   OMP_CLAUSE_DEVICEPTR,
    1076                 :             :   OMP_CLAUSE_GANG,
    1077                 :             :   OMP_CLAUSE_WORKER,
    1078                 :             :   OMP_CLAUSE_VECTOR,
    1079                 :             :   OMP_CLAUSE_SEQ,
    1080                 :             :   OMP_CLAUSE_INDEPENDENT,
    1081                 :             :   OMP_CLAUSE_USE_DEVICE,
    1082                 :             :   OMP_CLAUSE_DEVICE_RESIDENT,
    1083                 :             :   OMP_CLAUSE_HOST_SELF,
    1084                 :             :   OMP_CLAUSE_WAIT,
    1085                 :             :   OMP_CLAUSE_DELETE,
    1086                 :             :   OMP_CLAUSE_AUTO,
    1087                 :             :   OMP_CLAUSE_TILE,
    1088                 :             :   OMP_CLAUSE_IF_PRESENT,
    1089                 :             :   OMP_CLAUSE_FINALIZE,
    1090                 :             :   OMP_CLAUSE_ATTACH,
    1091                 :             :   OMP_CLAUSE_NOHOST,
    1092                 :             :   OMP_CLAUSE_HAS_DEVICE_ADDR,  /* OpenMP 5.1  */
    1093                 :             :   OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
    1094                 :             :   OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
    1095                 :             :   OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
    1096                 :             :   OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0  */
    1097                 :             :   /* This must come last.  */
    1098                 :             :   OMP_MASK2_LAST
    1099                 :             : };
    1100                 :             : 
    1101                 :             : struct omp_inv_mask;
    1102                 :             : 
    1103                 :             : /* Customized bitset for up to 128-bits.
    1104                 :             :    The two enums above provide bit numbers to use, and which of the
    1105                 :             :    two enums it is determines which of the two mask fields is used.
    1106                 :             :    Supported operations are defining a mask, like:
    1107                 :             :    #define XXX_CLAUSES \
    1108                 :             :      (omp_mask (OMP_CLAUSE_XXX) | OMP_CLAUSE_YYY | OMP_CLAUSE_ZZZ)
    1109                 :             :    oring such bitsets together or removing selected bits:
    1110                 :             :    (XXX_CLAUSES | YYY_CLAUSES) & ~(omp_mask (OMP_CLAUSE_VVV))
    1111                 :             :    and testing individual bits:
    1112                 :             :    if (mask & OMP_CLAUSE_UUU)  */
    1113                 :             : 
    1114                 :             : struct omp_mask {
    1115                 :             :   const uint64_t mask1;
    1116                 :             :   const uint64_t mask2;
    1117                 :             :   inline omp_mask ();
    1118                 :             :   inline omp_mask (omp_mask1);
    1119                 :             :   inline omp_mask (omp_mask2);
    1120                 :             :   inline omp_mask (uint64_t, uint64_t);
    1121                 :             :   inline omp_mask operator| (omp_mask1) const;
    1122                 :             :   inline omp_mask operator| (omp_mask2) const;
    1123                 :             :   inline omp_mask operator| (omp_mask) const;
    1124                 :             :   inline omp_mask operator& (const omp_inv_mask &) const;
    1125                 :             :   inline bool operator& (omp_mask1) const;
    1126                 :             :   inline bool operator& (omp_mask2) const;
    1127                 :             :   inline omp_inv_mask operator~ () const;
    1128                 :             : };
    1129                 :             : 
    1130                 :             : struct omp_inv_mask : public omp_mask {
    1131                 :             :   inline omp_inv_mask (const omp_mask &);
    1132                 :             : };
    1133                 :             : 
    1134                 :             : omp_mask::omp_mask () : mask1 (0), mask2 (0)
    1135                 :             : {
    1136                 :             : }
    1137                 :             : 
    1138                 :       28644 : omp_mask::omp_mask (omp_mask1 m) : mask1 (((uint64_t) 1) << m), mask2 (0)
    1139                 :             : {
    1140                 :             : }
    1141                 :             : 
    1142                 :        1448 : omp_mask::omp_mask (omp_mask2 m) : mask1 (0), mask2 (((uint64_t) 1) << m)
    1143                 :             : {
    1144                 :             : }
    1145                 :             : 
    1146                 :       28870 : omp_mask::omp_mask (uint64_t m1, uint64_t m2) : mask1 (m1), mask2 (m2)
    1147                 :             : {
    1148                 :             : }
    1149                 :             : 
    1150                 :             : omp_mask
    1151                 :       28350 : omp_mask::operator| (omp_mask1 m) const
    1152                 :             : {
    1153                 :       28350 :   return omp_mask (mask1 | (((uint64_t) 1) << m), mask2);
    1154                 :             : }
    1155                 :             : 
    1156                 :             : omp_mask
    1157                 :       13590 : omp_mask::operator| (omp_mask2 m) const
    1158                 :             : {
    1159                 :       13590 :   return omp_mask (mask1, mask2 | (((uint64_t) 1) << m));
    1160                 :             : }
    1161                 :             : 
    1162                 :             : omp_mask
    1163                 :        3704 : omp_mask::operator| (omp_mask m) const
    1164                 :             : {
    1165                 :        3704 :   return omp_mask (mask1 | m.mask1, mask2 | m.mask2);
    1166                 :             : }
    1167                 :             : 
    1168                 :             : omp_mask
    1169                 :        1648 : omp_mask::operator& (const omp_inv_mask &m) const
    1170                 :             : {
    1171                 :        1648 :   return omp_mask (mask1 & ~m.mask1, mask2 & ~m.mask2);
    1172                 :             : }
    1173                 :             : 
    1174                 :             : bool
    1175                 :      111884 : omp_mask::operator& (omp_mask1 m) const
    1176                 :             : {
    1177                 :      111884 :   return (mask1 & (((uint64_t) 1) << m)) != 0;
    1178                 :             : }
    1179                 :             : 
    1180                 :             : bool
    1181                 :       71700 : omp_mask::operator& (omp_mask2 m) const
    1182                 :             : {
    1183                 :       71700 :   return (mask2 & (((uint64_t) 1) << m)) != 0;
    1184                 :             : }
    1185                 :             : 
    1186                 :             : omp_inv_mask
    1187                 :        1648 : omp_mask::operator~ () const
    1188                 :             : {
    1189                 :        1648 :   return omp_inv_mask (*this);
    1190                 :             : }
    1191                 :             : 
    1192                 :        1648 : omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m)
    1193                 :             : {
    1194                 :             : }
    1195                 :             : 
    1196                 :             : /* Helper function for OpenACC and OpenMP clauses involving memory
    1197                 :             :    mapping.  */
    1198                 :             : 
    1199                 :             : static bool
    1200                 :        6322 : gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
    1201                 :             :                           bool allow_common, bool allow_derived)
    1202                 :             : {
    1203                 :        6322 :   gfc_omp_namelist **head = NULL;
    1204                 :        6322 :   if (gfc_match_omp_variable_list ("", list, allow_common, NULL, &head, true,
    1205                 :             :                                    allow_derived)
    1206                 :             :       == MATCH_YES)
    1207                 :             :     {
    1208                 :        6307 :       gfc_omp_namelist *n;
    1209                 :       15135 :       for (n = *head; n; n = n->next)
    1210                 :        8828 :         n->u.map_op = map_op;
    1211                 :             :       return true;
    1212                 :             :     }
    1213                 :             : 
    1214                 :             :   return false;
    1215                 :             : }
    1216                 :             : 
    1217                 :             : static match
    1218                 :        1087 : gfc_match_iterator (gfc_namespace **ns, bool permit_var)
    1219                 :             : {
    1220                 :        1087 :   locus old_loc = gfc_current_locus;
    1221                 :             : 
    1222                 :        1087 :   if (gfc_match ("iterator ( ") != MATCH_YES)
    1223                 :             :     return MATCH_NO;
    1224                 :             : 
    1225                 :          77 :   gfc_typespec ts;
    1226                 :          77 :   gfc_symbol *last = NULL;
    1227                 :          77 :   gfc_expr *begin, *end, *step;
    1228                 :          77 :   *ns = gfc_build_block_ns (gfc_current_ns);
    1229                 :          83 :   char name[GFC_MAX_SYMBOL_LEN + 1];
    1230                 :          89 :   while (true)
    1231                 :             :     {
    1232                 :          83 :       locus prev_loc = gfc_current_locus;
    1233                 :          83 :       if (gfc_match_type_spec (&ts) == MATCH_YES
    1234                 :          83 :           && gfc_match (" :: ") == MATCH_YES)
    1235                 :             :         {
    1236                 :           5 :           if (ts.type != BT_INTEGER)
    1237                 :             :             {
    1238                 :           2 :               gfc_error ("Expected INTEGER type at %L", &prev_loc);
    1239                 :           5 :               return MATCH_ERROR;
    1240                 :             :             }
    1241                 :             :           permit_var = false;
    1242                 :             :         }
    1243                 :             :       else
    1244                 :             :         {
    1245                 :          78 :           ts.type = BT_INTEGER;
    1246                 :          78 :           ts.kind = gfc_default_integer_kind;
    1247                 :          78 :           gfc_current_locus = prev_loc;
    1248                 :             :         }
    1249                 :          81 :       prev_loc = gfc_current_locus;
    1250                 :          81 :       if (gfc_match_name (name) != MATCH_YES)
    1251                 :             :         {
    1252                 :           4 :           gfc_error ("Expected identifier at %C");
    1253                 :           4 :           goto failed;
    1254                 :             :         }
    1255                 :          77 :       if (gfc_find_symtree ((*ns)->sym_root, name))
    1256                 :             :         {
    1257                 :           2 :           gfc_error ("Same identifier %qs specified again at %C", name);
    1258                 :           2 :           goto failed;
    1259                 :             :         }
    1260                 :             : 
    1261                 :          75 :       gfc_symbol *sym = gfc_new_symbol (name, *ns);
    1262                 :          75 :       if (last)
    1263                 :           4 :         last->tlink = sym;
    1264                 :             :       else
    1265                 :          71 :         (*ns)->omp_affinity_iterators = sym;
    1266                 :          75 :       last = sym;
    1267                 :          75 :       sym->declared_at = prev_loc;
    1268                 :          75 :       sym->ts = ts;
    1269                 :          75 :       sym->attr.flavor = FL_VARIABLE;
    1270                 :          75 :       sym->attr.artificial = 1;
    1271                 :          75 :       sym->attr.referenced = 1;
    1272                 :          75 :       sym->refs++;
    1273                 :          75 :       gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name);
    1274                 :          75 :       st->n.sym = sym;
    1275                 :             : 
    1276                 :          75 :       prev_loc = gfc_current_locus;
    1277                 :          75 :       if (gfc_match (" = ") != MATCH_YES)
    1278                 :           3 :         goto failed;
    1279                 :          72 :       permit_var = false;
    1280                 :          72 :       begin = end = step = NULL;
    1281                 :          72 :       if (gfc_match ("%e : ", &begin) != MATCH_YES
    1282                 :          72 :           || gfc_match ("%e ", &end) != MATCH_YES)
    1283                 :             :         {
    1284                 :           3 :           gfc_error ("Expected range-specification at %C");
    1285                 :           3 :           gfc_free_expr (begin);
    1286                 :           3 :           gfc_free_expr (end);
    1287                 :           3 :           return MATCH_ERROR;
    1288                 :             :         }
    1289                 :          69 :       if (':' == gfc_peek_ascii_char ())
    1290                 :             :         {
    1291                 :          23 :           if (gfc_match (": %e ", &step) != MATCH_YES)
    1292                 :             :             {
    1293                 :           5 :               gfc_free_expr (begin);
    1294                 :           5 :               gfc_free_expr (end);
    1295                 :           5 :               gfc_free_expr (step);
    1296                 :           5 :               goto failed;
    1297                 :             :             }
    1298                 :             :         }
    1299                 :             : 
    1300                 :          64 :       gfc_expr *e = gfc_get_expr ();
    1301                 :          64 :       e->where = prev_loc;
    1302                 :          64 :       e->expr_type = EXPR_ARRAY;
    1303                 :          64 :       e->ts = ts;
    1304                 :          64 :       e->rank = 1;
    1305                 :          64 :       e->shape = gfc_get_shape (1);
    1306                 :         110 :       mpz_init_set_ui (e->shape[0], step ? 3 : 2);
    1307                 :          64 :       gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where);
    1308                 :          64 :       gfc_constructor_append_expr (&e->value.constructor, end, &end->where);
    1309                 :          64 :       if (step)
    1310                 :          18 :         gfc_constructor_append_expr (&e->value.constructor, step, &step->where);
    1311                 :          64 :       sym->value = e;
    1312                 :             : 
    1313                 :          64 :       if (gfc_match (") ") == MATCH_YES)
    1314                 :             :         break;
    1315                 :           6 :       if (gfc_match (", ") != MATCH_YES)
    1316                 :           0 :         goto failed;
    1317                 :           6 :     }
    1318                 :          58 :   return MATCH_YES;
    1319                 :             : 
    1320                 :          14 : failed:
    1321                 :          14 :   gfc_namespace *prev_ns = NULL;
    1322                 :          14 :   for (gfc_namespace *it = gfc_current_ns->contained; it; it = it->sibling)
    1323                 :             :     {
    1324                 :           0 :       if (it == *ns)
    1325                 :             :         {
    1326                 :           0 :           if (prev_ns)
    1327                 :           0 :             prev_ns->sibling = it->sibling;
    1328                 :             :           else
    1329                 :           0 :             gfc_current_ns->contained = it->sibling;
    1330                 :           0 :           gfc_free_namespace (it);
    1331                 :           0 :           break;
    1332                 :             :         }
    1333                 :           0 :       prev_ns = it;
    1334                 :             :     }
    1335                 :          14 :   *ns = NULL;
    1336                 :          14 :   if (!permit_var)
    1337                 :             :     return MATCH_ERROR;
    1338                 :           4 :   gfc_current_locus = old_loc;
    1339                 :           4 :   return MATCH_NO;
    1340                 :             : }
    1341                 :             : 
    1342                 :             : /* Match target update's to/from( [present:] var-list).  */
    1343                 :             : 
    1344                 :             : static match
    1345                 :        1718 : gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
    1346                 :             :                            gfc_omp_namelist ***headp)
    1347                 :             : {
    1348                 :        1718 :   match m = gfc_match (str);
    1349                 :        1718 :   if (m != MATCH_YES)
    1350                 :             :     return m;
    1351                 :             : 
    1352                 :        1718 :   match m_present = gfc_match (" present : ");
    1353                 :             : 
    1354                 :        1718 :   m = gfc_match_omp_variable_list ("", list, false, NULL, headp, true, true);
    1355                 :        1718 :   if (m != MATCH_YES)
    1356                 :             :     return m;
    1357                 :        1718 :   if (m_present == MATCH_YES)
    1358                 :             :     {
    1359                 :           5 :       gfc_omp_namelist *n;
    1360                 :          10 :       for (n = **headp; n; n = n->next)
    1361                 :           5 :         n->u.present_modifier = true;
    1362                 :             :     }
    1363                 :             :   return MATCH_YES;
    1364                 :             : }
    1365                 :             : 
    1366                 :             : /* reduction ( reduction-modifier, reduction-operator : variable-list )
    1367                 :             :    in_reduction ( reduction-operator : variable-list )
    1368                 :             :    task_reduction ( reduction-operator : variable-list )  */
    1369                 :             : 
    1370                 :             : static match
    1371                 :        3972 : gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
    1372                 :             :                                 bool allow_derived, bool openmp_target = false)
    1373                 :             : {
    1374                 :        3972 :   if (pc == 'r' && gfc_match ("reduction ( ") != MATCH_YES)
    1375                 :             :     return MATCH_NO;
    1376                 :        3972 :   else if (pc == 'i' && gfc_match ("in_reduction ( ") != MATCH_YES)
    1377                 :             :     return MATCH_NO;
    1378                 :        3873 :   else if (pc == 't' && gfc_match ("task_reduction ( ") != MATCH_YES)
    1379                 :             :     return MATCH_NO;
    1380                 :             : 
    1381                 :        3873 :   locus old_loc = gfc_current_locus;
    1382                 :        3873 :   int list_idx = 0;
    1383                 :             : 
    1384                 :        3873 :   if (pc == 'r' && !openacc)
    1385                 :             :     {
    1386                 :        2033 :       if (gfc_match ("inscan") == MATCH_YES)
    1387                 :             :         list_idx = OMP_LIST_REDUCTION_INSCAN;
    1388                 :        1967 :       else if (gfc_match ("task") == MATCH_YES)
    1389                 :             :         list_idx = OMP_LIST_REDUCTION_TASK;
    1390                 :        1863 :       else if (gfc_match ("default") == MATCH_YES)
    1391                 :             :         list_idx = OMP_LIST_REDUCTION;
    1392                 :         226 :       if (list_idx != 0 && gfc_match (", ") != MATCH_YES)
    1393                 :             :         {
    1394                 :           1 :           gfc_error ("Comma expected at %C");
    1395                 :           1 :           gfc_current_locus = old_loc;
    1396                 :           1 :           return MATCH_NO;
    1397                 :             :         }
    1398                 :        2032 :       if (list_idx == 0)
    1399                 :        3464 :         list_idx = OMP_LIST_REDUCTION;
    1400                 :             :     }
    1401                 :        1840 :   else if (pc == 'i')
    1402                 :             :     list_idx = OMP_LIST_IN_REDUCTION;
    1403                 :        1722 :   else if (pc == 't')
    1404                 :             :     list_idx = OMP_LIST_TASK_REDUCTION;
    1405                 :             :   else
    1406                 :        3464 :     list_idx = OMP_LIST_REDUCTION;
    1407                 :             : 
    1408                 :        3872 :   gfc_omp_reduction_op rop = OMP_REDUCTION_NONE;
    1409                 :        3872 :   char buffer[GFC_MAX_SYMBOL_LEN + 3];
    1410                 :        3872 :   if (gfc_match_char ('+') == MATCH_YES)
    1411                 :             :     rop = OMP_REDUCTION_PLUS;
    1412                 :        2089 :   else if (gfc_match_char ('*') == MATCH_YES)
    1413                 :             :     rop = OMP_REDUCTION_TIMES;
    1414                 :        1875 :   else if (gfc_match_char ('-') == MATCH_YES)
    1415                 :             :     rop = OMP_REDUCTION_MINUS;
    1416                 :        1758 :   else if (gfc_match (".and.") == MATCH_YES)
    1417                 :             :     rop = OMP_REDUCTION_AND;
    1418                 :        1659 :   else if (gfc_match (".or.") == MATCH_YES)
    1419                 :             :     rop = OMP_REDUCTION_OR;
    1420                 :         880 :   else if (gfc_match (".eqv.") == MATCH_YES)
    1421                 :             :     rop = OMP_REDUCTION_EQV;
    1422                 :         788 :   else if (gfc_match (".neqv.") == MATCH_YES)
    1423                 :             :     rop = OMP_REDUCTION_NEQV;
    1424                 :         698 :   if (rop != OMP_REDUCTION_NONE)
    1425                 :        3174 :     snprintf (buffer, sizeof buffer, "operator %s",
    1426                 :             :               gfc_op2string ((gfc_intrinsic_op) rop));
    1427                 :         698 :   else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES)
    1428                 :             :     {
    1429                 :          38 :       buffer[0] = '.';
    1430                 :          38 :       strcat (buffer, ".");
    1431                 :             :     }
    1432                 :         660 :   else if (gfc_match_name (buffer) == MATCH_YES)
    1433                 :             :     {
    1434                 :         659 :       gfc_symbol *sym;
    1435                 :         659 :       const char *n = buffer;
    1436                 :             : 
    1437                 :         659 :       gfc_find_symbol (buffer, NULL, 1, &sym);
    1438                 :         659 :       if (sym != NULL)
    1439                 :             :         {
    1440                 :         213 :           if (sym->attr.intrinsic)
    1441                 :         139 :             n = sym->name;
    1442                 :          74 :           else if ((sym->attr.flavor != FL_UNKNOWN
    1443                 :          72 :                     && sym->attr.flavor != FL_PROCEDURE)
    1444                 :             :                    || sym->attr.external
    1445                 :          72 :                    || sym->attr.generic
    1446                 :          61 :                    || sym->attr.entry
    1447                 :             :                    || sym->attr.result
    1448                 :             :                    || sym->attr.dummy
    1449                 :             :                    || sym->attr.subroutine
    1450                 :             :                    || sym->attr.pointer
    1451                 :          61 :                    || sym->attr.target
    1452                 :             :                    || sym->attr.cray_pointer
    1453                 :          60 :                    || sym->attr.cray_pointee
    1454                 :          60 :                    || (sym->attr.proc != PROC_UNKNOWN
    1455                 :           1 :                        && sym->attr.proc != PROC_INTRINSIC)
    1456                 :          59 :                    || sym->attr.if_source != IFSRC_UNKNOWN
    1457                 :          59 :                    || sym == sym->ns->proc_name)
    1458                 :             :                 {
    1459                 :             :                   sym = NULL;
    1460                 :             :                   n = NULL;
    1461                 :             :                 }
    1462                 :             :               else
    1463                 :          59 :                 n = sym->name;
    1464                 :             :             }
    1465                 :         198 :           if (n == NULL)
    1466                 :             :             rop = OMP_REDUCTION_NONE;
    1467                 :         644 :           else if (strcmp (n, "max") == 0)
    1468                 :             :             rop = OMP_REDUCTION_MAX;
    1469                 :         491 :           else if (strcmp (n, "min") == 0)
    1470                 :             :             rop = OMP_REDUCTION_MIN;
    1471                 :         356 :           else if (strcmp (n, "iand") == 0)
    1472                 :             :             rop = OMP_REDUCTION_IAND;
    1473                 :         308 :           else if (strcmp (n, "ior") == 0)
    1474                 :             :             rop = OMP_REDUCTION_IOR;
    1475                 :         249 :           else if (strcmp (n, "ieor") == 0)
    1476                 :             :             rop = OMP_REDUCTION_IEOR;
    1477                 :             :           if (rop != OMP_REDUCTION_NONE
    1478                 :         439 :               && sym != NULL
    1479                 :             :               && ! sym->attr.intrinsic
    1480                 :         197 :               && ! sym->attr.use_assoc
    1481                 :          58 :               && ((sym->attr.flavor == FL_UNKNOWN
    1482                 :           2 :                    && !gfc_add_flavor (&sym->attr, FL_PROCEDURE,
    1483                 :             :                                               sym->name, NULL))
    1484                 :          58 :                   || !gfc_add_intrinsic (&sym->attr, NULL)))
    1485                 :             :             rop = OMP_REDUCTION_NONE;
    1486                 :             :     }
    1487                 :             :   else
    1488                 :           1 :     buffer[0] = '\0';
    1489                 :        3872 :   gfc_omp_udr *udr = (buffer[0] ? gfc_find_omp_udr (gfc_current_ns, buffer, NULL)
    1490                 :        3872 :                                 : NULL);
    1491                 :        3872 :   gfc_omp_namelist **head = NULL;
    1492                 :        3872 :   if (rop == OMP_REDUCTION_NONE && udr)
    1493                 :         250 :     rop = OMP_REDUCTION_USER;
    1494                 :             : 
    1495                 :        3872 :   if (gfc_match_omp_variable_list (" :", &c->lists[list_idx], false, NULL,
    1496                 :             :                                    &head, openacc, allow_derived) != MATCH_YES)
    1497                 :             :     {
    1498                 :           7 :       gfc_current_locus = old_loc;
    1499                 :           7 :       return MATCH_NO;
    1500                 :             :     }
    1501                 :        3865 :   gfc_omp_namelist *n;
    1502                 :        3865 :   if (rop == OMP_REDUCTION_NONE)
    1503                 :             :     {
    1504                 :           6 :       n = *head;
    1505                 :           6 :       *head = NULL;
    1506                 :           6 :       gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
    1507                 :             :                      buffer, &old_loc);
    1508                 :           6 :       gfc_free_omp_namelist (n, false, false, false);
    1509                 :             :     }
    1510                 :             :   else
    1511                 :        8341 :     for (n = *head; n; n = n->next)
    1512                 :             :       {
    1513                 :        4482 :         n->u.reduction_op = rop;
    1514                 :        4482 :         if (udr)
    1515                 :             :           {
    1516                 :         473 :             n->u2.udr = gfc_get_omp_namelist_udr ();
    1517                 :         473 :             n->u2.udr->udr = udr;
    1518                 :             :           }
    1519                 :        4482 :         if (openmp_target && list_idx == OMP_LIST_IN_REDUCTION)
    1520                 :             :           {
    1521                 :          40 :             gfc_omp_namelist *p = gfc_get_omp_namelist (), **tl;
    1522                 :          40 :             p->sym = n->sym;
    1523                 :          40 :             p->where = p->where;
    1524                 :          40 :             p->u.map_op = OMP_MAP_ALWAYS_TOFROM;
    1525                 :             : 
    1526                 :          40 :             tl = &c->lists[OMP_LIST_MAP];
    1527                 :          52 :             while (*tl)
    1528                 :          12 :               tl = &((*tl)->next);
    1529                 :          40 :             *tl = p;
    1530                 :          40 :             p->next = NULL;
    1531                 :             :           }
    1532                 :             :      }
    1533                 :             :   return MATCH_YES;
    1534                 :             : }
    1535                 :             : 
    1536                 :             : static match
    1537                 :          37 : gfc_omp_absent_contains_clause (gfc_omp_assumptions **assume, bool is_absent)
    1538                 :             : {
    1539                 :          37 :   if (*assume == NULL)
    1540                 :          12 :     *assume = gfc_get_omp_assumptions ();
    1541                 :          59 :   do
    1542                 :             :     {
    1543                 :          48 :       gfc_statement st = ST_NONE;
    1544                 :          48 :       gfc_gobble_whitespace ();
    1545                 :          48 :       locus old_loc = gfc_current_locus;
    1546                 :          48 :       char c = gfc_peek_ascii_char ();
    1547                 :          48 :       enum gfc_omp_directive_kind kind
    1548                 :             :         = GFC_OMP_DIR_DECLARATIVE; /* Silence warning. */
    1549                 :        1329 :       for (size_t i = 0; i < ARRAY_SIZE (gfc_omp_directives); i++)
    1550                 :             :         {
    1551                 :        1329 :           if (gfc_omp_directives[i].name[0] > c)
    1552                 :             :             break;
    1553                 :        1281 :           if (gfc_omp_directives[i].name[0] != c)
    1554                 :         963 :             continue;
    1555                 :         318 :           if (gfc_match (gfc_omp_directives[i].name) == MATCH_YES)
    1556                 :             :             {
    1557                 :          48 :               st = gfc_omp_directives[i].st;
    1558                 :          48 :               kind = gfc_omp_directives[i].kind;
    1559                 :             :             }
    1560                 :             :         }
    1561                 :          48 :       gfc_gobble_whitespace ();
    1562                 :          48 :       c = gfc_peek_ascii_char ();
    1563                 :          48 :       if (st == ST_NONE || (c != ',' && c != ')'))
    1564                 :             :         {
    1565                 :           0 :           if (st == ST_NONE)
    1566                 :           0 :             gfc_error ("Unknown directive at %L", &old_loc);
    1567                 :             :           else
    1568                 :           0 :             gfc_error ("Invalid combined or composite directive at %L",
    1569                 :             :                        &old_loc);
    1570                 :           3 :           return MATCH_ERROR;
    1571                 :             :         }
    1572                 :          48 :       if (kind == GFC_OMP_DIR_DECLARATIVE
    1573                 :          48 :           || kind == GFC_OMP_DIR_INFORMATIONAL
    1574                 :             :           || kind == GFC_OMP_DIR_META)
    1575                 :             :         {
    1576                 :           3 :           gfc_error ("Invalid %qs directive at %L in %s clause: declarative, "
    1577                 :             :                      "informational and meta directives not permitted",
    1578                 :             :                      gfc_ascii_statement (st, true), &old_loc,
    1579                 :             :                      is_absent ? "ABSENT" : "CONTAINS");
    1580                 :           3 :           return MATCH_ERROR;
    1581                 :             :         }
    1582                 :          45 :       if (is_absent)
    1583                 :             :         {
    1584                 :             :           /* Use exponential allocation; equivalent to pow2p(x). */
    1585                 :          33 :           int i = (*assume)->n_absent;
    1586                 :          33 :           int size = ((i == 0) ? 4
    1587                 :          10 :                       : pow2p_hwi (i) == 1 ? i*2 : 0);
    1588                 :           8 :           if (size != 0)
    1589                 :          31 :             (*assume)->absent = XRESIZEVEC (gfc_statement,
    1590                 :             :                                             (*assume)->absent, size);
    1591                 :          33 :           (*assume)->absent[(*assume)->n_absent++] = st;
    1592                 :             :         }
    1593                 :             :       else
    1594                 :             :         {
    1595                 :          12 :           int i = (*assume)->n_contains;
    1596                 :          12 :           int size = ((i == 0) ? 4
    1597                 :           4 :                       : pow2p_hwi (i) == 1 ? i*2 : 0);
    1598                 :           4 :           if (size != 0)
    1599                 :          12 :             (*assume)->contains = XRESIZEVEC (gfc_statement,
    1600                 :             :                                               (*assume)->contains, size);
    1601                 :          12 :           (*assume)->contains[(*assume)->n_contains++] = st;
    1602                 :             :         }
    1603                 :          45 :       gfc_gobble_whitespace ();
    1604                 :          45 :       if (gfc_match(",") == MATCH_YES)
    1605                 :          11 :         continue;
    1606                 :          34 :       if (gfc_match(")") == MATCH_YES)
    1607                 :             :         break;
    1608                 :           0 :       gfc_error ("Expected %<,%> or %<)%> at %C");
    1609                 :           0 :       return MATCH_ERROR;
    1610                 :             :     }
    1611                 :             :   while (true);
    1612                 :             : 
    1613                 :          34 :   return MATCH_YES;
    1614                 :             : }
    1615                 :             : 
    1616                 :             : /* Check 'check' argument for duplicated statements in absent and/or contains
    1617                 :             :    clauses. If 'merge', merge them from check to 'merge'.  */
    1618                 :             : 
    1619                 :             : static match
    1620                 :          40 : omp_verify_merge_absent_contains (gfc_statement st, gfc_omp_assumptions *check,
    1621                 :             :                                   gfc_omp_assumptions *merge, locus *loc)
    1622                 :             : {
    1623                 :          40 :   if (check == NULL)
    1624                 :             :     return MATCH_YES;
    1625                 :          40 :   bitmap_head absent_head, contains_head;
    1626                 :          40 :   bitmap_obstack_initialize (NULL);
    1627                 :          40 :   bitmap_initialize (&absent_head, &bitmap_default_obstack);
    1628                 :          40 :   bitmap_initialize (&contains_head, &bitmap_default_obstack);
    1629                 :             : 
    1630                 :          40 :   match m = MATCH_YES;
    1631                 :          73 :   for (int i = 0; i < check->n_absent; i++)
    1632                 :          33 :     if (!bitmap_set_bit (&absent_head, check->absent[i]))
    1633                 :             :       {
    1634                 :           2 :         gfc_error ("%qs directive mentioned multiple times in %s clause in %s "
    1635                 :             :                    "directive at %L",
    1636                 :           2 :                    gfc_ascii_statement (check->absent[i], true),
    1637                 :             :                    "ABSENT", gfc_ascii_statement (st), loc);
    1638                 :           2 :         m = MATCH_ERROR;
    1639                 :             :       }
    1640                 :          52 :   for (int i = 0; i < check->n_contains; i++)
    1641                 :             :     {
    1642                 :          12 :       if (!bitmap_set_bit (&contains_head, check->contains[i]))
    1643                 :             :         {
    1644                 :           2 :           gfc_error ("%qs directive mentioned multiple times in %s clause in %s "
    1645                 :             :                      "directive at %L",
    1646                 :           2 :                      gfc_ascii_statement (check->contains[i], true),
    1647                 :             :                      "CONTAINS", gfc_ascii_statement (st), loc);
    1648                 :           2 :           m = MATCH_ERROR;
    1649                 :             :         }
    1650                 :          12 :       if (bitmap_bit_p (&absent_head, check->contains[i]))
    1651                 :             :         {
    1652                 :           2 :           gfc_error ("%qs directive mentioned both times in ABSENT and CONTAINS "
    1653                 :             :                      "clauses in %s directive at %L",
    1654                 :           2 :                      gfc_ascii_statement (check->absent[i], true),
    1655                 :             :                      gfc_ascii_statement (st), loc);
    1656                 :           2 :           m = MATCH_ERROR;
    1657                 :             :         }
    1658                 :             :     }
    1659                 :             : 
    1660                 :          40 :   if (m == MATCH_ERROR)
    1661                 :             :     return MATCH_ERROR;
    1662                 :          34 :   if (merge == NULL)
    1663                 :             :     return MATCH_YES;
    1664                 :           2 :   if (merge->absent == NULL && check->absent)
    1665                 :             :     {
    1666                 :           1 :       merge->n_absent = check->n_absent;
    1667                 :           1 :       merge->absent = check->absent;
    1668                 :           1 :       check->absent = NULL;
    1669                 :             :     }
    1670                 :           1 :   else if (merge->absent && check->absent)
    1671                 :             :     {
    1672                 :           0 :       check->absent = XRESIZEVEC (gfc_statement, check->absent,
    1673                 :             :                                   merge->n_absent + check->n_absent);
    1674                 :           0 :       for (int i = 0; i < merge->n_absent; i++)
    1675                 :           0 :         if (!bitmap_bit_p (&absent_head, merge->absent[i]))
    1676                 :           0 :           check->absent[check->n_absent++] = merge->absent[i];
    1677                 :           0 :       free (merge->absent);
    1678                 :           0 :       merge->absent = check->absent;
    1679                 :           0 :       merge->n_absent = check->n_absent;
    1680                 :           0 :       check->absent = NULL;
    1681                 :             :     }
    1682                 :           2 :   if (merge->contains == NULL && check->contains)
    1683                 :             :     {
    1684                 :           0 :       merge->n_contains = check->n_contains;
    1685                 :           0 :       merge->contains = check->contains;
    1686                 :           0 :       check->contains = NULL;
    1687                 :             :     }
    1688                 :           2 :   else if (merge->contains && check->contains)
    1689                 :             :     {
    1690                 :           0 :       check->contains = XRESIZEVEC (gfc_statement, check->contains,
    1691                 :             :                                     merge->n_contains + check->n_contains);
    1692                 :           0 :       for (int i = 0; i < merge->n_contains; i++)
    1693                 :           0 :         if (!bitmap_bit_p (&contains_head, merge->contains[i]))
    1694                 :           0 :           check->contains[check->n_contains++] = merge->contains[i];
    1695                 :           0 :       free (merge->contains);
    1696                 :           0 :       merge->contains = check->contains;
    1697                 :           0 :       merge->n_contains = check->n_contains;
    1698                 :           0 :       check->contains = NULL;
    1699                 :             :     }
    1700                 :             :   return MATCH_YES;
    1701                 :             : }
    1702                 :             : 
    1703                 :             : /* OpenMP 5.0
    1704                 :             :    uses_allocators ( allocator-list )
    1705                 :             : 
    1706                 :             :    allocator:
    1707                 :             :      predefined-allocator
    1708                 :             :      variable ( traits-array )
    1709                 :             : 
    1710                 :             :    OpenMP 5.2:
    1711                 :             :    uses_allocators ( [modifier-list :] allocator-list )
    1712                 :             : 
    1713                 :             :    allocator:
    1714                 :             :      variable or predefined-allocator
    1715                 :             :    modifier:
    1716                 :             :      traits ( traits-array )
    1717                 :             :      memspace ( mem-space-handle )  */
    1718                 :             : 
    1719                 :             : static match
    1720                 :          47 : gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
    1721                 :             : {
    1722                 :          47 :   gfc_symbol *memspace_sym = NULL;
    1723                 :          47 :   gfc_symbol *traits_sym = NULL;
    1724                 :          47 :   gfc_omp_namelist *head = NULL;
    1725                 :          47 :   gfc_omp_namelist *p, *tail, **list;
    1726                 :          47 :   int ntraits, nmemspace;
    1727                 :          47 :   bool has_modifiers;
    1728                 :          47 :   locus old_loc, cur_loc;
    1729                 :             : 
    1730                 :          47 :   gfc_gobble_whitespace ();
    1731                 :          47 :   old_loc = gfc_current_locus;
    1732                 :          47 :   ntraits = nmemspace = 0;
    1733                 :          77 :   do
    1734                 :             :     {
    1735                 :          62 :       cur_loc = gfc_current_locus;
    1736                 :          62 :       if (gfc_match ("traits ( %S ) ", &traits_sym) == MATCH_YES)
    1737                 :          21 :         ntraits++;
    1738                 :          41 :       else if (gfc_match ("memspace ( %S ) ", &memspace_sym) == MATCH_YES)
    1739                 :          21 :         nmemspace++;
    1740                 :          62 :       if (ntraits > 1 || nmemspace > 1)
    1741                 :             :         {
    1742                 :           2 :           gfc_error ("Duplicate %s modifier at %L in USES_ALLOCATORS clause",
    1743                 :             :                      ntraits > 1 ? "TRAITS" : "MEMSPACE", &cur_loc);
    1744                 :           2 :           return MATCH_ERROR;
    1745                 :             :         }
    1746                 :          60 :       if (gfc_match (", ") == MATCH_YES)
    1747                 :          15 :         continue;
    1748                 :          45 :       if (gfc_match (": ") != MATCH_YES)
    1749                 :             :         {
    1750                 :             :           /* Assume no modifier. */
    1751                 :          22 :           memspace_sym = traits_sym = NULL;
    1752                 :          22 :           gfc_current_locus = old_loc;
    1753                 :          22 :           break;
    1754                 :             :         }
    1755                 :             :       break;
    1756                 :             :     } while (true);
    1757                 :             : 
    1758                 :          68 :   has_modifiers = traits_sym != NULL || memspace_sym != NULL;
    1759                 :         127 :   do
    1760                 :             :     {
    1761                 :          86 :       p = gfc_get_omp_namelist ();
    1762                 :          86 :       p->where = gfc_current_locus;
    1763                 :          86 :       if (head == NULL)
    1764                 :             :         head = tail = p;
    1765                 :             :       else
    1766                 :             :         {
    1767                 :          41 :           tail->next = p;
    1768                 :          41 :           tail = tail->next;
    1769                 :             :         }
    1770                 :          86 :       if (gfc_match ("%S ", &p->sym) != MATCH_YES)
    1771                 :           0 :         goto error;
    1772                 :          86 :       if (!has_modifiers)
    1773                 :          58 :         gfc_match ("( %S ) ", &p->u2.traits_sym);
    1774                 :          28 :       else if (gfc_peek_ascii_char () == '(')
    1775                 :             :         {
    1776                 :           0 :           gfc_error ("Unexpected %<(%> at %C");
    1777                 :           0 :           goto error;
    1778                 :             :         }
    1779                 :             :       else
    1780                 :             :         {
    1781                 :          28 :           p->u.memspace_sym = memspace_sym;
    1782                 :          28 :           p->u2.traits_sym = traits_sym;
    1783                 :             :         }
    1784                 :          86 :       if (gfc_match (", ") == MATCH_YES)
    1785                 :          41 :         continue;
    1786                 :          45 :       if (gfc_match (") ") == MATCH_YES)
    1787                 :             :         break;
    1788                 :           2 :       goto error;
    1789                 :             :     } while (true);
    1790                 :             : 
    1791                 :          43 :   list = &c->lists[OMP_LIST_USES_ALLOCATORS];
    1792                 :          48 :   while (*list)
    1793                 :           5 :     list = &(*list)->next;
    1794                 :          43 :   *list = head;
    1795                 :             : 
    1796                 :          43 :   return MATCH_YES;
    1797                 :             : 
    1798                 :           2 : error:
    1799                 :           2 :   gfc_free_omp_namelist (head, false, false, true);
    1800                 :           2 :   return MATCH_ERROR;
    1801                 :             : }
    1802                 :             : 
    1803                 :             : 
    1804                 :             : /* Match with duplicate check. Matches 'name'. If expr != NULL, it
    1805                 :             :    then matches '(expr)', otherwise, if open_parens is true,
    1806                 :             :    it matches a ' ( ' after 'name'.
    1807                 :             :    dupl_message requires '%qs %L' - and is used by
    1808                 :             :    gfc_match_dupl_memorder and gfc_match_dupl_atomic.  */
    1809                 :             : 
    1810                 :             : static match
    1811                 :       19852 : gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false,
    1812                 :             :                       gfc_expr **expr = NULL, const char *dupl_msg = NULL)
    1813                 :             : {
    1814                 :       19852 :   match m;
    1815                 :       19852 :   locus old_loc = gfc_current_locus;
    1816                 :       19852 :   if ((m = gfc_match (name)) != MATCH_YES)
    1817                 :             :     return m;
    1818                 :       15315 :   if (!not_dupl)
    1819                 :             :     {
    1820                 :          33 :       if (dupl_msg)
    1821                 :           2 :         gfc_error (dupl_msg, name, &old_loc);
    1822                 :             :       else
    1823                 :          31 :         gfc_error ("Duplicated %qs clause at %L", name, &old_loc);
    1824                 :          33 :       return MATCH_ERROR;
    1825                 :             :     }
    1826                 :       15282 :   if (open_parens || expr)
    1827                 :             :     {
    1828                 :        8283 :       if (gfc_match (" ( ") != MATCH_YES)
    1829                 :             :         {
    1830                 :          22 :           gfc_error ("Expected %<(%> after %qs at %C", name);
    1831                 :          22 :           return MATCH_ERROR;
    1832                 :             :         }
    1833                 :        8261 :       if (expr)
    1834                 :             :         {
    1835                 :        4122 :           if (gfc_match ("%e )", expr) != MATCH_YES)
    1836                 :             :             {
    1837                 :           7 :               gfc_error ("Invalid expression after %<%s(%> at %C", name);
    1838                 :           7 :               return MATCH_ERROR;
    1839                 :             :             }
    1840                 :             :         }
    1841                 :             :     }
    1842                 :             :   return MATCH_YES;
    1843                 :             : }
    1844                 :             : 
    1845                 :             : static match
    1846                 :         207 : gfc_match_dupl_memorder (bool not_dupl, const char *name)
    1847                 :             : {
    1848                 :           0 :   return gfc_match_dupl_check (not_dupl, name, false, NULL,
    1849                 :             :                                "Duplicated memory-order clause: unexpected %s "
    1850                 :           0 :                                "clause at %L");
    1851                 :             : }
    1852                 :             : 
    1853                 :             : static match
    1854                 :        1157 : gfc_match_dupl_atomic (bool not_dupl, const char *name)
    1855                 :             : {
    1856                 :           0 :   return gfc_match_dupl_check (not_dupl, name, false, NULL,
    1857                 :             :                                "Duplicated atomic clause: unexpected %s "
    1858                 :           0 :                                "clause at %L");
    1859                 :             : }
    1860                 :             : 
    1861                 :             : /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
    1862                 :             :    clauses that are allowed for a particular directive.  */
    1863                 :             : 
    1864                 :             : static match
    1865                 :       30092 : gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
    1866                 :             :                        bool first = true, bool needs_space = true,
    1867                 :             :                        bool openacc = false, bool context_selector = false,
    1868                 :             :                        bool openmp_target = false)
    1869                 :             : {
    1870                 :       30092 :   bool error = false;
    1871                 :       30092 :   gfc_omp_clauses *c = gfc_get_omp_clauses ();
    1872                 :       30092 :   locus old_loc;
    1873                 :             :   /* Determine whether we're dealing with an OpenACC directive that permits
    1874                 :             :      derived type member accesses.  This in particular disallows
    1875                 :             :      "!$acc declare" from using such accesses, because it's not clear if/how
    1876                 :             :      that should work.  */
    1877                 :       30092 :   bool allow_derived = (openacc
    1878                 :       30092 :                         && ((mask & OMP_CLAUSE_ATTACH)
    1879                 :        5414 :                             || (mask & OMP_CLAUSE_DETACH)
    1880                 :        4908 :                             || (mask & OMP_CLAUSE_HOST_SELF)));
    1881                 :             : 
    1882                 :       30092 :   gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64);
    1883                 :       30092 :   *cp = NULL;
    1884                 :      110918 :   while (1)
    1885                 :             :     {
    1886                 :       70505 :       match m = MATCH_NO;
    1887                 :       52713 :       if ((first || (m = gfc_match_char (',')) != MATCH_YES)
    1888                 :      122903 :           && (needs_space && gfc_match_space () != MATCH_YES))
    1889                 :             :         break;
    1890                 :       63039 :       needs_space = false;
    1891                 :       63039 :       first = false;
    1892                 :       63039 :       gfc_gobble_whitespace ();
    1893                 :       63039 :       bool end_colon;
    1894                 :       63039 :       gfc_omp_namelist **head;
    1895                 :       63039 :       old_loc = gfc_current_locus;
    1896                 :       63039 :       char pc = gfc_peek_ascii_char ();
    1897                 :       63039 :       if (pc == '\n' && m == MATCH_YES)
    1898                 :             :         {
    1899                 :           1 :           gfc_error ("Clause expected at %C after trailing comma");
    1900                 :           1 :           goto error;
    1901                 :             :         }
    1902                 :       63038 :       switch (pc)
    1903                 :             :         {
    1904                 :        1185 :         case 'a':
    1905                 :        1185 :           end_colon = false;
    1906                 :        1185 :           head = NULL;
    1907                 :        1209 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    1908                 :        1185 :               && gfc_match ("absent ( ") == MATCH_YES)
    1909                 :             :             {
    1910                 :          27 :               if (gfc_omp_absent_contains_clause (&c->assume, true)
    1911                 :             :                   != MATCH_YES)
    1912                 :           3 :                 goto error;
    1913                 :          24 :               continue;
    1914                 :             :             }
    1915                 :        1158 :           if ((mask & OMP_CLAUSE_ALIGNED)
    1916                 :        1158 :               && gfc_match_omp_variable_list ("aligned (",
    1917                 :             :                                               &c->lists[OMP_LIST_ALIGNED],
    1918                 :             :                                               false, &end_colon,
    1919                 :             :                                               &head) == MATCH_YES)
    1920                 :             :             {
    1921                 :         112 :               gfc_expr *alignment = NULL;
    1922                 :         112 :               gfc_omp_namelist *n;
    1923                 :             : 
    1924                 :         112 :               if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
    1925                 :             :                 {
    1926                 :           0 :                   gfc_free_omp_namelist (*head, false, false, false);
    1927                 :           0 :                   gfc_current_locus = old_loc;
    1928                 :           0 :                   *head = NULL;
    1929                 :           0 :                   break;
    1930                 :             :                 }
    1931                 :         268 :               for (n = *head; n; n = n->next)
    1932                 :         156 :                 if (n->next && alignment)
    1933                 :          42 :                   n->expr = gfc_copy_expr (alignment);
    1934                 :             :                 else
    1935                 :         114 :                   n->expr = alignment;
    1936                 :         112 :               continue;
    1937                 :         112 :             }
    1938                 :        1056 :           if ((mask & OMP_CLAUSE_MEMORDER)
    1939                 :        1062 :               && (m = gfc_match_dupl_memorder ((c->memorder
    1940                 :          16 :                                                 == OMP_MEMORDER_UNSET),
    1941                 :             :                                                "acq_rel")) != MATCH_NO)
    1942                 :             :             {
    1943                 :          10 :               if (m == MATCH_ERROR)
    1944                 :           0 :                 goto error;
    1945                 :          10 :               c->memorder = OMP_MEMORDER_ACQ_REL;
    1946                 :          10 :               needs_space = true;
    1947                 :          10 :               continue;
    1948                 :             :             }
    1949                 :        1042 :           if ((mask & OMP_CLAUSE_MEMORDER)
    1950                 :        1042 :               && (m = gfc_match_dupl_memorder ((c->memorder
    1951                 :           6 :                                                 == OMP_MEMORDER_UNSET),
    1952                 :             :                                                "acquire")) != MATCH_NO)
    1953                 :             :             {
    1954                 :           6 :               if (m == MATCH_ERROR)
    1955                 :           0 :                 goto error;
    1956                 :           6 :               c->memorder = OMP_MEMORDER_ACQUIRE;
    1957                 :           6 :               needs_space = true;
    1958                 :           6 :               continue;
    1959                 :             :             }
    1960                 :        1030 :           if ((mask & OMP_CLAUSE_AFFINITY)
    1961                 :        1030 :               && gfc_match ("affinity ( ") == MATCH_YES)
    1962                 :             :             {
    1963                 :          41 :               gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
    1964                 :          41 :               m = gfc_match_iterator (&ns_iter, true);
    1965                 :          41 :               if (m == MATCH_ERROR)
    1966                 :             :                 break;
    1967                 :          31 :               if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
    1968                 :             :                 {
    1969                 :           1 :                   gfc_error ("Expected %<:%> at %C");
    1970                 :           1 :                   break;
    1971                 :             :                 }
    1972                 :          30 :               if (ns_iter)
    1973                 :          18 :                 gfc_current_ns = ns_iter;
    1974                 :          30 :               head = NULL;
    1975                 :          30 :               m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY],
    1976                 :             :                                                false, NULL, &head, true);
    1977                 :          30 :               gfc_current_ns = ns_curr;
    1978                 :          30 :               if (m == MATCH_ERROR)
    1979                 :             :                 break;
    1980                 :          27 :               if (ns_iter)
    1981                 :             :                 {
    1982                 :          45 :                   for (gfc_omp_namelist *n = *head; n; n = n->next)
    1983                 :             :                     {
    1984                 :          27 :                       n->u2.ns = ns_iter;
    1985                 :          27 :                       ns_iter->refs++;
    1986                 :             :                     }
    1987                 :             :                 }
    1988                 :          27 :               continue;
    1989                 :          27 :             }
    1990                 :         989 :           if ((mask & OMP_CLAUSE_ALLOCATE)
    1991                 :         989 :               && gfc_match ("allocate ( ") == MATCH_YES)
    1992                 :             :             {
    1993                 :         215 :               gfc_expr *allocator = NULL;
    1994                 :         215 :               gfc_expr *align = NULL;
    1995                 :         215 :               old_loc = gfc_current_locus;
    1996                 :         215 :               if ((m = gfc_match ("allocator ( %e )", &allocator)) == MATCH_YES)
    1997                 :           5 :                 gfc_match (" , align ( %e )", &align);
    1998                 :         210 :               else if ((m = gfc_match ("align ( %e )", &align)) == MATCH_YES)
    1999                 :          25 :                 gfc_match (" , allocator ( %e )", &allocator);
    2000                 :             : 
    2001                 :         215 :               if (m == MATCH_YES)
    2002                 :             :                 {
    2003                 :          30 :                   if (gfc_match (" : ") != MATCH_YES)
    2004                 :             :                     {
    2005                 :           5 :                       gfc_error ("Expected %<:%> at %C");
    2006                 :           7 :                       goto error;
    2007                 :             :                     }
    2008                 :             :                 }
    2009                 :             :               else
    2010                 :             :                 {
    2011                 :         185 :                   m = gfc_match_expr (&allocator);
    2012                 :         185 :                   if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
    2013                 :             :                     {
    2014                 :             :                        /* If no ":" then there is no allocator, we backtrack
    2015                 :             :                           and read the variable list.  */
    2016                 :          93 :                       gfc_free_expr (allocator);
    2017                 :          93 :                       allocator = NULL;
    2018                 :          93 :                       gfc_current_locus = old_loc;
    2019                 :             :                     }
    2020                 :             :                 }
    2021                 :         210 :               gfc_omp_namelist **head = NULL;
    2022                 :         210 :               m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
    2023                 :             :                                                true, NULL, &head);
    2024                 :             : 
    2025                 :         210 :               if (m != MATCH_YES)
    2026                 :             :                 {
    2027                 :           2 :                   gfc_free_expr (allocator);
    2028                 :           2 :                   gfc_free_expr (align);
    2029                 :           2 :                   gfc_error ("Expected variable list at %C");
    2030                 :           2 :                   goto error;
    2031                 :             :                 }
    2032                 :             : 
    2033                 :         587 :               for (gfc_omp_namelist *n = *head; n; n = n->next)
    2034                 :             :                 {
    2035                 :         758 :                   n->u2.allocator = ((allocator)
    2036                 :         379 :                                      ? gfc_copy_expr (allocator) : NULL);
    2037                 :         379 :                   n->u.align = (align) ? gfc_copy_expr (align) : NULL;
    2038                 :             :                 }
    2039                 :         208 :               gfc_free_expr (allocator);
    2040                 :         208 :               gfc_free_expr (align);
    2041                 :         208 :               continue;
    2042                 :         208 :             }
    2043                 :         821 :           if ((mask & OMP_CLAUSE_AT)
    2044                 :         774 :               && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
    2045                 :             :                  != MATCH_NO)
    2046                 :             :             {
    2047                 :          53 :               if (m == MATCH_ERROR)
    2048                 :           2 :                 goto error;
    2049                 :          51 :               if (gfc_match ("compilation )") == MATCH_YES)
    2050                 :          14 :                 c->at = OMP_AT_COMPILATION;
    2051                 :          37 :               else if (gfc_match ("execution )") == MATCH_YES)
    2052                 :          33 :                 c->at = OMP_AT_EXECUTION;
    2053                 :             :               else
    2054                 :             :                 {
    2055                 :           4 :                   gfc_error ("Expected COMPILATION or EXECUTION in AT clause "
    2056                 :             :                              "at %C");
    2057                 :           4 :                   goto error;
    2058                 :             :                 }
    2059                 :          47 :               continue;
    2060                 :             :             }
    2061                 :        1334 :           if ((mask & OMP_CLAUSE_ASYNC)
    2062                 :         721 :               && (m = gfc_match_dupl_check (!c->async, "async")) != MATCH_NO)
    2063                 :             :             {
    2064                 :         613 :               if (m == MATCH_ERROR)
    2065                 :           0 :                 goto error;
    2066                 :         613 :               c->async = true;
    2067                 :         613 :               m = gfc_match (" ( %e )", &c->async_expr);
    2068                 :         613 :               if (m == MATCH_ERROR)
    2069                 :             :                 {
    2070                 :           0 :                   gfc_current_locus = old_loc;
    2071                 :           0 :                   break;
    2072                 :             :                 }
    2073                 :         613 :               else if (m == MATCH_NO)
    2074                 :             :                 {
    2075                 :         126 :                   c->async_expr
    2076                 :         126 :                     = gfc_get_constant_expr (BT_INTEGER,
    2077                 :             :                                              gfc_default_integer_kind,
    2078                 :             :                                              &gfc_current_locus);
    2079                 :         126 :                   mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL);
    2080                 :         126 :                   needs_space = true;
    2081                 :             :                 }
    2082                 :         613 :               continue;
    2083                 :             :             }
    2084                 :         155 :           if ((mask & OMP_CLAUSE_AUTO)
    2085                 :         108 :               && (m = gfc_match_dupl_check (!c->par_auto, "auto"))
    2086                 :             :                  != MATCH_NO)
    2087                 :             :             {
    2088                 :          47 :               if (m == MATCH_ERROR)
    2089                 :           0 :                 goto error;
    2090                 :          47 :               c->par_auto = true;
    2091                 :          47 :               needs_space = true;
    2092                 :          47 :               continue;
    2093                 :             :             }
    2094                 :         120 :           if ((mask & OMP_CLAUSE_ATTACH)
    2095                 :          59 :               && gfc_match ("attach ( ") == MATCH_YES
    2096                 :         120 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2097                 :             :                                            OMP_MAP_ATTACH, false,
    2098                 :             :                                            allow_derived))
    2099                 :          59 :             continue;
    2100                 :             :           break;
    2101                 :          36 :         case 'b':
    2102                 :          70 :           if ((mask & OMP_CLAUSE_BIND)
    2103                 :          36 :               && (m = gfc_match_dupl_check (c->bind == OMP_BIND_UNSET, "bind",
    2104                 :             :                                             true)) != MATCH_NO)
    2105                 :             :             {
    2106                 :          36 :               if (m == MATCH_ERROR)
    2107                 :           1 :                 goto error;
    2108                 :          35 :               if (gfc_match ("teams )") == MATCH_YES)
    2109                 :          11 :                 c->bind = OMP_BIND_TEAMS;
    2110                 :          24 :               else if (gfc_match ("parallel )") == MATCH_YES)
    2111                 :          15 :                 c->bind = OMP_BIND_PARALLEL;
    2112                 :           9 :               else if (gfc_match ("thread )") == MATCH_YES)
    2113                 :           8 :                 c->bind = OMP_BIND_THREAD;
    2114                 :             :               else
    2115                 :             :                 {
    2116                 :           1 :                   gfc_error ("Expected TEAMS, PARALLEL or THREAD as binding in "
    2117                 :             :                              "BIND at %C");
    2118                 :           1 :                   break;
    2119                 :             :                 }
    2120                 :          34 :               continue;
    2121                 :             :             }
    2122                 :             :           break;
    2123                 :        6575 :         case 'c':
    2124                 :        6864 :           if ((mask & OMP_CLAUSE_CAPTURE)
    2125                 :        6575 :               && (m = gfc_match_dupl_check (!c->capture, "capture"))
    2126                 :             :                  != MATCH_NO)
    2127                 :             :             {
    2128                 :         290 :               if (m == MATCH_ERROR)
    2129                 :           1 :                 goto error;
    2130                 :         289 :               c->capture = true;
    2131                 :         289 :               needs_space = true;
    2132                 :         289 :               continue;
    2133                 :             :             }
    2134                 :        6285 :           if (mask & OMP_CLAUSE_COLLAPSE)
    2135                 :             :             {
    2136                 :        1886 :               gfc_expr *cexpr = NULL;
    2137                 :        1886 :               if ((m = gfc_match_dupl_check (!c->collapse, "collapse", true,
    2138                 :             :                                              &cexpr)) != MATCH_NO)
    2139                 :             :               {
    2140                 :        1405 :                 int collapse;
    2141                 :        1405 :                 if (m == MATCH_ERROR)
    2142                 :           0 :                   goto error;
    2143                 :        1405 :                 if (gfc_extract_int (cexpr, &collapse, -1))
    2144                 :           4 :                   collapse = 1;
    2145                 :        1401 :                 else if (collapse <= 0)
    2146                 :             :                   {
    2147                 :           8 :                     gfc_error_now ("COLLAPSE clause argument not constant "
    2148                 :             :                                    "positive integer at %C");
    2149                 :           8 :                     collapse = 1;
    2150                 :             :                   }
    2151                 :        1405 :                 gfc_free_expr (cexpr);
    2152                 :        1405 :                 c->collapse = collapse;
    2153                 :        1405 :                 continue;
    2154                 :        1405 :               }
    2155                 :             :             }
    2156                 :        5046 :           if ((mask & OMP_CLAUSE_COMPARE)
    2157                 :        4880 :               && (m = gfc_match_dupl_check (!c->compare, "compare"))
    2158                 :             :                  != MATCH_NO)
    2159                 :             :             {
    2160                 :         167 :               if (m == MATCH_ERROR)
    2161                 :           1 :                 goto error;
    2162                 :         166 :               c->compare = true;
    2163                 :         166 :               needs_space = true;
    2164                 :         166 :               continue;
    2165                 :             :             }
    2166                 :        4723 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    2167                 :        4713 :               && gfc_match ("contains ( ") == MATCH_YES)
    2168                 :             :             {
    2169                 :          10 :               if (gfc_omp_absent_contains_clause (&c->assume, false)
    2170                 :             :                   != MATCH_YES)
    2171                 :           0 :                 goto error;
    2172                 :          10 :               continue;
    2173                 :             :             }
    2174                 :        6791 :           if ((mask & OMP_CLAUSE_COPY)
    2175                 :        3382 :               && gfc_match ("copy ( ") == MATCH_YES
    2176                 :        6792 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2177                 :             :                                            OMP_MAP_TOFROM, true,
    2178                 :             :                                            allow_derived))
    2179                 :        2088 :             continue;
    2180                 :        2615 :           if (mask & OMP_CLAUSE_COPYIN)
    2181                 :             :             {
    2182                 :        2217 :               if (openacc)
    2183                 :             :                 {
    2184                 :        2118 :                   if (gfc_match ("copyin ( ") == MATCH_YES
    2185                 :        2118 :                       && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2186                 :             :                                                    OMP_MAP_TO, true,
    2187                 :             :                                                    allow_derived))
    2188                 :        1197 :                     continue;
    2189                 :             :                 }
    2190                 :          99 :               else if (gfc_match_omp_variable_list ("copyin (",
    2191                 :             :                                                     &c->lists[OMP_LIST_COPYIN],
    2192                 :             :                                                     true) == MATCH_YES)
    2193                 :          97 :                 continue;
    2194                 :             :             }
    2195                 :        2233 :           if ((mask & OMP_CLAUSE_COPYOUT)
    2196                 :        1054 :               && gfc_match ("copyout ( ") == MATCH_YES
    2197                 :        2233 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2198                 :             :                                            OMP_MAP_FROM, true, allow_derived))
    2199                 :         912 :             continue;
    2200                 :         493 :           if ((mask & OMP_CLAUSE_COPYPRIVATE)
    2201                 :         409 :               && gfc_match_omp_variable_list ("copyprivate (",
    2202                 :             :                                               &c->lists[OMP_LIST_COPYPRIVATE],
    2203                 :             :                                               true) == MATCH_YES)
    2204                 :          84 :             continue;
    2205                 :         641 :           if ((mask & OMP_CLAUSE_CREATE)
    2206                 :         323 :               && gfc_match ("create ( ") == MATCH_YES
    2207                 :         641 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2208                 :             :                                            OMP_MAP_ALLOC, true, allow_derived))
    2209                 :         316 :             continue;
    2210                 :             :           break;
    2211                 :        3312 :         case 'd':
    2212                 :        3312 :           if ((mask & OMP_CLAUSE_DEFAULTMAP)
    2213                 :        3312 :               && gfc_match ("defaultmap ( ") == MATCH_YES)
    2214                 :             :             {
    2215                 :         159 :               enum gfc_omp_defaultmap behavior;
    2216                 :         159 :               gfc_omp_defaultmap_category category
    2217                 :             :                 = OMP_DEFAULTMAP_CAT_UNCATEGORIZED;
    2218                 :         159 :               if (gfc_match ("alloc ") == MATCH_YES)
    2219                 :             :                 behavior = OMP_DEFAULTMAP_ALLOC;
    2220                 :         153 :               else if (gfc_match ("tofrom ") == MATCH_YES)
    2221                 :             :                 behavior = OMP_DEFAULTMAP_TOFROM;
    2222                 :         122 :               else if (gfc_match ("to ") == MATCH_YES)
    2223                 :             :                 behavior = OMP_DEFAULTMAP_TO;
    2224                 :         117 :               else if (gfc_match ("from ") == MATCH_YES)
    2225                 :             :                 behavior = OMP_DEFAULTMAP_FROM;
    2226                 :         114 :               else if (gfc_match ("firstprivate ") == MATCH_YES)
    2227                 :             :                 behavior = OMP_DEFAULTMAP_FIRSTPRIVATE;
    2228                 :          83 :               else if (gfc_match ("present ") == MATCH_YES)
    2229                 :             :                 behavior = OMP_DEFAULTMAP_PRESENT;
    2230                 :          79 :               else if (gfc_match ("none ") == MATCH_YES)
    2231                 :             :                 behavior = OMP_DEFAULTMAP_NONE;
    2232                 :          10 :               else if (gfc_match ("default ") == MATCH_YES)
    2233                 :             :                 behavior = OMP_DEFAULTMAP_DEFAULT;
    2234                 :             :               else
    2235                 :             :                 {
    2236                 :           1 :                   gfc_error ("Expected ALLOC, TO, FROM, TOFROM, FIRSTPRIVATE, "
    2237                 :             :                              "PRESENT, NONE or DEFAULT at %C");
    2238                 :           1 :                   break;
    2239                 :             :                 }
    2240                 :         158 :               if (')' == gfc_peek_ascii_char ())
    2241                 :             :                 ;
    2242                 :          88 :               else if (gfc_match (": ") != MATCH_YES)
    2243                 :             :                 break;
    2244                 :             :               else
    2245                 :             :                 {
    2246                 :          88 :                   if (gfc_match ("scalar ") == MATCH_YES)
    2247                 :             :                     category = OMP_DEFAULTMAP_CAT_SCALAR;
    2248                 :          56 :                   else if (gfc_match ("aggregate ") == MATCH_YES)
    2249                 :             :                     category = OMP_DEFAULTMAP_CAT_AGGREGATE;
    2250                 :          35 :                   else if (gfc_match ("allocatable ") == MATCH_YES)
    2251                 :             :                     category = OMP_DEFAULTMAP_CAT_ALLOCATABLE;
    2252                 :          23 :                   else if (gfc_match ("pointer ") == MATCH_YES)
    2253                 :             :                     category = OMP_DEFAULTMAP_CAT_POINTER;
    2254                 :           9 :                   else if (gfc_match ("all ") == MATCH_YES)
    2255                 :             :                     category = OMP_DEFAULTMAP_CAT_ALL;
    2256                 :             :                   else
    2257                 :             :                     {
    2258                 :           1 :                       gfc_error ("Expected SCALAR, AGGREGATE, ALLOCATABLE, "
    2259                 :             :                                  "POINTER or ALL at %C");
    2260                 :           1 :                       break;
    2261                 :             :                     }
    2262                 :             :                 }
    2263                 :        1046 :               for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; ++i)
    2264                 :             :                 {
    2265                 :         902 :                   if (i != category
    2266                 :         902 :                       && category != OMP_DEFAULTMAP_CAT_UNCATEGORIZED
    2267                 :         416 :                       && category != OMP_DEFAULTMAP_CAT_ALL
    2268                 :         416 :                       && i != OMP_DEFAULTMAP_CAT_UNCATEGORIZED
    2269                 :         305 :                       && i != OMP_DEFAULTMAP_CAT_ALL)
    2270                 :         227 :                     continue;
    2271                 :         675 :                   if (c->defaultmap[i] != OMP_DEFAULTMAP_UNSET)
    2272                 :             :                     {
    2273                 :          13 :                       const char *pcategory = NULL;
    2274                 :          13 :                       switch (i)
    2275                 :             :                         {
    2276                 :             :                         case OMP_DEFAULTMAP_CAT_UNCATEGORIZED: break;
    2277                 :             :                         case OMP_DEFAULTMAP_CAT_ALL: pcategory = "ALL"; break;
    2278                 :           1 :                         case OMP_DEFAULTMAP_CAT_SCALAR: pcategory = "SCALAR"; break;
    2279                 :           2 :                         case OMP_DEFAULTMAP_CAT_AGGREGATE:
    2280                 :           2 :                           pcategory = "AGGREGATE";
    2281                 :           2 :                           break;
    2282                 :           1 :                         case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
    2283                 :           1 :                           pcategory = "ALLOCATABLE";
    2284                 :           1 :                           break;
    2285                 :           2 :                         case OMP_DEFAULTMAP_CAT_POINTER:
    2286                 :           2 :                           pcategory = "POINTER";
    2287                 :           2 :                           break;
    2288                 :             :                         default: gcc_unreachable ();
    2289                 :             :                         }
    2290                 :           6 :                      if (i == OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
    2291                 :           4 :                       gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP with "
    2292                 :             :                                  "unspecified category");
    2293                 :             :                      else
    2294                 :           9 :                       gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for "
    2295                 :             :                                  "category %s", pcategory);
    2296                 :          13 :                      goto error;
    2297                 :             :                     }
    2298                 :             :                 }
    2299                 :         144 :               c->defaultmap[category] = behavior;
    2300                 :         144 :               if (gfc_match (")") != MATCH_YES)
    2301                 :             :                 break;
    2302                 :         144 :               continue;
    2303                 :         144 :             }
    2304                 :        4073 :           if ((mask & OMP_CLAUSE_DEFAULT)
    2305                 :        3153 :               && (m = gfc_match_dupl_check (c->default_sharing
    2306                 :             :                                             == OMP_DEFAULT_UNKNOWN, "default",
    2307                 :             :                                             true)) != MATCH_NO)
    2308                 :             :             {
    2309                 :         950 :               if (m == MATCH_ERROR)
    2310                 :           4 :                 goto error;
    2311                 :         946 :               if (gfc_match ("none") == MATCH_YES)
    2312                 :         552 :                 c->default_sharing = OMP_DEFAULT_NONE;
    2313                 :         394 :               else if (openacc)
    2314                 :             :                 {
    2315                 :         210 :                   if (gfc_match ("present") == MATCH_YES)
    2316                 :         190 :                     c->default_sharing = OMP_DEFAULT_PRESENT;
    2317                 :             :                 }
    2318                 :             :               else
    2319                 :             :                 {
    2320                 :         184 :                   if (gfc_match ("firstprivate") == MATCH_YES)
    2321                 :           7 :                     c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
    2322                 :         177 :                   else if (gfc_match ("private") == MATCH_YES)
    2323                 :          24 :                     c->default_sharing = OMP_DEFAULT_PRIVATE;
    2324                 :         153 :                   else if (gfc_match ("shared") == MATCH_YES)
    2325                 :         153 :                     c->default_sharing = OMP_DEFAULT_SHARED;
    2326                 :             :                 }
    2327                 :         946 :               if (c->default_sharing == OMP_DEFAULT_UNKNOWN)
    2328                 :             :                 {
    2329                 :          20 :                   if (openacc)
    2330                 :          20 :                     gfc_error ("Expected NONE or PRESENT in DEFAULT clause "
    2331                 :             :                                "at %C");
    2332                 :             :                   else
    2333                 :           0 :                     gfc_error ("Expected NONE, FIRSTPRIVATE, PRIVATE or SHARED "
    2334                 :             :                                "in DEFAULT clause at %C");
    2335                 :          20 :                   goto error;
    2336                 :             :                 }
    2337                 :         926 :               if (gfc_match (" )") != MATCH_YES)
    2338                 :           6 :                 goto error;
    2339                 :         920 :               continue;
    2340                 :             :             }
    2341                 :        2415 :           if ((mask & OMP_CLAUSE_DELETE)
    2342                 :         247 :               && gfc_match ("delete ( ") == MATCH_YES
    2343                 :        2415 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2344                 :             :                                            OMP_MAP_RELEASE, true,
    2345                 :             :                                            allow_derived))
    2346                 :         212 :             continue;
    2347                 :             :           /* DOACROSS: match 'doacross' and 'depend' with sink/source.
    2348                 :             :              DEPEND: match 'depend' but not sink/source.  */
    2349                 :        1991 :           m = MATCH_NO;
    2350                 :        1991 :           if (((mask & OMP_CLAUSE_DOACROSS)
    2351                 :         381 :                && gfc_match ("doacross ( ") == MATCH_YES)
    2352                 :        2345 :               || (((mask & OMP_CLAUSE_DEPEND) || (mask & OMP_CLAUSE_DOACROSS))
    2353                 :        1437 :                   && (m = gfc_match ("depend ( ")) == MATCH_YES))
    2354                 :             :             {
    2355                 :        1073 :               bool has_omp_all_memory;
    2356                 :        1073 :               bool is_depend = m == MATCH_YES;
    2357                 :        1073 :               gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
    2358                 :        1073 :               match m_it = MATCH_NO;
    2359                 :        1073 :               if (is_depend)
    2360                 :        1046 :                 m_it = gfc_match_iterator (&ns_iter, false);
    2361                 :        1046 :               if (m_it == MATCH_ERROR)
    2362                 :             :                 break;
    2363                 :        1068 :               if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
    2364                 :             :                 break;
    2365                 :        1068 :               m = MATCH_YES;
    2366                 :        1068 :               gfc_omp_depend_doacross_op depend_op = OMP_DEPEND_OUT;
    2367                 :        1068 :               if (gfc_match ("inoutset") == MATCH_YES)
    2368                 :             :                 depend_op = OMP_DEPEND_INOUTSET;
    2369                 :        1056 :               else if (gfc_match ("inout") == MATCH_YES)
    2370                 :             :                 depend_op = OMP_DEPEND_INOUT;
    2371                 :         982 :               else if (gfc_match ("in") == MATCH_YES)
    2372                 :             :                 depend_op = OMP_DEPEND_IN;
    2373                 :         697 :               else if (gfc_match ("out") == MATCH_YES)
    2374                 :             :                 depend_op = OMP_DEPEND_OUT;
    2375                 :         437 :               else if (gfc_match ("mutexinoutset") == MATCH_YES)
    2376                 :             :                 depend_op = OMP_DEPEND_MUTEXINOUTSET;
    2377                 :         419 :               else if (gfc_match ("depobj") == MATCH_YES)
    2378                 :             :                 depend_op = OMP_DEPEND_DEPOBJ;
    2379                 :         385 :               else if (gfc_match ("source") == MATCH_YES)
    2380                 :             :                 {
    2381                 :         142 :                   if (m_it == MATCH_YES)
    2382                 :             :                     {
    2383                 :           1 :                       gfc_error ("ITERATOR may not be combined with SOURCE "
    2384                 :             :                                  "at %C");
    2385                 :          17 :                       goto error;
    2386                 :             :                     }
    2387                 :         141 :                   if (!(mask & OMP_CLAUSE_DOACROSS))
    2388                 :             :                     {
    2389                 :           1 :                       gfc_error ("SOURCE at %C not permitted as dependence-type"
    2390                 :             :                                  " for this directive");
    2391                 :           1 :                       goto error;
    2392                 :             :                     }
    2393                 :         140 :                   if (c->doacross_source)
    2394                 :             :                     {
    2395                 :           0 :                       gfc_error ("Duplicated clause with SOURCE dependence-type"
    2396                 :             :                                  " at %C");
    2397                 :           0 :                       goto error;
    2398                 :             :                     }
    2399                 :         140 :                   gfc_gobble_whitespace ();
    2400                 :         140 :                   m = gfc_match (": ");
    2401                 :         140 :                   if (m != MATCH_YES && !is_depend)
    2402                 :             :                     {
    2403                 :           1 :                       gfc_error ("Expected %<:%> at %C");
    2404                 :           1 :                       goto error;
    2405                 :             :                     }
    2406                 :         139 :                   if (gfc_match (")") != MATCH_YES
    2407                 :         145 :                       && !(m == MATCH_YES
    2408                 :           6 :                            && gfc_match ("omp_cur_iteration )") == MATCH_YES))
    2409                 :             :                     {
    2410                 :           2 :                       gfc_error ("Expected %<)%> or %<omp_cur_iteration)%> "
    2411                 :             :                                  "at %C");
    2412                 :           2 :                       goto error;
    2413                 :             :                     }
    2414                 :         137 :                   c->doacross_source = true;
    2415                 :         137 :                   c->depend_source = is_depend;
    2416                 :        1051 :                   continue;
    2417                 :             :                 }
    2418                 :         243 :               else if (gfc_match ("sink ") == MATCH_YES)
    2419                 :             :                 {
    2420                 :         243 :                   if (!(mask & OMP_CLAUSE_DOACROSS))
    2421                 :             :                     {
    2422                 :           2 :                       gfc_error ("SINK at %C not permitted as dependence-type "
    2423                 :             :                                  "for this directive");
    2424                 :           2 :                       goto error;
    2425                 :             :                     }
    2426                 :         241 :                   if (gfc_match (": ") != MATCH_YES)
    2427                 :             :                     {
    2428                 :           1 :                       gfc_error ("Expected %<:%> at %C");
    2429                 :           1 :                       goto error;
    2430                 :             :                     }
    2431                 :         240 :                   if (m_it == MATCH_YES)
    2432                 :             :                     {
    2433                 :           0 :                       gfc_error ("ITERATOR may not be combined with SINK "
    2434                 :             :                                  "at %C");
    2435                 :           0 :                       goto error;
    2436                 :             :                     }
    2437                 :         240 :                   m = gfc_match_omp_doacross_sink (&c->lists[OMP_LIST_DEPEND],
    2438                 :             :                                                    is_depend);
    2439                 :         240 :                   if (m == MATCH_YES)
    2440                 :         237 :                     continue;
    2441                 :           3 :                   goto error;
    2442                 :             :                 }
    2443                 :             :               else
    2444                 :             :                 m = MATCH_NO;
    2445                 :         683 :               if (!(mask & OMP_CLAUSE_DEPEND))
    2446                 :             :                 {
    2447                 :           0 :                   gfc_error ("Expected dependence-type SINK or SOURCE at %C");
    2448                 :           0 :                   goto error;
    2449                 :             :                 }
    2450                 :         683 :               head = NULL;
    2451                 :         683 :               if (ns_iter)
    2452                 :          37 :                 gfc_current_ns = ns_iter;
    2453                 :         683 :               if (m == MATCH_YES)
    2454                 :         683 :                 m = gfc_match_omp_variable_list (" : ",
    2455                 :             :                                                  &c->lists[OMP_LIST_DEPEND],
    2456                 :             :                                                  false, NULL, &head, true,
    2457                 :             :                                                  false, &has_omp_all_memory);
    2458                 :         683 :               if (m != MATCH_YES)
    2459                 :           2 :                 goto error;
    2460                 :         681 :               gfc_current_ns = ns_curr;
    2461                 :         681 :               if (has_omp_all_memory && depend_op != OMP_DEPEND_INOUT
    2462                 :          21 :                   && depend_op != OMP_DEPEND_OUT)
    2463                 :             :                 {
    2464                 :           4 :                   gfc_error ("%<omp_all_memory%> used with DEPEND kind "
    2465                 :             :                              "other than OUT or INOUT at %C");
    2466                 :           4 :                   goto error;
    2467                 :             :                 }
    2468                 :         677 :               gfc_omp_namelist *n;
    2469                 :        1382 :               for (n = *head; n; n = n->next)
    2470                 :             :                 {
    2471                 :         705 :                   n->u.depend_doacross_op = depend_op;
    2472                 :         705 :                   n->u2.ns = ns_iter;
    2473                 :         705 :                   if (ns_iter)
    2474                 :          36 :                     ns_iter->refs++;
    2475                 :             :                 }
    2476                 :         677 :               continue;
    2477                 :         677 :             }
    2478                 :        1044 :           if ((mask & OMP_CLAUSE_DETACH)
    2479                 :         162 :               && !openacc
    2480                 :         127 :               && !c->detach
    2481                 :        1044 :               && gfc_match_omp_detach (&c->detach) == MATCH_YES)
    2482                 :         126 :             continue;
    2483                 :         827 :           if ((mask & OMP_CLAUSE_DETACH)
    2484                 :          36 :               && openacc
    2485                 :          35 :               && gfc_match ("detach ( ") == MATCH_YES
    2486                 :         827 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2487                 :             :                                            OMP_MAP_DETACH, false,
    2488                 :             :                                            allow_derived))
    2489                 :          35 :             continue;
    2490                 :         757 :           if ((mask & OMP_CLAUSE_DEVICE)
    2491                 :         555 :               && !openacc
    2492                 :        1034 :               && ((m = gfc_match_dupl_check (!c->device, "device", true))
    2493                 :             :                   != MATCH_NO))
    2494                 :             :             {
    2495                 :         251 :               if (m == MATCH_ERROR)
    2496                 :           0 :                 goto error;
    2497                 :         251 :               c->ancestor = false;
    2498                 :         251 :               if (gfc_match ("device_num : ") == MATCH_YES)
    2499                 :             :                 {
    2500                 :          16 :                   if (gfc_match ("%e )", &c->device) != MATCH_YES)
    2501                 :             :                     {
    2502                 :           1 :                       gfc_error ("Expected integer expression at %C");
    2503                 :           1 :                       break;
    2504                 :             :                     }
    2505                 :             :                 }
    2506                 :         235 :               else if (gfc_match ("ancestor : ") == MATCH_YES)
    2507                 :             :                 {
    2508                 :          45 :                   bool has_requires = false;
    2509                 :          45 :                   c->ancestor = true;
    2510                 :          82 :                   for (gfc_namespace *ns = gfc_current_ns; ns; ns = ns->parent)
    2511                 :          80 :                     if (ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)
    2512                 :             :                       {
    2513                 :             :                         has_requires = true;
    2514                 :             :                         break;
    2515                 :             :                       }
    2516                 :          45 :                   if (!has_requires)
    2517                 :             :                     {
    2518                 :           2 :                       gfc_error ("%<ancestor%> device modifier not "
    2519                 :             :                                  "preceded by %<requires%> directive "
    2520                 :             :                                  "with %<reverse_offload%> clause at %C");
    2521                 :           2 :                       break;
    2522                 :             :                     }
    2523                 :          43 :                   locus old_loc2 = gfc_current_locus;
    2524                 :          43 :                   if (gfc_match ("%e )", &c->device) == MATCH_YES)
    2525                 :             :                     {
    2526                 :          43 :                       int device = 0;
    2527                 :          43 :                       if (!gfc_extract_int (c->device, &device) && device != 1)
    2528                 :             :                       {
    2529                 :           1 :                         gfc_current_locus = old_loc2;
    2530                 :           1 :                         gfc_error ("the %<device%> clause expression must "
    2531                 :             :                                    "evaluate to %<1%> at %C");
    2532                 :           1 :                         break;
    2533                 :             :                       }
    2534                 :             :                     }
    2535                 :             :                   else
    2536                 :             :                     {
    2537                 :           0 :                       gfc_error ("Expected integer expression at %C");
    2538                 :           0 :                       break;
    2539                 :             :                     }
    2540                 :             :                 }
    2541                 :         190 :               else if (gfc_match ("%e )", &c->device) != MATCH_YES)
    2542                 :             :                 {
    2543                 :          13 :                   gfc_error ("Expected integer expression or a single device-"
    2544                 :             :                               "modifier %<device_num%> or %<ancestor%> at %C");
    2545                 :          13 :                   break;
    2546                 :             :                 }
    2547                 :         234 :               continue;
    2548                 :         234 :             }
    2549                 :         782 :           if ((mask & OMP_CLAUSE_DEVICE)
    2550                 :         304 :               && openacc
    2551                 :         278 :               && gfc_match ("device ( ") == MATCH_YES
    2552                 :         783 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2553                 :             :                                            OMP_MAP_FORCE_TO, true,
    2554                 :             :                                            allow_derived))
    2555                 :         276 :             continue;
    2556                 :         261 :           if ((mask & OMP_CLAUSE_DEVICEPTR)
    2557                 :          80 :               && gfc_match ("deviceptr ( ") == MATCH_YES
    2558                 :         263 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2559                 :             :                                            OMP_MAP_FORCE_DEVICEPTR, false,
    2560                 :             :                                            allow_derived))
    2561                 :          31 :             continue;
    2562                 :         247 :           if ((mask & OMP_CLAUSE_DEVICE_TYPE)
    2563                 :         199 :               && gfc_match ("device_type ( ") == MATCH_YES)
    2564                 :             :             {
    2565                 :          49 :               if (gfc_match ("host") == MATCH_YES)
    2566                 :          16 :                 c->device_type = OMP_DEVICE_TYPE_HOST;
    2567                 :          33 :               else if (gfc_match ("nohost") == MATCH_YES)
    2568                 :          16 :                 c->device_type = OMP_DEVICE_TYPE_NOHOST;
    2569                 :          17 :               else if (gfc_match ("any") == MATCH_YES)
    2570                 :          16 :                 c->device_type = OMP_DEVICE_TYPE_ANY;
    2571                 :             :               else
    2572                 :             :                 {
    2573                 :           1 :                   gfc_error ("Expected HOST, NOHOST or ANY at %C");
    2574                 :           1 :                   break;
    2575                 :             :                 }
    2576                 :          48 :               if (gfc_match (" )") != MATCH_YES)
    2577                 :             :                 break;
    2578                 :          48 :               continue;
    2579                 :             :             }
    2580                 :         196 :           if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
    2581                 :         197 :               && gfc_match_omp_variable_list
    2582                 :          47 :                    ("device_resident (",
    2583                 :             :                     &c->lists[OMP_LIST_DEVICE_RESIDENT], true) == MATCH_YES)
    2584                 :          46 :             continue;
    2585                 :         104 :           if ((mask & OMP_CLAUSE_DIST_SCHEDULE)
    2586                 :          97 :               && c->dist_sched_kind == OMP_SCHED_NONE
    2587                 :         201 :               && gfc_match ("dist_schedule ( static") == MATCH_YES)
    2588                 :             :             {
    2589                 :          97 :               m = MATCH_NO;
    2590                 :          97 :               c->dist_sched_kind = OMP_SCHED_STATIC;
    2591                 :          97 :               m = gfc_match (" , %e )", &c->dist_chunk_size);
    2592                 :          97 :               if (m != MATCH_YES)
    2593                 :          14 :                 m = gfc_match_char (')');
    2594                 :          14 :               if (m != MATCH_YES)
    2595                 :             :                 {
    2596                 :           0 :                   c->dist_sched_kind = OMP_SCHED_NONE;
    2597                 :           0 :                   gfc_current_locus = old_loc;
    2598                 :             :                 }
    2599                 :             :               else
    2600                 :          97 :                 continue;
    2601                 :             :             }
    2602                 :             :           break;
    2603                 :          57 :         case 'e':
    2604                 :          57 :           if ((mask & OMP_CLAUSE_ENTER))
    2605                 :             :             {
    2606                 :          57 :               m = gfc_match_omp_to_link ("enter (", &c->lists[OMP_LIST_ENTER]);
    2607                 :          57 :               if (m == MATCH_ERROR)
    2608                 :           0 :                 goto error;
    2609                 :          57 :               if (m == MATCH_YES)
    2610                 :          57 :                 continue;
    2611                 :             :             }
    2612                 :             :           break;
    2613                 :        2131 :         case 'f':
    2614                 :        2180 :           if ((mask & OMP_CLAUSE_FAIL)
    2615                 :        2131 :               && (m = gfc_match_dupl_check (c->fail == OMP_MEMORDER_UNSET,
    2616                 :             :                                             "fail", true)) != MATCH_NO)
    2617                 :             :             {
    2618                 :          58 :               if (m == MATCH_ERROR)
    2619                 :           3 :                 goto error;
    2620                 :          55 :               if (gfc_match ("seq_cst") == MATCH_YES)
    2621                 :           6 :                 c->fail = OMP_MEMORDER_SEQ_CST;
    2622                 :          49 :               else if (gfc_match ("acquire") == MATCH_YES)
    2623                 :          14 :                 c->fail = OMP_MEMORDER_ACQUIRE;
    2624                 :          35 :               else if (gfc_match ("relaxed") == MATCH_YES)
    2625                 :          30 :                 c->fail = OMP_MEMORDER_RELAXED;
    2626                 :             :               else
    2627                 :             :                 {
    2628                 :           5 :                   gfc_error ("Expected SEQ_CST, ACQUIRE or RELAXED at %C");
    2629                 :           5 :                   break;
    2630                 :             :                 }
    2631                 :          50 :               if (gfc_match (" )") != MATCH_YES)
    2632                 :           1 :                 goto error;
    2633                 :          49 :               continue;
    2634                 :             :             }
    2635                 :        2116 :           if ((mask & OMP_CLAUSE_FILTER)
    2636                 :        2073 :               && (m = gfc_match_dupl_check (!c->filter, "filter", true,
    2637                 :             :                                             &c->filter)) != MATCH_NO)
    2638                 :             :             {
    2639                 :          44 :               if (m == MATCH_ERROR)
    2640                 :           1 :                 goto error;
    2641                 :          43 :               continue;
    2642                 :             :             }
    2643                 :        2093 :           if ((mask & OMP_CLAUSE_FINAL)
    2644                 :        2029 :               && (m = gfc_match_dupl_check (!c->final_expr, "final", true,
    2645                 :             :                                             &c->final_expr)) != MATCH_NO)
    2646                 :             :             {
    2647                 :          64 :               if (m == MATCH_ERROR)
    2648                 :           0 :                 goto error;
    2649                 :          64 :               continue;
    2650                 :             :             }
    2651                 :        1981 :           if ((mask & OMP_CLAUSE_FINALIZE)
    2652                 :        1965 :               && (m = gfc_match_dupl_check (!c->finalize, "finalize"))
    2653                 :             :                  != MATCH_NO)
    2654                 :             :             {
    2655                 :          16 :               if (m == MATCH_ERROR)
    2656                 :           0 :                 goto error;
    2657                 :          16 :               c->finalize = true;
    2658                 :          16 :               needs_space = true;
    2659                 :          16 :               continue;
    2660                 :             :             }
    2661                 :        2893 :           if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
    2662                 :        1949 :               && gfc_match_omp_variable_list ("firstprivate (",
    2663                 :             :                                               &c->lists[OMP_LIST_FIRSTPRIVATE],
    2664                 :             :                                               true) == MATCH_YES)
    2665                 :         944 :             continue;
    2666                 :        2003 :           if ((mask & OMP_CLAUSE_FROM)
    2667                 :        1005 :               && gfc_match_motion_var_list ("from (", &c->lists[OMP_LIST_FROM],
    2668                 :             :                                              &head) == MATCH_YES)
    2669                 :         998 :             continue;
    2670                 :             :           break;
    2671                 :        1170 :         case 'g':
    2672                 :        2292 :           if ((mask & OMP_CLAUSE_GANG)
    2673                 :        1170 :               && (m = gfc_match_dupl_check (!c->gang, "gang")) != MATCH_NO)
    2674                 :             :             {
    2675                 :        1127 :               if (m == MATCH_ERROR)
    2676                 :           0 :                 goto error;
    2677                 :        1127 :               c->gang = true;
    2678                 :        1127 :               m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
    2679                 :        1127 :               if (m == MATCH_ERROR)
    2680                 :             :                 {
    2681                 :           5 :                   gfc_current_locus = old_loc;
    2682                 :           5 :                   break;
    2683                 :             :                 }
    2684                 :        1122 :               else if (m == MATCH_NO)
    2685                 :         916 :                 needs_space = true;
    2686                 :        1122 :               continue;
    2687                 :             :             }
    2688                 :          86 :           if ((mask & OMP_CLAUSE_GRAINSIZE)
    2689                 :          43 :               && (m = gfc_match_dupl_check (!c->grainsize, "grainsize", true))
    2690                 :             :                  != MATCH_NO)
    2691                 :             :             {
    2692                 :          43 :               if (m == MATCH_ERROR)
    2693                 :           0 :                 goto error;
    2694                 :          43 :               if (gfc_match ("strict : ") == MATCH_YES)
    2695                 :           6 :                 c->grainsize_strict = true;
    2696                 :          43 :               if (gfc_match (" %e )", &c->grainsize) != MATCH_YES)
    2697                 :           0 :                 goto error;
    2698                 :          43 :               continue;
    2699                 :             :             }
    2700                 :             :           break;
    2701                 :         415 :         case 'h':
    2702                 :         450 :           if ((mask & OMP_CLAUSE_HAS_DEVICE_ADDR)
    2703                 :         450 :               && gfc_match_omp_variable_list
    2704                 :          35 :                    ("has_device_addr (", &c->lists[OMP_LIST_HAS_DEVICE_ADDR],
    2705                 :             :                     false, NULL, NULL, true) == MATCH_YES)
    2706                 :          35 :             continue;
    2707                 :         423 :           if ((mask & OMP_CLAUSE_HINT)
    2708                 :         380 :               && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint))
    2709                 :             :                  != MATCH_NO)
    2710                 :             :             {
    2711                 :          43 :               if (m == MATCH_ERROR)
    2712                 :           0 :                 goto error;
    2713                 :          43 :               continue;
    2714                 :             :             }
    2715                 :         337 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    2716                 :         337 :               && gfc_match ("holds ( ") == MATCH_YES)
    2717                 :             :             {
    2718                 :          18 :               gfc_expr *e;
    2719                 :          18 :               if (gfc_match ("%e )", &e) != MATCH_YES)
    2720                 :           0 :                 goto error;
    2721                 :          18 :               if (c->assume == NULL)
    2722                 :          11 :                 c->assume = gfc_get_omp_assumptions ();
    2723                 :          18 :               gfc_expr_list *el = XCNEW (gfc_expr_list);
    2724                 :          18 :               el->expr = e;
    2725                 :          18 :               el->next = c->assume->holds;
    2726                 :          18 :               c->assume->holds = el;
    2727                 :          18 :               continue;
    2728                 :          18 :             }
    2729                 :         637 :           if ((mask & OMP_CLAUSE_HOST_SELF)
    2730                 :         319 :               && gfc_match ("host ( ") == MATCH_YES
    2731                 :         638 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    2732                 :             :                                            OMP_MAP_FORCE_FROM, true,
    2733                 :             :                                            allow_derived))
    2734                 :         318 :             continue;
    2735                 :             :           break;
    2736                 :        1503 :         case 'i':
    2737                 :        1526 :           if ((mask & OMP_CLAUSE_IF_PRESENT)
    2738                 :        1503 :               && (m = gfc_match_dupl_check (!c->if_present, "if_present"))
    2739                 :             :                  != MATCH_NO)
    2740                 :             :             {
    2741                 :          23 :               if (m == MATCH_ERROR)
    2742                 :           0 :                 goto error;
    2743                 :          23 :               c->if_present = true;
    2744                 :          23 :               needs_space = true;
    2745                 :          23 :               continue;
    2746                 :             :             }
    2747                 :        1480 :           if ((mask & OMP_CLAUSE_IF)
    2748                 :        1480 :               && (m = gfc_match_dupl_check (!c->if_expr, "if", true))
    2749                 :             :                  != MATCH_NO)
    2750                 :             :             {
    2751                 :        1045 :               if (m == MATCH_ERROR)
    2752                 :          15 :                 goto error;
    2753                 :        1030 :               if (!openacc)
    2754                 :             :                 {
    2755                 :             :                   /* This should match the enum gfc_omp_if_kind order.  */
    2756                 :             :                   static const char *ifs[OMP_IF_LAST] = {
    2757                 :             :                     "cancel : %e )",
    2758                 :             :                     "parallel : %e )",
    2759                 :             :                     "simd : %e )",
    2760                 :             :                     "task : %e )",
    2761                 :             :                     "taskloop : %e )",
    2762                 :             :                     "target : %e )",
    2763                 :             :                     "target data : %e )",
    2764                 :             :                     "target update : %e )",
    2765                 :             :                     "target enter data : %e )",
    2766                 :             :                     "target exit data : %e )" };
    2767                 :             :                   int i;
    2768                 :        4753 :                   for (i = 0; i < OMP_IF_LAST; i++)
    2769                 :        4363 :                     if (c->if_exprs[i] == NULL
    2770                 :        4363 :                         && gfc_match (ifs[i], &c->if_exprs[i]) == MATCH_YES)
    2771                 :             :                       break;
    2772                 :         528 :                   if (i < OMP_IF_LAST)
    2773                 :         138 :                     continue;
    2774                 :             :                 }
    2775                 :         892 :               if (gfc_match (" %e )", &c->if_expr) == MATCH_YES)
    2776                 :         888 :                 continue;
    2777                 :           4 :               goto error;
    2778                 :             :             }
    2779                 :         552 :           if ((mask & OMP_CLAUSE_IN_REDUCTION)
    2780                 :         435 :               && gfc_match_omp_clause_reduction (pc, c, openacc, allow_derived,
    2781                 :             :                                                  openmp_target) == MATCH_YES)
    2782                 :         117 :             continue;
    2783                 :         343 :           if ((mask & OMP_CLAUSE_INBRANCH)
    2784                 :         318 :               && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch,
    2785                 :             :                                             "inbranch")) != MATCH_NO)
    2786                 :             :             {
    2787                 :          25 :               if (m == MATCH_ERROR)
    2788                 :           0 :                 goto error;
    2789                 :          25 :               c->inbranch = needs_space = true;
    2790                 :          25 :               continue;
    2791                 :             :             }
    2792                 :         480 :           if ((mask & OMP_CLAUSE_INDEPENDENT)
    2793                 :         293 :               && (m = gfc_match_dupl_check (!c->independent, "independent"))
    2794                 :             :                  != MATCH_NO)
    2795                 :             :             {
    2796                 :         187 :               if (m == MATCH_ERROR)
    2797                 :           0 :                 goto error;
    2798                 :         187 :               c->independent = true;
    2799                 :         187 :               needs_space = true;
    2800                 :         187 :               continue;
    2801                 :             :             }
    2802                 :         205 :           if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
    2803                 :         205 :               && gfc_match_omp_variable_list
    2804                 :          99 :                    ("is_device_ptr (",
    2805                 :             :                     &c->lists[OMP_LIST_IS_DEVICE_PTR], false) == MATCH_YES)
    2806                 :          99 :             continue;
    2807                 :             :           break;
    2808                 :        2274 :         case 'l':
    2809                 :        2274 :           if ((mask & OMP_CLAUSE_LASTPRIVATE)
    2810                 :        2274 :               && gfc_match ("lastprivate ( ") == MATCH_YES)
    2811                 :             :             {
    2812                 :        1389 :               bool conditional = gfc_match ("conditional : ") == MATCH_YES;
    2813                 :        1389 :               head = NULL;
    2814                 :        1389 :               if (gfc_match_omp_variable_list ("",
    2815                 :             :                                                &c->lists[OMP_LIST_LASTPRIVATE],
    2816                 :             :                                                false, NULL, &head) == MATCH_YES)
    2817                 :             :                 {
    2818                 :        1389 :                   gfc_omp_namelist *n;
    2819                 :        3653 :                   for (n = *head; n; n = n->next)
    2820                 :        2264 :                     n->u.lastprivate_conditional = conditional;
    2821                 :        1389 :                   continue;
    2822                 :        1389 :                 }
    2823                 :           0 :               gfc_current_locus = old_loc;
    2824                 :           0 :               break;
    2825                 :             :             }
    2826                 :         885 :           end_colon = false;
    2827                 :         885 :           head = NULL;
    2828                 :         885 :           if ((mask & OMP_CLAUSE_LINEAR)
    2829                 :         885 :               && gfc_match ("linear (") == MATCH_YES)
    2830                 :             :             {
    2831                 :         840 :               bool old_linear_modifier = false;
    2832                 :         840 :               gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
    2833                 :         840 :               gfc_expr *step = NULL;
    2834                 :             : 
    2835                 :         840 :               if (gfc_match_omp_variable_list (" ref (",
    2836                 :             :                                                &c->lists[OMP_LIST_LINEAR],
    2837                 :             :                                                false, NULL, &head)
    2838                 :             :                   == MATCH_YES)
    2839                 :             :                 {
    2840                 :             :                   linear_op = OMP_LINEAR_REF;
    2841                 :             :                   old_linear_modifier = true;
    2842                 :             :                 }
    2843                 :         811 :               else if (gfc_match_omp_variable_list (" val (",
    2844                 :             :                                                     &c->lists[OMP_LIST_LINEAR],
    2845                 :             :                                                     false, NULL, &head)
    2846                 :             :                        == MATCH_YES)
    2847                 :             :                 {
    2848                 :             :                   linear_op = OMP_LINEAR_VAL;
    2849                 :             :                   old_linear_modifier = true;
    2850                 :             :                 }
    2851                 :         799 :               else if (gfc_match_omp_variable_list (" uval (",
    2852                 :             :                                                     &c->lists[OMP_LIST_LINEAR],
    2853                 :             :                                                     false, NULL, &head)
    2854                 :             :                        == MATCH_YES)
    2855                 :             :                 {
    2856                 :             :                   linear_op = OMP_LINEAR_UVAL;
    2857                 :             :                   old_linear_modifier = true;
    2858                 :             :                 }
    2859                 :         789 :               else if (gfc_match_omp_variable_list ("",
    2860                 :             :                                                     &c->lists[OMP_LIST_LINEAR],
    2861                 :             :                                                     false, &end_colon, &head)
    2862                 :             :                        == MATCH_YES)
    2863                 :             :                 linear_op = OMP_LINEAR_DEFAULT;
    2864                 :             :               else
    2865                 :             :                 {
    2866                 :           2 :                   gfc_current_locus = old_loc;
    2867                 :           2 :                   break;
    2868                 :             :                 }
    2869                 :             :               if (linear_op != OMP_LINEAR_DEFAULT)
    2870                 :             :                 {
    2871                 :          51 :                   if (gfc_match (" :") == MATCH_YES)
    2872                 :          31 :                     end_colon = true;
    2873                 :          20 :                   else if (gfc_match (" )") != MATCH_YES)
    2874                 :             :                     {
    2875                 :           0 :                       gfc_free_omp_namelist (*head, false, false, false);
    2876                 :           0 :                       gfc_current_locus = old_loc;
    2877                 :           0 :                       *head = NULL;
    2878                 :           0 :                       break;
    2879                 :             :                     }
    2880                 :             :                 }
    2881                 :         838 :               gfc_gobble_whitespace ();
    2882                 :         838 :               if (old_linear_modifier && end_colon)
    2883                 :             :                 {
    2884                 :          31 :                   if (gfc_match (" %e )", &step) != MATCH_YES)
    2885                 :             :                     {
    2886                 :           1 :                       gfc_free_omp_namelist (*head, false, false, false);
    2887                 :           1 :                       gfc_current_locus = old_loc;
    2888                 :           1 :                       *head = NULL;
    2889                 :           5 :                       goto error;
    2890                 :             :                     }
    2891                 :             :                 }
    2892                 :         807 :               else if (end_colon)
    2893                 :             :                 {
    2894                 :         710 :                   bool has_error = false;
    2895                 :             :                   bool has_modifiers = false;
    2896                 :             :                   bool has_step = false;
    2897                 :         710 :                   bool duplicate_step = false;
    2898                 :         710 :                   bool duplicate_mod = false;
    2899                 :         710 :                   while (true)
    2900                 :             :                     {
    2901                 :         710 :                       old_loc = gfc_current_locus;
    2902                 :         710 :                       bool close_paren = gfc_match ("val )") == MATCH_YES;
    2903                 :         710 :                       if (close_paren || gfc_match ("val , ") == MATCH_YES)
    2904                 :             :                         {
    2905                 :          16 :                           if (linear_op != OMP_LINEAR_DEFAULT)
    2906                 :             :                             {
    2907                 :             :                               duplicate_mod = true;
    2908                 :             :                               break;
    2909                 :             :                             }
    2910                 :          15 :                           linear_op = OMP_LINEAR_VAL;
    2911                 :          15 :                           has_modifiers = true;
    2912                 :          15 :                           if (close_paren)
    2913                 :             :                             break;
    2914                 :          10 :                           continue;
    2915                 :             :                         }
    2916                 :         694 :                       close_paren = gfc_match ("uval )") == MATCH_YES;
    2917                 :         694 :                       if (close_paren || gfc_match ("uval , ") == MATCH_YES)
    2918                 :             :                         {
    2919                 :           6 :                           if (linear_op != OMP_LINEAR_DEFAULT)
    2920                 :             :                             {
    2921                 :             :                               duplicate_mod = true;
    2922                 :             :                               break;
    2923                 :             :                             }
    2924                 :           6 :                           linear_op = OMP_LINEAR_UVAL;
    2925                 :           6 :                           has_modifiers = true;
    2926                 :           6 :                           if (close_paren)
    2927                 :             :                             break;
    2928                 :           2 :                           continue;
    2929                 :             :                         }
    2930                 :         688 :                       close_paren = gfc_match ("ref )") == MATCH_YES;
    2931                 :         688 :                       if (close_paren || gfc_match ("ref , ") == MATCH_YES)
    2932                 :             :                         {
    2933                 :          15 :                           if (linear_op != OMP_LINEAR_DEFAULT)
    2934                 :             :                             {
    2935                 :             :                               duplicate_mod = true;
    2936                 :             :                               break;
    2937                 :             :                             }
    2938                 :          14 :                           linear_op = OMP_LINEAR_REF;
    2939                 :          14 :                           has_modifiers = true;
    2940                 :          14 :                           if (close_paren)
    2941                 :             :                             break;
    2942                 :           7 :                           continue;
    2943                 :             :                         }
    2944                 :         673 :                       close_paren = (gfc_match ("step ( %e ) )", &step)
    2945                 :             :                                      == MATCH_YES);
    2946                 :         684 :                       if (close_paren
    2947                 :         673 :                           || gfc_match ("step ( %e ) , ", &step) == MATCH_YES)
    2948                 :             :                         {
    2949                 :          38 :                           if (has_step)
    2950                 :             :                             {
    2951                 :             :                               duplicate_step = true;
    2952                 :             :                               break;
    2953                 :             :                             }
    2954                 :          37 :                           has_modifiers = has_step = true;
    2955                 :          37 :                           if (close_paren)
    2956                 :             :                             break;
    2957                 :          11 :                           continue;
    2958                 :             :                         }
    2959                 :         635 :                       if (!has_modifiers
    2960                 :         635 :                           && gfc_match ("%e )", &step) == MATCH_YES)
    2961                 :             :                         {
    2962                 :         635 :                           if ((step->expr_type == EXPR_FUNCTION
    2963                 :         634 :                                 || step->expr_type == EXPR_VARIABLE)
    2964                 :          31 :                               && strcmp (step->symtree->name, "step") == 0)
    2965                 :             :                             {
    2966                 :           1 :                               gfc_current_locus = old_loc;
    2967                 :           1 :                               gfc_match ("step (");
    2968                 :           1 :                               has_error = true;
    2969                 :             :                             }
    2970                 :             :                           break;
    2971                 :             :                         }
    2972                 :             :                       has_error = true;
    2973                 :             :                       break;
    2974                 :             :                     }
    2975                 :         680 :                   if (duplicate_mod || duplicate_step)
    2976                 :             :                     {
    2977                 :           3 :                       gfc_error ("Multiple %qs modifiers specified at %C",
    2978                 :             :                                  duplicate_mod ? "linear" : "step");
    2979                 :           3 :                       has_error = true;
    2980                 :             :                     }
    2981                 :         680 :                   if (has_error)
    2982                 :             :                     {
    2983                 :           4 :                       gfc_free_omp_namelist (*head, false, false, false);
    2984                 :           4 :                       *head = NULL;
    2985                 :           4 :                       goto error;
    2986                 :             :                     }
    2987                 :             :                 }
    2988                 :         833 :               if (step == NULL)
    2989                 :             :                 {
    2990                 :         134 :                   step = gfc_get_constant_expr (BT_INTEGER,
    2991                 :             :                                                 gfc_default_integer_kind,
    2992                 :             :                                                 &old_loc);
    2993                 :         134 :                   mpz_set_si (step->value.integer, 1);
    2994                 :             :                 }
    2995                 :         833 :               (*head)->expr = step;
    2996                 :         833 :               if (linear_op != OMP_LINEAR_DEFAULT || old_linear_modifier)
    2997                 :         176 :                 for (gfc_omp_namelist *n = *head; n; n = n->next)
    2998                 :             :                   {
    2999                 :          94 :                     n->u.linear.op = linear_op;
    3000                 :          94 :                     n->u.linear.old_modifier = old_linear_modifier;
    3001                 :             :                   }
    3002                 :         833 :               continue;
    3003                 :         833 :             }
    3004                 :          49 :           if ((mask & OMP_CLAUSE_LINK)
    3005                 :          45 :               && openacc
    3006                 :          53 :               && (gfc_match_oacc_clause_link ("link (",
    3007                 :             :                                               &c->lists[OMP_LIST_LINK])
    3008                 :             :                   == MATCH_YES))
    3009                 :           4 :             continue;
    3010                 :          78 :           else if ((mask & OMP_CLAUSE_LINK)
    3011                 :          41 :                    && !openacc
    3012                 :          78 :                    && (gfc_match_omp_to_link ("link (",
    3013                 :             :                                               &c->lists[OMP_LIST_LINK])
    3014                 :             :                        == MATCH_YES))
    3015                 :          37 :             continue;
    3016                 :             :           break;
    3017                 :        3965 :         case 'm':
    3018                 :        3965 :           if ((mask & OMP_CLAUSE_MAP)
    3019                 :        3965 :               && gfc_match ("map ( ") == MATCH_YES)
    3020                 :             :             {
    3021                 :        3884 :               locus old_loc2 = gfc_current_locus;
    3022                 :        3884 :               int always_modifier = 0;
    3023                 :        3884 :               int close_modifier = 0;
    3024                 :        3884 :               int present_modifier = 0;
    3025                 :        3884 :               locus second_always_locus = old_loc2;
    3026                 :        3884 :               locus second_close_locus = old_loc2;
    3027                 :        3884 :               locus second_present_locus = old_loc2;
    3028                 :             : 
    3029                 :        4366 :               for (;;)
    3030                 :             :                 {
    3031                 :        4125 :                   locus current_locus = gfc_current_locus;
    3032                 :        4125 :                   if (gfc_match ("always ") == MATCH_YES)
    3033                 :             :                     {
    3034                 :         125 :                       if (always_modifier++ == 1)
    3035                 :           5 :                         second_always_locus = current_locus;
    3036                 :             :                     }
    3037                 :        4000 :                   else if (gfc_match ("close ") == MATCH_YES)
    3038                 :             :                     {
    3039                 :          65 :                       if (close_modifier++ == 1)
    3040                 :           5 :                         second_close_locus = current_locus;
    3041                 :             :                     }
    3042                 :        3935 :                   else if (gfc_match ("present ") == MATCH_YES)
    3043                 :             :                     {
    3044                 :          51 :                       if (present_modifier++ == 1)
    3045                 :           4 :                         second_present_locus = current_locus;
    3046                 :             :                     }
    3047                 :             :                   else
    3048                 :             :                     break;
    3049                 :         241 :                   gfc_match (", ");
    3050                 :         241 :                 }
    3051                 :             : 
    3052                 :        3884 :               gfc_omp_map_op map_op = OMP_MAP_TOFROM;
    3053                 :        3884 :               int always_present_modifier
    3054                 :        3884 :                 = always_modifier && present_modifier;
    3055                 :             : 
    3056                 :        3884 :               if (gfc_match ("alloc : ") == MATCH_YES)
    3057                 :         519 :                 map_op = (present_modifier ? OMP_MAP_PRESENT_ALLOC
    3058                 :             :                           : OMP_MAP_ALLOC);
    3059                 :        3365 :               else if (gfc_match ("tofrom : ") == MATCH_YES)
    3060                 :         483 :                 map_op = (always_present_modifier ? OMP_MAP_ALWAYS_PRESENT_TOFROM
    3061                 :         479 :                           : present_modifier ? OMP_MAP_PRESENT_TOFROM
    3062                 :         475 :                           : always_modifier ? OMP_MAP_ALWAYS_TOFROM
    3063                 :             :                           : OMP_MAP_TOFROM);
    3064                 :        2882 :               else if (gfc_match ("to : ") == MATCH_YES)
    3065                 :        1225 :                 map_op = (always_present_modifier ? OMP_MAP_ALWAYS_PRESENT_TO
    3066                 :        1221 :                           : present_modifier ? OMP_MAP_PRESENT_TO
    3067                 :        1210 :                           : always_modifier ? OMP_MAP_ALWAYS_TO
    3068                 :             :                           : OMP_MAP_TO);
    3069                 :        1657 :               else if (gfc_match ("from : ") == MATCH_YES)
    3070                 :        1317 :                 map_op = (always_present_modifier ? OMP_MAP_ALWAYS_PRESENT_FROM
    3071                 :        1313 :                           : present_modifier ? OMP_MAP_PRESENT_FROM
    3072                 :        1309 :                           : always_modifier ? OMP_MAP_ALWAYS_FROM
    3073                 :             :                           : OMP_MAP_FROM);
    3074                 :         340 :               else if (gfc_match ("release : ") == MATCH_YES)
    3075                 :             :                 map_op = OMP_MAP_RELEASE;
    3076                 :         326 :               else if (gfc_match ("delete : ") == MATCH_YES)
    3077                 :             :                 map_op = OMP_MAP_DELETE;
    3078                 :             :               else
    3079                 :             :                 {
    3080                 :         282 :                   gfc_current_locus = old_loc2;
    3081                 :         282 :                   always_modifier = 0;
    3082                 :         282 :                   close_modifier = 0;
    3083                 :             :                 }
    3084                 :             : 
    3085                 :        3884 :               if (always_modifier > 1)
    3086                 :             :                 {
    3087                 :           5 :                   gfc_error ("too many %<always%> modifiers at %L",
    3088                 :             :                              &second_always_locus);
    3089                 :          21 :                   break;
    3090                 :             :                 }
    3091                 :        3879 :               if (close_modifier > 1)
    3092                 :             :                 {
    3093                 :           4 :                   gfc_error ("too many %<close%> modifiers at %L",
    3094                 :             :                              &second_close_locus);
    3095                 :           4 :                   break;
    3096                 :             :                 }
    3097                 :        3875 :               if (present_modifier > 1)
    3098                 :             :                 {
    3099                 :           4 :                   gfc_error ("too many %<present%> modifiers at %L",
    3100                 :             :                              &second_present_locus);
    3101                 :           4 :                   break;
    3102                 :             :                 }
    3103                 :             : 
    3104                 :        3871 :               head = NULL;
    3105                 :        3871 :               if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
    3106                 :             :                                                false, NULL, &head,
    3107                 :             :                                                true, true) == MATCH_YES)
    3108                 :             :                 {
    3109                 :        3868 :                   gfc_omp_namelist *n;
    3110                 :        8809 :                   for (n = *head; n; n = n->next)
    3111                 :        4941 :                     n->u.map_op = map_op;
    3112                 :        3868 :                   continue;
    3113                 :        3868 :                 }
    3114                 :           3 :               gfc_current_locus = old_loc;
    3115                 :           3 :               break;
    3116                 :             :             }
    3117                 :         115 :           if ((mask & OMP_CLAUSE_MERGEABLE)
    3118                 :          81 :               && (m = gfc_match_dupl_check (!c->mergeable, "mergeable"))
    3119                 :             :                  != MATCH_NO)
    3120                 :             :             {
    3121                 :          34 :               if (m == MATCH_ERROR)
    3122                 :           0 :                 goto error;
    3123                 :          34 :               c->mergeable = needs_space = true;
    3124                 :          34 :               continue;
    3125                 :             :             }
    3126                 :          89 :           if ((mask & OMP_CLAUSE_MESSAGE)
    3127                 :          47 :               && (m = gfc_match_dupl_check (!c->message, "message", true,
    3128                 :             :                  &c->message)) != MATCH_NO)
    3129                 :             :             {
    3130                 :          47 :               if (m == MATCH_ERROR)
    3131                 :           5 :                 goto error;
    3132                 :          42 :               continue;
    3133                 :             :             }
    3134                 :             :           break;
    3135                 :        2861 :         case 'n':
    3136                 :        2911 :           if ((mask & OMP_CLAUSE_NO_CREATE)
    3137                 :        1341 :               && gfc_match ("no_create ( ") == MATCH_YES
    3138                 :        2911 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3139                 :             :                                            OMP_MAP_IF_PRESENT, true,
    3140                 :             :                                            allow_derived))
    3141                 :          50 :             continue;
    3142                 :        2823 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    3143                 :        2831 :               && (m = gfc_match_dupl_check (!c->assume
    3144                 :          20 :                                             || !c->assume->no_openmp_routines,
    3145                 :             :                                             "no_openmp_routines")) == MATCH_YES)
    3146                 :             :             {
    3147                 :          12 :               if (m == MATCH_ERROR)
    3148                 :             :                 goto error;
    3149                 :          12 :               if (c->assume == NULL)
    3150                 :          12 :                 c->assume = gfc_get_omp_assumptions ();
    3151                 :          12 :               c->assume->no_openmp_routines = needs_space = true;
    3152                 :          12 :               continue;
    3153                 :             :             }
    3154                 :        2801 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    3155                 :        2807 :               && (m = gfc_match_dupl_check (!c->assume || !c->assume->no_openmp,
    3156                 :             :                                             "no_openmp")) == MATCH_YES)
    3157                 :             :             {
    3158                 :           2 :               if (m == MATCH_ERROR)
    3159                 :             :                 goto error;
    3160                 :           2 :               if (c->assume == NULL)
    3161                 :           2 :                 c->assume = gfc_get_omp_assumptions ();
    3162                 :           2 :               c->assume->no_openmp = needs_space = true;
    3163                 :           2 :               continue;
    3164                 :             :             }
    3165                 :        2803 :           if ((mask & OMP_CLAUSE_ASSUMPTIONS)
    3166                 :        2803 :               && (m = gfc_match_dupl_check (!c->assume
    3167                 :           6 :                                             || !c->assume->no_parallelism,
    3168                 :             :                                             "no_parallelism")) == MATCH_YES)
    3169                 :             :             {
    3170                 :           6 :               if (m == MATCH_ERROR)
    3171                 :             :                 goto error;
    3172                 :           6 :               if (c->assume == NULL)
    3173                 :           6 :                 c->assume = gfc_get_omp_assumptions ();
    3174                 :           6 :               c->assume->no_parallelism = needs_space = true;
    3175                 :           6 :               continue;
    3176                 :             :             }
    3177                 :        2804 :           if ((mask & OMP_CLAUSE_NOGROUP)
    3178                 :        2791 :               && (m = gfc_match_dupl_check (!c->nogroup, "nogroup"))
    3179                 :             :                  != MATCH_NO)
    3180                 :             :             {
    3181                 :          13 :               if (m == MATCH_ERROR)
    3182                 :           0 :                 goto error;
    3183                 :          13 :               c->nogroup = needs_space = true;
    3184                 :          13 :               continue;
    3185                 :             :             }
    3186                 :        2928 :           if ((mask & OMP_CLAUSE_NOHOST)
    3187                 :        2778 :               && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO)
    3188                 :             :             {
    3189                 :         151 :               if (m == MATCH_ERROR)
    3190                 :           1 :                 goto error;
    3191                 :         150 :               c->nohost = needs_space = true;
    3192                 :         150 :               continue;
    3193                 :             :             }
    3194                 :        2669 :           if ((mask & OMP_CLAUSE_NOTEMPORAL)
    3195                 :        2627 :               && gfc_match_omp_variable_list ("nontemporal (",
    3196                 :             :                                               &c->lists[OMP_LIST_NONTEMPORAL],
    3197                 :             :                                               true) == MATCH_YES)
    3198                 :          42 :             continue;
    3199                 :        2614 :           if ((mask & OMP_CLAUSE_NOTINBRANCH)
    3200                 :        2585 :               && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch,
    3201                 :             :                                             "notinbranch")) != MATCH_NO)
    3202                 :             :             {
    3203                 :          30 :               if (m == MATCH_ERROR)
    3204                 :           1 :                 goto error;
    3205                 :          29 :               c->notinbranch = needs_space = true;
    3206                 :          29 :               continue;
    3207                 :             :             }
    3208                 :        2671 :           if ((mask & OMP_CLAUSE_NOWAIT)
    3209                 :        2555 :               && (m = gfc_match_dupl_check (!c->nowait, "nowait")) != MATCH_NO)
    3210                 :             :             {
    3211                 :         118 :               if (m == MATCH_ERROR)
    3212                 :           2 :                 goto error;
    3213                 :         116 :               c->nowait = needs_space = true;
    3214                 :         116 :               continue;
    3215                 :             :             }
    3216                 :        3119 :           if ((mask & OMP_CLAUSE_NUM_GANGS)
    3217                 :        2437 :               && (m = gfc_match_dupl_check (!c->num_gangs_expr, "num_gangs",
    3218                 :             :                                             true)) != MATCH_NO)
    3219                 :             :             {
    3220                 :         686 :               if (m == MATCH_ERROR)
    3221                 :           2 :                 goto error;
    3222                 :         684 :               if (gfc_match (" %e )", &c->num_gangs_expr) != MATCH_YES)
    3223                 :           2 :                 goto error;
    3224                 :         682 :               continue;
    3225                 :             :             }
    3226                 :        1786 :           if ((mask & OMP_CLAUSE_NUM_TASKS)
    3227                 :        1751 :               && (m = gfc_match_dupl_check (!c->num_tasks, "num_tasks", true))
    3228                 :             :                  != MATCH_NO)
    3229                 :             :             {
    3230                 :          35 :               if (m == MATCH_ERROR)
    3231                 :           0 :                 goto error;
    3232                 :          35 :               if (gfc_match ("strict : ") == MATCH_YES)
    3233                 :           6 :                 c->num_tasks_strict = true;
    3234                 :          35 :               if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES)
    3235                 :           0 :                 goto error;
    3236                 :          35 :               continue;
    3237                 :             :             }
    3238                 :        1843 :           if ((mask & OMP_CLAUSE_NUM_TEAMS)
    3239                 :        1716 :               && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams",
    3240                 :             :                                             true)) != MATCH_NO)
    3241                 :             :             {
    3242                 :         127 :               if (m == MATCH_ERROR)
    3243                 :           0 :                 goto error;
    3244                 :         127 :               if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES)
    3245                 :           0 :                 goto error;
    3246                 :         127 :               if (gfc_peek_ascii_char () == ':')
    3247                 :             :                 {
    3248                 :          21 :                   c->num_teams_lower = c->num_teams_upper;
    3249                 :          21 :                   c->num_teams_upper = NULL;
    3250                 :          21 :                   if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES)
    3251                 :           0 :                     goto error;
    3252                 :             :                 }
    3253                 :         127 :               if (gfc_match (") ") != MATCH_YES)
    3254                 :           0 :                 goto error;
    3255                 :         127 :               continue;
    3256                 :             :             }
    3257                 :        2538 :           if ((mask & OMP_CLAUSE_NUM_THREADS)
    3258                 :        1589 :               && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true,
    3259                 :             :                                             &c->num_threads)) != MATCH_NO)
    3260                 :             :             {
    3261                 :         949 :               if (m == MATCH_ERROR)
    3262                 :           0 :                 goto error;
    3263                 :         949 :               continue;
    3264                 :             :             }
    3265                 :        1239 :           if ((mask & OMP_CLAUSE_NUM_WORKERS)
    3266                 :         640 :               && (m = gfc_match_dupl_check (!c->num_workers_expr, "num_workers",
    3267                 :             :                                             true, &c->num_workers_expr))
    3268                 :             :                  != MATCH_NO)
    3269                 :             :             {
    3270                 :         603 :               if (m == MATCH_ERROR)
    3271                 :           4 :                 goto error;
    3272                 :         599 :               continue;
    3273                 :             :             }
    3274                 :             :           break;
    3275                 :         587 :         case 'o':
    3276                 :         821 :           if ((mask & OMP_CLAUSE_ORDER)
    3277                 :         587 :               && (m = gfc_match_dupl_check (!c->order_concurrent, "order ("))
    3278                 :             :                  != MATCH_NO)
    3279                 :             :             {
    3280                 :         245 :               if (m == MATCH_ERROR)
    3281                 :           8 :                 goto error;
    3282                 :         237 :               if (gfc_match (" reproducible : concurrent )") == MATCH_YES)
    3283                 :          55 :                 c->order_reproducible = true;
    3284                 :         182 :               else if (gfc_match (" concurrent )") == MATCH_YES)
    3285                 :             :                 ;
    3286                 :          50 :               else if (gfc_match (" unconstrained : concurrent )") == MATCH_YES)
    3287                 :          47 :                 c->order_unconstrained = true;
    3288                 :             :               else
    3289                 :             :                 {
    3290                 :           3 :                   gfc_error ("Expected ORDER(CONCURRENT) at %C "
    3291                 :             :                              "with optional %<reproducible%> or "
    3292                 :             :                              "%<unconstrained%> modifier");
    3293                 :           3 :                   goto error;
    3294                 :             :                 }
    3295                 :         234 :               c->order_concurrent = true;
    3296                 :         234 :               continue;
    3297                 :             :             }
    3298                 :         342 :           if ((mask & OMP_CLAUSE_ORDERED)
    3299                 :         342 :               && (m = gfc_match_dupl_check (!c->ordered, "ordered"))
    3300                 :             :                  != MATCH_NO)
    3301                 :             :             {
    3302                 :         339 :               if (m == MATCH_ERROR)
    3303                 :           0 :                 goto error;
    3304                 :         339 :               gfc_expr *cexpr = NULL;
    3305                 :         339 :               m = gfc_match (" ( %e )", &cexpr);
    3306                 :             : 
    3307                 :         339 :               c->ordered = true;
    3308                 :         339 :               if (m == MATCH_YES)
    3309                 :             :                 {
    3310                 :         140 :                   int ordered = 0;
    3311                 :         140 :                   if (gfc_extract_int (cexpr, &ordered, -1))
    3312                 :           0 :                     ordered = 0;
    3313                 :         140 :                   else if (ordered <= 0)
    3314                 :             :                     {
    3315                 :           0 :                       gfc_error_now ("ORDERED clause argument not"
    3316                 :             :                                      " constant positive integer at %C");
    3317                 :           0 :                       ordered = 0;
    3318                 :             :                     }
    3319                 :         140 :                   c->orderedc = ordered;
    3320                 :         140 :                   gfc_free_expr (cexpr);
    3321                 :         140 :                   continue;
    3322                 :         140 :                 }
    3323                 :             : 
    3324                 :         199 :               needs_space = true;
    3325                 :         199 :               continue;
    3326                 :         199 :             }
    3327                 :             :           break;
    3328                 :        2405 :         case 'p':
    3329                 :        2470 :           if ((mask & OMP_CLAUSE_COPY)
    3330                 :         778 :               && gfc_match ("pcopy ( ") == MATCH_YES
    3331                 :        2471 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3332                 :             :                                            OMP_MAP_TOFROM, true, allow_derived))
    3333                 :          65 :             continue;
    3334                 :        2412 :           if ((mask & OMP_CLAUSE_COPYIN)
    3335                 :        1592 :               && gfc_match ("pcopyin ( ") == MATCH_YES
    3336                 :        2412 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3337                 :             :                                            OMP_MAP_TO, true, allow_derived))
    3338                 :          72 :             continue;
    3339                 :        2338 :           if ((mask & OMP_CLAUSE_COPYOUT)
    3340                 :         642 :               && gfc_match ("pcopyout ( ") == MATCH_YES
    3341                 :        2338 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3342                 :             :                                            OMP_MAP_FROM, true, allow_derived))
    3343                 :          70 :             continue;
    3344                 :        2211 :           if ((mask & OMP_CLAUSE_CREATE)
    3345                 :         582 :               && gfc_match ("pcreate ( ") == MATCH_YES
    3346                 :        2211 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3347                 :             :                                            OMP_MAP_ALLOC, true, allow_derived))
    3348                 :          13 :             continue;
    3349                 :        2562 :           if ((mask & OMP_CLAUSE_PRESENT)
    3350                 :         559 :               && gfc_match ("present ( ") == MATCH_YES
    3351                 :        2564 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3352                 :             :                                            OMP_MAP_FORCE_PRESENT, false,
    3353                 :             :                                            allow_derived))
    3354                 :         377 :             continue;
    3355                 :        1830 :           if ((mask & OMP_CLAUSE_COPY)
    3356                 :         182 :               && gfc_match ("present_or_copy ( ") == MATCH_YES
    3357                 :        1830 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3358                 :             :                                            OMP_MAP_TOFROM, true,
    3359                 :             :                                            allow_derived))
    3360                 :          22 :             continue;
    3361                 :        1825 :           if ((mask & OMP_CLAUSE_COPYIN)
    3362                 :        1038 :               && gfc_match ("present_or_copyin ( ") == MATCH_YES
    3363                 :        1825 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3364                 :             :                                            OMP_MAP_TO, true, allow_derived))
    3365                 :          39 :             continue;
    3366                 :        1781 :           if ((mask & OMP_CLAUSE_COPYOUT)
    3367                 :         126 :               && gfc_match ("present_or_copyout ( ") == MATCH_YES
    3368                 :        1781 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3369                 :             :                                            OMP_MAP_FROM, true, allow_derived))
    3370                 :          34 :             continue;
    3371                 :        1740 :           if ((mask & OMP_CLAUSE_CREATE)
    3372                 :          97 :               && gfc_match ("present_or_create ( ") == MATCH_YES
    3373                 :        1740 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3374                 :             :                                            OMP_MAP_ALLOC, true, allow_derived))
    3375                 :          27 :             continue;
    3376                 :        1720 :           if ((mask & OMP_CLAUSE_PRIORITY)
    3377                 :        1686 :               && (m = gfc_match_dupl_check (!c->priority, "priority", true,
    3378                 :             :                                             &c->priority)) != MATCH_NO)
    3379                 :             :             {
    3380                 :          34 :               if (m == MATCH_ERROR)
    3381                 :           0 :                 goto error;
    3382                 :          34 :               continue;
    3383                 :             :             }
    3384                 :        3231 :           if ((mask & OMP_CLAUSE_PRIVATE)
    3385                 :        1652 :               && gfc_match_omp_variable_list ("private (",
    3386                 :             :                                               &c->lists[OMP_LIST_PRIVATE],
    3387                 :             :                                               true) == MATCH_YES)
    3388                 :        1579 :             continue;
    3389                 :         137 :           if ((mask & OMP_CLAUSE_PROC_BIND)
    3390                 :         137 :               && (m = gfc_match_dupl_check ((c->proc_bind
    3391                 :          64 :                                              == OMP_PROC_BIND_UNKNOWN),
    3392                 :             :                                             "proc_bind", true)) != MATCH_NO)
    3393                 :             :             {
    3394                 :          64 :               if (m == MATCH_ERROR)
    3395                 :           0 :                 goto error;
    3396                 :          64 :               if (gfc_match ("primary )") == MATCH_YES)
    3397                 :           1 :                 c->proc_bind = OMP_PROC_BIND_PRIMARY;
    3398                 :          63 :               else if (gfc_match ("master )") == MATCH_YES)
    3399                 :           9 :                 c->proc_bind = OMP_PROC_BIND_MASTER;
    3400                 :          54 :               else if (gfc_match ("spread )") == MATCH_YES)
    3401                 :          53 :                 c->proc_bind = OMP_PROC_BIND_SPREAD;
    3402                 :           1 :               else if (gfc_match ("close )") == MATCH_YES)
    3403                 :           1 :                 c->proc_bind = OMP_PROC_BIND_CLOSE;
    3404                 :             :               else
    3405                 :           0 :                 goto error;
    3406                 :          64 :               continue;
    3407                 :             :             }
    3408                 :             :           break;
    3409                 :        4203 :         case 'r':
    3410                 :        4689 :           if ((mask & OMP_CLAUSE_ATOMIC)
    3411                 :        4203 :               && (m = gfc_match_dupl_atomic ((c->atomic_op
    3412                 :             :                                               == GFC_OMP_ATOMIC_UNSET),
    3413                 :             :                                              "read")) != MATCH_NO)
    3414                 :             :             {
    3415                 :         486 :               if (m == MATCH_ERROR)
    3416                 :           0 :                 goto error;
    3417                 :         486 :               c->atomic_op = GFC_OMP_ATOMIC_READ;
    3418                 :         486 :               needs_space = true;
    3419                 :         486 :               continue;
    3420                 :             :             }
    3421                 :        7400 :           if ((mask & OMP_CLAUSE_REDUCTION)
    3422                 :        3717 :               && gfc_match_omp_clause_reduction (pc, c, openacc,
    3423                 :             :                                                  allow_derived) == MATCH_YES)
    3424                 :        3683 :             continue;
    3425                 :          44 :           if ((mask & OMP_CLAUSE_MEMORDER)
    3426                 :          61 :               && (m = gfc_match_dupl_memorder ((c->memorder
    3427                 :          27 :                                                 == OMP_MEMORDER_UNSET),
    3428                 :             :                                                "relaxed")) != MATCH_NO)
    3429                 :             :             {
    3430                 :          10 :               if (m == MATCH_ERROR)
    3431                 :           0 :                 goto error;
    3432                 :          10 :               c->memorder = OMP_MEMORDER_RELAXED;
    3433                 :          10 :               needs_space = true;
    3434                 :          10 :               continue;
    3435                 :             :             }
    3436                 :          40 :           if ((mask & OMP_CLAUSE_MEMORDER)
    3437                 :          41 :               && (m = gfc_match_dupl_memorder ((c->memorder
    3438                 :          17 :                                                 == OMP_MEMORDER_UNSET),
    3439                 :             :                                                "release")) != MATCH_NO)
    3440                 :             :             {
    3441                 :          17 :               if (m == MATCH_ERROR)
    3442                 :           1 :                 goto error;
    3443                 :          16 :               c->memorder = OMP_MEMORDER_RELEASE;
    3444                 :          16 :               needs_space = true;
    3445                 :          16 :               continue;
    3446                 :             :             }
    3447                 :             :           break;
    3448                 :        2555 :         case 's':
    3449                 :        2648 :           if ((mask & OMP_CLAUSE_SAFELEN)
    3450                 :        2555 :               && (m = gfc_match_dupl_check (!c->safelen_expr, "safelen",
    3451                 :             :                                             true, &c->safelen_expr))
    3452                 :             :                  != MATCH_NO)
    3453                 :             :             {
    3454                 :          93 :               if (m == MATCH_ERROR)
    3455                 :           0 :                 goto error;
    3456                 :          93 :               continue;
    3457                 :             :             }
    3458                 :        2462 :           if ((mask & OMP_CLAUSE_SCHEDULE)
    3459                 :        2462 :               && (m = gfc_match_dupl_check (c->sched_kind == OMP_SCHED_NONE,
    3460                 :             :                                             "schedule", true)) != MATCH_NO)
    3461                 :             :             {
    3462                 :         775 :               if (m == MATCH_ERROR)
    3463                 :           0 :                 goto error;
    3464                 :         775 :               int nmodifiers = 0;
    3465                 :         775 :               locus old_loc2 = gfc_current_locus;
    3466                 :         793 :               do
    3467                 :             :                 {
    3468                 :         784 :                   if (gfc_match ("simd") == MATCH_YES)
    3469                 :             :                     {
    3470                 :          18 :                       c->sched_simd = true;
    3471                 :          18 :                       nmodifiers++;
    3472                 :             :                     }
    3473                 :         766 :                   else if (gfc_match ("monotonic") == MATCH_YES)
    3474                 :             :                     {
    3475                 :          30 :                       c->sched_monotonic = true;
    3476                 :          30 :                       nmodifiers++;
    3477                 :             :                     }
    3478                 :         736 :                   else if (gfc_match ("nonmonotonic") == MATCH_YES)
    3479                 :             :                     {
    3480                 :          35 :                       c->sched_nonmonotonic = true;
    3481                 :          35 :                       nmodifiers++;
    3482                 :             :                     }
    3483                 :             :                   else
    3484                 :             :                     {
    3485                 :         701 :                       if (nmodifiers)
    3486                 :           0 :                         gfc_current_locus = old_loc2;
    3487                 :             :                       break;
    3488                 :             :                     }
    3489                 :          92 :                   if (nmodifiers == 1
    3490                 :          83 :                       && gfc_match (" , ") == MATCH_YES)
    3491                 :           9 :                     continue;
    3492                 :          74 :                   else if (gfc_match (" : ") == MATCH_YES)
    3493                 :             :                     break;
    3494                 :           0 :                   gfc_current_locus = old_loc2;
    3495                 :           0 :                   break;
    3496                 :             :                 }
    3497                 :             :               while (1);
    3498                 :         775 :               if (gfc_match ("static") == MATCH_YES)
    3499                 :         405 :                 c->sched_kind = OMP_SCHED_STATIC;
    3500                 :         370 :               else if (gfc_match ("dynamic") == MATCH_YES)
    3501                 :         164 :                 c->sched_kind = OMP_SCHED_DYNAMIC;
    3502                 :         206 :               else if (gfc_match ("guided") == MATCH_YES)
    3503                 :         113 :                 c->sched_kind = OMP_SCHED_GUIDED;
    3504                 :          93 :               else if (gfc_match ("runtime") == MATCH_YES)
    3505                 :          85 :                 c->sched_kind = OMP_SCHED_RUNTIME;
    3506                 :           8 :               else if (gfc_match ("auto") == MATCH_YES)
    3507                 :           8 :                 c->sched_kind = OMP_SCHED_AUTO;
    3508                 :         775 :               if (c->sched_kind != OMP_SCHED_NONE)
    3509                 :             :                 {
    3510                 :         775 :                   m = MATCH_NO;
    3511                 :         775 :                   if (c->sched_kind != OMP_SCHED_RUNTIME
    3512                 :         690 :                       && c->sched_kind != OMP_SCHED_AUTO)
    3513                 :         682 :                     m = gfc_match (" , %e )", &c->chunk_size);
    3514                 :         682 :                   if (m != MATCH_YES)
    3515                 :         271 :                     m = gfc_match_char (')');
    3516                 :         271 :                   if (m != MATCH_YES)
    3517                 :           0 :                     c->sched_kind = OMP_SCHED_NONE;
    3518                 :             :                 }
    3519                 :         775 :               if (c->sched_kind != OMP_SCHED_NONE)
    3520                 :         775 :                 continue;
    3521                 :             :               else
    3522                 :           0 :                 gfc_current_locus = old_loc;
    3523                 :             :             }
    3524                 :        1781 :           if ((mask & OMP_CLAUSE_HOST_SELF)
    3525                 :          95 :               && gfc_match ("self ( ") == MATCH_YES
    3526                 :        1782 :               && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
    3527                 :             :                                            OMP_MAP_FORCE_FROM, true,
    3528                 :             :                                            allow_derived))
    3529                 :          94 :             continue;
    3530                 :        1910 :           if ((mask & OMP_CLAUSE_SEQ)
    3531                 :        1593 :               && (m = gfc_match_dupl_check (!c->seq, "seq")) != MATCH_NO)
    3532                 :             :             {
    3533                 :         317 :               if (m == MATCH_ERROR)
    3534                 :           0 :                 goto error;
    3535                 :         317 :               c->seq = true;
    3536                 :         317 :               needs_space = true;
    3537                 :         317 :               continue;
    3538                 :             :             }
    3539                 :        1417 :           if ((mask & OMP_CLAUSE_MEMORDER)
    3540                 :        1417 :               && (m = gfc_match_dupl_memorder ((c->memorder
    3541                 :         141 :                                                 == OMP_MEMORDER_UNSET),
    3542                 :             :                                                "seq_cst")) != MATCH_NO)
    3543                 :             :             {
    3544                 :         141 :               if (m == MATCH_ERROR)
    3545                 :           0 :                 goto error;
    3546                 :         141 :               c->memorder = OMP_MEMORDER_SEQ_CST;
    3547                 :         141 :               needs_space = true;
    3548                 :         141 :               continue;
    3549                 :             :             }
    3550                 :        2084 :           if ((mask & OMP_CLAUSE_SHARED)
    3551                 :        1135 :               && gfc_match_omp_variable_list ("shared (",
    3552                 :             :                                               &c->lists[OMP_LIST_SHARED],
    3553                 :             :                                               true) == MATCH_YES)
    3554                 :         949 :             continue;
    3555                 :         304 :           if ((mask & OMP_CLAUSE_SIMDLEN)
    3556                 :         186 :               && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true,
    3557                 :             :                                             &c->simdlen_expr)) != MATCH_NO)
    3558                 :             :             {
    3559                 :         118 :               if (m == MATCH_ERROR)
    3560                 :           0 :                 goto error;
    3561                 :         118 :               continue;
    3562                 :             :             }
    3563                 :          90 :           if ((mask & OMP_CLAUSE_SIMD)
    3564                 :          68 :               && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO)
    3565                 :             :             {
    3566                 :          22 :               if (m == MATCH_ERROR)
    3567                 :           0 :                 goto error;
    3568                 :          22 :               c->simd = needs_space = true;
    3569                 :          22 :               continue;
    3570                 :             :             }
    3571                 :          85 :           if ((mask & OMP_CLAUSE_SEVERITY)
    3572                 :          46 :               && (m = gfc_match_dupl_check (!c->severity, "severity", true))
    3573                 :             :                  != MATCH_NO)
    3574                 :             :             {
    3575                 :          45 :               if (m == MATCH_ERROR)
    3576                 :           2 :                 goto error;
    3577                 :          43 :               if (gfc_match ("fatal )") == MATCH_YES)
    3578                 :          10 :                 c->severity = OMP_SEVERITY_FATAL;
    3579                 :          33 :               else if (gfc_match ("warning )") == MATCH_YES)
    3580                 :          29 :                 c->severity = OMP_SEVERITY_WARNING;
    3581                 :             :               else
    3582                 :             :                 {
    3583                 :           4 :                   gfc_error ("Expected FATAL or WARNING in SEVERITY clause "
    3584                 :             :                              "at %C");
    3585                 :           4 :                   goto error;
    3586                 :             :                 }
    3587                 :          39 :               continue;
    3588                 :             :             }
    3589                 :             :           break;
    3590                 :        1124 :         case 't':
    3591                 :        1189 :           if ((mask & OMP_CLAUSE_TASK_REDUCTION)
    3592                 :        1124 :               && gfc_match_omp_clause_reduction (pc, c, openacc,
    3593                 :             :                                                  allow_derived) == MATCH_YES)
    3594                 :          65 :             continue;
    3595                 :        1131 :           if ((mask & OMP_CLAUSE_THREAD_LIMIT)
    3596                 :        1059 :               && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit",
    3597                 :             :                                             true, &c->thread_limit))
    3598                 :             :                  != MATCH_NO)
    3599                 :             :             {
    3600                 :          72 :               if (m == MATCH_ERROR)
    3601                 :           0 :                 goto error;
    3602                 :          72 :               continue;
    3603                 :             :             }
    3604                 :        1000 :           if ((mask & OMP_CLAUSE_THREADS)
    3605                 :         987 :               && (m = gfc_match_dupl_check (!c->threads, "threads"))
    3606                 :             :                  != MATCH_NO)
    3607                 :             :             {
    3608                 :          13 :               if (m == MATCH_ERROR)
    3609                 :           0 :                 goto error;
    3610                 :          13 :               c->threads = needs_space = true;
    3611                 :          13 :               continue;
    3612                 :             :             }
    3613                 :        1144 :           if ((mask & OMP_CLAUSE_TILE)
    3614                 :         190 :               && !c->tile_list
    3615                 :        1164 :               && match_oacc_expr_list ("tile (", &c->tile_list,
    3616                 :             :                                        true) == MATCH_YES)
    3617                 :         170 :             continue;
    3618                 :         804 :           if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK))
    3619                 :             :             {
    3620                 :             :               /* Declare target: 'to' is an alias for 'enter';
    3621                 :             :                  'to' is deprecated since 5.2.  */
    3622                 :          64 :               m = gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO]);
    3623                 :          64 :               if (m == MATCH_ERROR)
    3624                 :           0 :                 goto error;
    3625                 :          64 :               if (m == MATCH_YES)
    3626                 :          64 :                 continue;
    3627                 :             :             }
    3628                 :        1460 :           else if ((mask & OMP_CLAUSE_TO)
    3629                 :         740 :                    && gfc_match_motion_var_list ("to (", &c->lists[OMP_LIST_TO],
    3630                 :             :                                                  &head) == MATCH_YES)
    3631                 :         720 :             continue;
    3632                 :             :           break;
    3633                 :        1480 :         case 'u':
    3634                 :        1543 :           if ((mask & OMP_CLAUSE_UNIFORM)
    3635                 :        1480 :               && gfc_match_omp_variable_list ("uniform (",
    3636                 :             :                                               &c->lists[OMP_LIST_UNIFORM],
    3637                 :             :                                               false) == MATCH_YES)
    3638                 :          63 :             continue;
    3639                 :        1558 :           if ((mask & OMP_CLAUSE_UNTIED)
    3640                 :        1417 :               && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO)
    3641                 :             :             {
    3642                 :         141 :               if (m == MATCH_ERROR)
    3643                 :           0 :                 goto error;
    3644                 :         141 :               c->untied = needs_space = true;
    3645                 :         141 :               continue;
    3646                 :             :             }
    3647                 :        1513 :           if ((mask & OMP_CLAUSE_ATOMIC)
    3648                 :        1276 :               && (m = gfc_match_dupl_atomic ((c->atomic_op
    3649                 :             :                                               == GFC_OMP_ATOMIC_UNSET),
    3650                 :             :                                              "update")) != MATCH_NO)
    3651                 :             :             {
    3652                 :         238 :               if (m == MATCH_ERROR)
    3653                 :           1 :                 goto error;
    3654                 :         237 :               c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
    3655                 :         237 :               needs_space = true;
    3656                 :         237 :               continue;
    3657                 :             :             }
    3658                 :        1098 :           if ((mask & OMP_CLAUSE_USE_DEVICE)
    3659                 :        1038 :               && gfc_match_omp_variable_list ("use_device (",
    3660                 :             :                                               &c->lists[OMP_LIST_USE_DEVICE],
    3661                 :             :                                               true) == MATCH_YES)
    3662                 :          60 :             continue;
    3663                 :        1139 :           if ((mask & OMP_CLAUSE_USE_DEVICE_PTR)
    3664                 :        1904 :               && gfc_match_omp_variable_list
    3665                 :         926 :                    ("use_device_ptr (",
    3666                 :             :                     &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
    3667                 :         161 :             continue;
    3668                 :        1582 :           if ((mask & OMP_CLAUSE_USE_DEVICE_ADDR)
    3669                 :        1582 :               && gfc_match_omp_variable_list
    3670                 :         765 :                    ("use_device_addr (", &c->lists[OMP_LIST_USE_DEVICE_ADDR],
    3671                 :             :                     false, NULL, NULL, true) == MATCH_YES)
    3672                 :         765 :             continue;
    3673                 :          95 :           if ((mask & OMP_CLAUSE_USES_ALLOCATORS)
    3674                 :          52 :               && (gfc_match ("uses_allocators ( ") == MATCH_YES))
    3675                 :             :             {
    3676                 :          47 :               if (gfc_match_omp_clause_uses_allocators (c) != MATCH_YES)
    3677                 :           4 :                 goto error;
    3678                 :          43 :               continue;
    3679                 :             :             }
    3680                 :             :           break;
    3681                 :        1516 :         case 'v':
    3682                 :             :           /* VECTOR_LENGTH must be matched before VECTOR, because the latter
    3683                 :             :              doesn't unconditionally match '('.  */
    3684                 :        2085 :           if ((mask & OMP_CLAUSE_VECTOR_LENGTH)
    3685                 :        1516 :               && (m = gfc_match_dupl_check (!c->vector_length_expr,
    3686                 :             :                                             "vector_length", true,
    3687                 :             :                                             &c->vector_length_expr))
    3688                 :             :                  != MATCH_NO)
    3689                 :             :             {
    3690                 :         573 :               if (m == MATCH_ERROR)
    3691                 :           4 :                 goto error;
    3692                 :         569 :               continue;
    3693                 :             :             }
    3694                 :        1881 :           if ((mask & OMP_CLAUSE_VECTOR)
    3695                 :         943 :               && (m = gfc_match_dupl_check (!c->vector, "vector")) != MATCH_NO)
    3696                 :             :             {
    3697                 :         941 :               if (m == MATCH_ERROR)
    3698                 :           0 :                 goto error;
    3699                 :         941 :               c->vector = true;
    3700                 :         941 :               m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
    3701                 :         941 :               if (m == MATCH_ERROR)
    3702                 :           3 :                 goto error;
    3703                 :         938 :               if (m == MATCH_NO)
    3704                 :         810 :                 needs_space = true;
    3705                 :         938 :               continue;
    3706                 :             :             }
    3707                 :             :           break;
    3708                 :        1416 :         case 'w':
    3709                 :        1416 :           if ((mask & OMP_CLAUSE_WAIT)
    3710                 :        1416 :               && gfc_match ("wait") == MATCH_YES)
    3711                 :             :             {
    3712                 :         187 :               m = match_oacc_expr_list (" (", &c->wait_list, false);
    3713                 :         187 :               if (m == MATCH_ERROR)
    3714                 :           9 :                 goto error;
    3715                 :         178 :               else if (m == MATCH_NO)
    3716                 :             :                 {
    3717                 :          47 :                   gfc_expr *expr
    3718                 :          47 :                     = gfc_get_constant_expr (BT_INTEGER,
    3719                 :             :                                              gfc_default_integer_kind,
    3720                 :             :                                              &gfc_current_locus);
    3721                 :          47 :                   mpz_set_si (expr->value.integer, GOMP_ASYNC_NOVAL);
    3722                 :          47 :                   gfc_expr_list **expr_list = &c->wait_list;
    3723                 :         103 :                   while (*expr_list)
    3724                 :           9 :                     expr_list = &(*expr_list)->next;
    3725                 :          47 :                   *expr_list = gfc_get_expr_list ();
    3726                 :          47 :                   (*expr_list)->expr = expr;
    3727                 :          47 :                   needs_space = true;
    3728                 :             :                 }
    3729                 :         178 :               continue;
    3730                 :         178 :             }
    3731                 :        1242 :           if ((mask & OMP_CLAUSE_WEAK)
    3732                 :        1229 :               && (m = gfc_match_dupl_check (!c->weak, "weak"))
    3733                 :             :                  != MATCH_NO)
    3734                 :             :             {
    3735                 :          14 :               if (m == MATCH_ERROR)
    3736                 :           1 :                 goto error;
    3737                 :          13 :               c->weak = true;
    3738                 :          13 :               needs_space = true;
    3739                 :          13 :               continue;
    3740                 :             :             }
    3741                 :        2021 :           if ((mask & OMP_CLAUSE_WORKER)
    3742                 :        1215 :               && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO)
    3743                 :             :             {
    3744                 :         809 :               if (m == MATCH_ERROR)
    3745                 :           0 :                 goto error;
    3746                 :         809 :               c->worker = true;
    3747                 :         809 :               m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
    3748                 :         809 :               if (m == MATCH_ERROR)
    3749                 :           3 :                 goto error;
    3750                 :         806 :               else if (m == MATCH_NO)
    3751                 :         709 :                 needs_space = true;
    3752                 :         806 :               continue;
    3753                 :             :             }
    3754                 :         812 :           if ((mask & OMP_CLAUSE_ATOMIC)
    3755                 :         406 :               && (m = gfc_match_dupl_atomic ((c->atomic_op
    3756                 :             :                                               == GFC_OMP_ATOMIC_UNSET),
    3757                 :             :                                              "write")) != MATCH_NO)
    3758                 :             :             {
    3759                 :         406 :               if (m == MATCH_ERROR)
    3760                 :           0 :                 goto error;
    3761                 :         406 :               c->atomic_op = GFC_OMP_ATOMIC_WRITE;
    3762                 :         406 :               needs_space = true;
    3763                 :         406 :               continue;
    3764                 :             :             }
    3765                 :             :           break;
    3766                 :             :         }
    3767                 :             :       break;
    3768                 :       40413 :     }
    3769                 :             : 
    3770                 :       30092 : end:
    3771                 :       30092 :   if (error
    3772                 :       29923 :       || (context_selector && gfc_peek_ascii_char () != ')')
    3773                 :       29908 :       || (!context_selector && gfc_match_omp_eos () != MATCH_YES))
    3774                 :             :     {
    3775                 :         405 :       if (!gfc_error_flag_test ())
    3776                 :         121 :         gfc_error ("Failed to match clause at %C");
    3777                 :         405 :       gfc_free_omp_clauses (c);
    3778                 :         405 :       return MATCH_ERROR;
    3779                 :             :     }
    3780                 :             : 
    3781                 :       29687 :   *cp = c;
    3782                 :       29687 :   return MATCH_YES;
    3783                 :             : 
    3784                 :         169 : error:
    3785                 :         169 :   error = true;
    3786                 :         169 :   goto end;
    3787                 :             : }
    3788                 :             : 
    3789                 :             : 
    3790                 :             : #define OACC_PARALLEL_CLAUSES \
    3791                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS         \
    3792                 :             :    | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
    3793                 :             :    | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT                 \
    3794                 :             :    | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT            \
    3795                 :             :    | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE      \
    3796                 :             :    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT | OMP_CLAUSE_ATTACH)
    3797                 :             : #define OACC_KERNELS_CLAUSES \
    3798                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS         \
    3799                 :             :    | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_DEVICEPTR \
    3800                 :             :    | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT                 \
    3801                 :             :    | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT            \
    3802                 :             :    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT | OMP_CLAUSE_ATTACH)
    3803                 :             : #define OACC_SERIAL_CLAUSES \
    3804                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_REDUCTION         \
    3805                 :             :    | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT                 \
    3806                 :             :    | OMP_CLAUSE_CREATE | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT            \
    3807                 :             :    | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE      \
    3808                 :             :    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT | OMP_CLAUSE_ATTACH)
    3809                 :             : #define OACC_DATA_CLAUSES \
    3810                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR  | OMP_CLAUSE_COPY         \
    3811                 :             :    | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE               \
    3812                 :             :    | OMP_CLAUSE_NO_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_ATTACH            \
    3813                 :             :    | OMP_CLAUSE_DEFAULT)
    3814                 :             : #define OACC_LOOP_CLAUSES \
    3815                 :             :   (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER       \
    3816                 :             :    | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT              \
    3817                 :             :    | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO              \
    3818                 :             :    | OMP_CLAUSE_TILE)
    3819                 :             : #define OACC_PARALLEL_LOOP_CLAUSES \
    3820                 :             :   (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
    3821                 :             : #define OACC_KERNELS_LOOP_CLAUSES \
    3822                 :             :   (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
    3823                 :             : #define OACC_SERIAL_LOOP_CLAUSES \
    3824                 :             :   (OACC_LOOP_CLAUSES | OACC_SERIAL_CLAUSES)
    3825                 :             : #define OACC_HOST_DATA_CLAUSES \
    3826                 :             :   (omp_mask (OMP_CLAUSE_USE_DEVICE)                                           \
    3827                 :             :    | OMP_CLAUSE_IF                                                            \
    3828                 :             :    | OMP_CLAUSE_IF_PRESENT)
    3829                 :             : #define OACC_DECLARE_CLAUSES \
    3830                 :             :   (omp_mask (OMP_CLAUSE_COPY) | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT        \
    3831                 :             :    | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT    \
    3832                 :             :    | OMP_CLAUSE_PRESENT                       \
    3833                 :             :    | OMP_CLAUSE_LINK)
    3834                 :             : #define OACC_UPDATE_CLAUSES \
    3835                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF         \
    3836                 :             :    | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT | OMP_CLAUSE_IF_PRESENT)
    3837                 :             : #define OACC_ENTER_DATA_CLAUSES \
    3838                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT              \
    3839                 :             :    | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE | OMP_CLAUSE_ATTACH)
    3840                 :             : #define OACC_EXIT_DATA_CLAUSES \
    3841                 :             :   (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT              \
    3842                 :             :    | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE | OMP_CLAUSE_FINALIZE             \
    3843                 :             :    | OMP_CLAUSE_DETACH)
    3844                 :             : #define OACC_WAIT_CLAUSES \
    3845                 :             :   omp_mask (OMP_CLAUSE_ASYNC)
    3846                 :             : #define OACC_ROUTINE_CLAUSES \
    3847                 :             :   (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR         \
    3848                 :             :    | OMP_CLAUSE_SEQ                                                           \
    3849                 :             :    | OMP_CLAUSE_NOHOST)
    3850                 :             : 
    3851                 :             : 
    3852                 :             : static match
    3853                 :       10436 : match_acc (gfc_exec_op op, const omp_mask mask)
    3854                 :             : {
    3855                 :       10436 :   gfc_omp_clauses *c;
    3856                 :       10436 :   if (gfc_match_omp_clauses (&c, mask, false, false, true) != MATCH_YES)
    3857                 :             :     return MATCH_ERROR;
    3858                 :       10276 :   new_st.op = op;
    3859                 :       10276 :   new_st.ext.omp_clauses = c;
    3860                 :       10276 :   return MATCH_YES;
    3861                 :             : }
    3862                 :             : 
    3863                 :             : match
    3864                 :        1377 : gfc_match_oacc_parallel_loop (void)
    3865                 :             : {
    3866                 :        1377 :   return match_acc (EXEC_OACC_PARALLEL_LOOP, OACC_PARALLEL_LOOP_CLAUSES);
    3867                 :             : }
    3868                 :             : 
    3869                 :             : 
    3870                 :             : match
    3871                 :        2851 : gfc_match_oacc_parallel (void)
    3872                 :             : {
    3873                 :        2851 :   return match_acc (EXEC_OACC_PARALLEL, OACC_PARALLEL_CLAUSES);
    3874                 :             : }
    3875                 :             : 
    3876                 :             : 
    3877                 :             : match
    3878                 :         128 : gfc_match_oacc_kernels_loop (void)
    3879                 :             : {
    3880                 :         128 :   return match_acc (EXEC_OACC_KERNELS_LOOP, OACC_KERNELS_LOOP_CLAUSES);
    3881                 :             : }
    3882                 :             : 
    3883                 :             : 
    3884                 :             : match
    3885                 :         796 : gfc_match_oacc_kernels (void)
    3886                 :             : {
    3887                 :         796 :   return match_acc (EXEC_OACC_KERNELS, OACC_KERNELS_CLAUSES);
    3888                 :             : }
    3889                 :             : 
    3890                 :             : 
    3891                 :             : match
    3892                 :           4 : gfc_match_oacc_serial_loop (void)
    3893                 :             : {
    3894                 :           4 :   return match_acc (EXEC_OACC_SERIAL_LOOP, OACC_SERIAL_LOOP_CLAUSES);
    3895                 :             : }
    3896                 :             : 
    3897                 :             : 
    3898                 :             : match
    3899                 :          60 : gfc_match_oacc_serial (void)
    3900                 :             : {
    3901                 :          60 :   return match_acc (EXEC_OACC_SERIAL, OACC_SERIAL_CLAUSES);
    3902                 :             : }
    3903                 :             : 
    3904                 :             : 
    3905                 :             : match
    3906                 :         596 : gfc_match_oacc_data (void)
    3907                 :             : {
    3908                 :         596 :   return match_acc (EXEC_OACC_DATA, OACC_DATA_CLAUSES);
    3909                 :             : }
    3910                 :             : 
    3911                 :             : 
    3912                 :             : match
    3913                 :          65 : gfc_match_oacc_host_data (void)
    3914                 :             : {
    3915                 :          65 :   return match_acc (EXEC_OACC_HOST_DATA, OACC_HOST_DATA_CLAUSES);
    3916                 :             : }
    3917                 :             : 
    3918                 :             : 
    3919                 :             : match
    3920                 :        3274 : gfc_match_oacc_loop (void)
    3921                 :             : {
    3922                 :        3274 :   return match_acc (EXEC_OACC_LOOP, OACC_LOOP_CLAUSES);
    3923                 :             : }
    3924                 :             : 
    3925                 :             : 
    3926                 :             : match
    3927                 :         170 : gfc_match_oacc_declare (void)
    3928                 :             : {
    3929                 :         170 :   gfc_omp_clauses *c;
    3930                 :         170 :   gfc_omp_namelist *n;
    3931                 :         170 :   gfc_namespace *ns = gfc_current_ns;
    3932                 :         170 :   gfc_oacc_declare *new_oc;
    3933                 :         170 :   bool module_var = false;
    3934                 :         170 :   locus where = gfc_current_locus;
    3935                 :             : 
    3936                 :         170 :   if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
    3937                 :             :       != MATCH_YES)
    3938                 :             :     return MATCH_ERROR;
    3939                 :             : 
    3940                 :         252 :   for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next)
    3941                 :          88 :     n->sym->attr.oacc_declare_device_resident = 1;
    3942                 :             : 
    3943                 :         184 :   for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next)
    3944                 :          20 :     n->sym->attr.oacc_declare_link = 1;
    3945                 :             : 
    3946                 :         295 :   for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next)
    3947                 :             :     {
    3948                 :         141 :       gfc_symbol *s = n->sym;
    3949                 :             : 
    3950                 :         141 :       if (gfc_current_ns->proc_name
    3951                 :         141 :           && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
    3952                 :             :         {
    3953                 :          48 :           if (n->u.map_op != OMP_MAP_ALLOC && n->u.map_op != OMP_MAP_TO)
    3954                 :             :             {
    3955                 :           6 :               gfc_error ("Invalid clause in module with !$ACC DECLARE at %L",
    3956                 :             :                          &where);
    3957                 :           6 :               return MATCH_ERROR;
    3958                 :             :             }
    3959                 :             : 
    3960                 :             :           module_var = true;
    3961                 :             :         }
    3962                 :             : 
    3963                 :         135 :       if (s->attr.use_assoc)
    3964                 :             :         {
    3965                 :           0 :           gfc_error ("Variable is USE-associated with !$ACC DECLARE at %L",
    3966                 :             :                      &where);
    3967                 :           0 :           return MATCH_ERROR;
    3968                 :             :         }
    3969                 :             : 
    3970                 :         135 :       if ((s->result == s && s->ns->contained != gfc_current_ns)
    3971                 :         135 :           || ((s->attr.flavor == FL_UNKNOWN || s->attr.flavor == FL_VARIABLE)
    3972                 :         125 :               && s->ns != gfc_current_ns))
    3973                 :             :         {
    3974                 :           2 :           gfc_error ("Variable %qs shall be declared in the same scoping unit "
    3975                 :             :                      "as !$ACC DECLARE at %L", s->name, &where);
    3976                 :           2 :           return MATCH_ERROR;
    3977                 :             :         }
    3978                 :             : 
    3979                 :         133 :       if ((s->attr.dimension || s->attr.codimension)
    3980                 :          69 :           && s->attr.dummy && s->as->type != AS_EXPLICIT)
    3981                 :             :         {
    3982                 :           2 :           gfc_error ("Assumed-size dummy array with !$ACC DECLARE at %L",
    3983                 :             :                      &where);
    3984                 :           2 :           return MATCH_ERROR;
    3985                 :             :         }
    3986                 :             : 
    3987                 :         131 :       switch (n->u.map_op)
    3988                 :             :         {
    3989                 :          49 :           case OMP_MAP_FORCE_ALLOC:
    3990                 :          49 :           case OMP_MAP_ALLOC:
    3991                 :          49 :             s->attr.oacc_declare_create = 1;
    3992                 :          49 :             break;
    3993                 :             : 
    3994                 :          48 :           case OMP_MAP_FORCE_TO:
    3995                 :          48 :           case OMP_MAP_TO:
    3996                 :          48 :             s->attr.oacc_declare_copyin = 1;
    3997                 :          48 :             break;
    3998                 :             : 
    3999                 :           1 :           case OMP_MAP_FORCE_DEVICEPTR:
    4000                 :           1 :             s->attr.oacc_declare_deviceptr = 1;
    4001                 :           1 :             break;
    4002                 :             : 
    4003                 :             :           default:
    4004                 :             :             break;
    4005                 :             :         }
    4006                 :             :     }
    4007                 :             : 
    4008                 :         154 :   new_oc = gfc_get_oacc_declare ();
    4009                 :         154 :   new_oc->next = ns->oacc_declare;
    4010                 :         154 :   new_oc->module_var = module_var;
    4011                 :         154 :   new_oc->clauses = c;
    4012                 :         154 :   new_oc->loc = gfc_current_locus;
    4013                 :         154 :   ns->oacc_declare = new_oc;
    4014                 :             : 
    4015                 :         154 :   return MATCH_YES;
    4016                 :             : }
    4017                 :             : 
    4018                 :             : 
    4019                 :             : match
    4020                 :         688 : gfc_match_oacc_update (void)
    4021                 :             : {
    4022                 :         688 :   gfc_omp_clauses *c;
    4023                 :         688 :   locus here = gfc_current_locus;
    4024                 :             : 
    4025                 :         688 :   if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
    4026                 :             :       != MATCH_YES)
    4027                 :             :     return MATCH_ERROR;
    4028                 :             : 
    4029                 :         684 :   if (!c->lists[OMP_LIST_MAP])
    4030                 :             :     {
    4031                 :           1 :       gfc_error ("%<acc update%> must contain at least one "
    4032                 :             :                  "%<device%> or %<host%> or %<self%> clause at %L", &here);
    4033                 :           1 :       return MATCH_ERROR;
    4034                 :             :     }
    4035                 :             : 
    4036                 :         683 :   new_st.op = EXEC_OACC_UPDATE;
    4037                 :         683 :   new_st.ext.omp_clauses = c;
    4038                 :         683 :   return MATCH_YES;
    4039                 :             : }
    4040                 :             : 
    4041                 :             : 
    4042                 :             : match
    4043                 :         779 : gfc_match_oacc_enter_data (void)
    4044                 :             : {
    4045                 :         779 :   return match_acc (EXEC_OACC_ENTER_DATA, OACC_ENTER_DATA_CLAUSES);
    4046                 :             : }
    4047                 :             : 
    4048                 :             : 
    4049                 :             : match
    4050                 :         506 : gfc_match_oacc_exit_data (void)
    4051                 :             : {
    4052                 :         506 :   return match_acc (EXEC_OACC_EXIT_DATA, OACC_EXIT_DATA_CLAUSES);
    4053                 :             : }
    4054                 :             : 
    4055                 :             : 
    4056                 :             : match
    4057                 :         197 : gfc_match_oacc_wait (void)
    4058                 :             : {
    4059                 :         197 :   gfc_omp_clauses *c = gfc_get_omp_clauses ();
    4060                 :         197 :   gfc_expr_list *wait_list = NULL, *el;
    4061                 :         197 :   bool space = true;
    4062                 :         197 :   match m;
    4063                 :             : 
    4064                 :         197 :   m = match_oacc_expr_list (" (", &wait_list, true);
    4065                 :         197 :   if (m == MATCH_ERROR)
    4066                 :             :     return m;
    4067                 :         191 :   else if (m == MATCH_YES)
    4068                 :         120 :     space = false;
    4069                 :             : 
    4070                 :         191 :   if (gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, space, space, true)
    4071                 :             :       == MATCH_ERROR)
    4072                 :             :     return MATCH_ERROR;
    4073                 :             : 
    4074                 :         178 :   if (wait_list)
    4075                 :         249 :     for (el = wait_list; el; el = el->next)
    4076                 :             :       {
    4077                 :         134 :         if (el->expr == NULL)
    4078                 :             :           {
    4079                 :           2 :             gfc_error ("Invalid argument to !$ACC WAIT at %C");
    4080                 :           2 :             return MATCH_ERROR;
    4081                 :             :           }
    4082                 :             : 
    4083                 :         132 :         if (!gfc_resolve_expr (el->expr)
    4084                 :         132 :             || el->expr->ts.type != BT_INTEGER || el->expr->rank != 0)
    4085                 :             :           {
    4086                 :           3 :             gfc_error ("WAIT clause at %L requires a scalar INTEGER expression",
    4087                 :           3 :                        &el->expr->where);
    4088                 :             : 
    4089                 :           3 :             return MATCH_ERROR;
    4090                 :             :           }
    4091                 :             :       }
    4092                 :         173 :   c->wait_list = wait_list;
    4093                 :         173 :   new_st.op = EXEC_OACC_WAIT;
    4094                 :         173 :   new_st.ext.omp_clauses = c;
    4095                 :         173 :   return MATCH_YES;
    4096                 :             : }
    4097                 :             : 
    4098                 :             : 
    4099                 :             : match
    4100                 :          74 : gfc_match_oacc_cache (void)
    4101                 :             : {
    4102                 :          74 :   gfc_omp_clauses *c = gfc_get_omp_clauses ();
    4103                 :             :   /* The OpenACC cache directive explicitly only allows "array elements or
    4104                 :             :      subarrays", which we're currently not checking here.  Either check this
    4105                 :             :      after the call of gfc_match_omp_variable_list, or add something like a
    4106                 :             :      only_sections variant next to its allow_sections parameter.  */
    4107                 :          74 :   match m = gfc_match_omp_variable_list (" (",
    4108                 :             :                                          &c->lists[OMP_LIST_CACHE], true,
    4109                 :             :                                          NULL, NULL, true);
    4110                 :          74 :   if (m != MATCH_YES)
    4111                 :             :     {
    4112                 :           1 :       gfc_free_omp_clauses(c);
    4113                 :           1 :       return m;
    4114                 :             :     }
    4115                 :             : 
    4116                 :          73 :   if (gfc_current_state() != COMP_DO 
    4117                 :          56 :       && gfc_current_state() != COMP_DO_CONCURRENT)
    4118                 :             :     {
    4119                 :           2 :       gfc_error ("ACC CACHE directive must be inside of loop %C");
    4120                 :           2 :       gfc_free_omp_clauses(c);
    4121                 :           2 :       return MATCH_ERROR;
    4122                 :             :     }
    4123                 :             : 
    4124                 :          71 :   new_st.op = EXEC_OACC_CACHE;
    4125                 :          71 :   new_st.ext.omp_clauses = c;
    4126                 :          71 :   return MATCH_YES;
    4127                 :             : }
    4128                 :             : 
    4129                 :             : /* Determine the OpenACC 'routine' directive's level of parallelism.  */
    4130                 :             : 
    4131                 :             : static oacc_routine_lop
    4132                 :         716 : gfc_oacc_routine_lop (gfc_omp_clauses *clauses)
    4133                 :             : {
    4134                 :         716 :   oacc_routine_lop ret = OACC_ROUTINE_LOP_SEQ;
    4135                 :             : 
    4136                 :         716 :   if (clauses)
    4137                 :             :     {
    4138                 :         568 :       unsigned n_lop_clauses = 0;
    4139                 :             : 
    4140                 :         568 :       if (clauses->gang)
    4141                 :             :         {
    4142                 :         160 :           ++n_lop_clauses;
    4143                 :         160 :           ret = OACC_ROUTINE_LOP_GANG;
    4144                 :             :         }
    4145                 :         568 :       if (clauses->worker)
    4146                 :             :         {
    4147                 :         110 :           ++n_lop_clauses;
    4148                 :         110 :           ret = OACC_ROUTINE_LOP_WORKER;
    4149                 :             :         }
    4150                 :         568 :       if (clauses->vector)
    4151                 :             :         {
    4152                 :         112 :           ++n_lop_clauses;
    4153                 :         112 :           ret = OACC_ROUTINE_LOP_VECTOR;
    4154                 :             :         }
    4155                 :         568 :       if (clauses->seq)
    4156                 :             :         {
    4157                 :         202 :           ++n_lop_clauses;
    4158                 :         202 :           ret = OACC_ROUTINE_LOP_SEQ;
    4159                 :             :         }
    4160                 :             : 
    4161                 :         568 :       if (n_lop_clauses > 1)
    4162                 :          47 :         ret = OACC_ROUTINE_LOP_ERROR;
    4163                 :             :     }
    4164                 :             : 
    4165                 :         716 :   return ret;
    4166                 :             : }
    4167                 :             : 
    4168                 :             : match
    4169                 :         680 : gfc_match_oacc_routine (void)
    4170                 :             : {
    4171                 :         680 :   locus old_loc;
    4172                 :         680 :   match m;
    4173                 :         680 :   gfc_intrinsic_sym *isym = NULL;
    4174                 :         680 :   gfc_symbol *sym = NULL;
    4175                 :         680 :   gfc_omp_clauses *c = NULL;
    4176                 :         680 :   gfc_oacc_routine_name *n = NULL;
    4177                 :         680 :   oacc_routine_lop lop = OACC_ROUTINE_LOP_NONE;
    4178                 :         680 :   bool nohost;
    4179                 :             : 
    4180                 :         680 :   old_loc = gfc_current_locus;
    4181                 :             : 
    4182                 :         680 :   m = gfc_match (" (");
    4183                 :             : 
    4184                 :         680 :   if (gfc_current_ns->proc_name
    4185                 :         678 :       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
    4186                 :          90 :       && m == MATCH_YES)
    4187                 :             :     {
    4188                 :           3 :       gfc_error ("Only the !$ACC ROUTINE form without "
    4189                 :             :                  "list is allowed in interface block at %C");
    4190                 :           3 :       goto cleanup;
    4191                 :             :     }
    4192                 :             : 
    4193                 :         590 :   if (m == MATCH_YES)
    4194                 :             :     {
    4195                 :         279 :       char buffer[GFC_MAX_SYMBOL_LEN + 1];
    4196                 :             : 
    4197                 :         279 :       m = gfc_match_name (buffer);
    4198                 :         279 :       if (m == MATCH_YES)
    4199                 :             :         {
    4200                 :         278 :           gfc_symtree *st = NULL;
    4201                 :             : 
    4202                 :             :           /* First look for an intrinsic symbol.  */
    4203                 :         278 :           isym = gfc_find_function (buffer);
    4204                 :         278 :           if (!isym)
    4205                 :         278 :             isym = gfc_find_subroutine (buffer);
    4206                 :             :           /* If no intrinsic symbol found, search the current namespace.  */
    4207                 :         278 :           if (!isym)
    4208                 :         260 :             st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
    4209                 :         260 :           if (st)
    4210                 :             :             {
    4211                 :         254 :               sym = st->n.sym;
    4212                 :             :               /* If the name in a 'routine' directive refers to the containing
    4213                 :             :                  subroutine or function, then make sure that we'll later handle
    4214                 :             :                  this accordingly.  */
    4215                 :         254 :               if (gfc_current_ns->proc_name != NULL
    4216                 :         254 :                   && strcmp (sym->name, gfc_current_ns->proc_name->name) == 0)
    4217                 :         278 :                 sym = NULL;
    4218                 :             :             }
    4219                 :             : 
    4220                 :         278 :           if (isym == NULL && st == NULL)
    4221                 :             :             {
    4222                 :           6 :               gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C",
    4223                 :             :                          buffer);
    4224                 :           6 :               gfc_current_locus = old_loc;
    4225                 :           9 :               return MATCH_ERROR;
    4226                 :             :             }
    4227                 :             :         }
    4228                 :             :       else
    4229                 :             :         {
    4230                 :           1 :           gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
    4231                 :           1 :           gfc_current_locus = old_loc;
    4232                 :           1 :           return MATCH_ERROR;
    4233                 :             :         }
    4234                 :             : 
    4235                 :         272 :       if (gfc_match_char (')') != MATCH_YES)
    4236                 :             :         {
    4237                 :           2 :           gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
    4238                 :             :                      " %<)%> after NAME");
    4239                 :           2 :           gfc_current_locus = old_loc;
    4240                 :           2 :           return MATCH_ERROR;
    4241                 :             :         }
    4242                 :             :     }
    4243                 :             : 
    4244                 :         668 :   if (gfc_match_omp_eos () != MATCH_YES
    4245                 :         668 :       && (gfc_match_omp_clauses (&c, OACC_ROUTINE_CLAUSES, false, false, true)
    4246                 :             :           != MATCH_YES))
    4247                 :             :     return MATCH_ERROR;
    4248                 :             : 
    4249                 :         665 :   lop = gfc_oacc_routine_lop (c);
    4250                 :         665 :   if (lop == OACC_ROUTINE_LOP_ERROR)
    4251                 :             :     {
    4252                 :          47 :       gfc_error ("Multiple loop axes specified for routine at %C");
    4253                 :          47 :       goto cleanup;
    4254                 :             :     }
    4255                 :         618 :   nohost = c ? c->nohost : false;
    4256                 :             : 
    4257                 :         618 :   if (isym != NULL)
    4258                 :             :     {
    4259                 :             :       /* Diagnose any OpenACC 'routine' directive that doesn't match the
    4260                 :             :          (implicit) one with a 'seq' clause.  */
    4261                 :          16 :       if (c && (c->gang || c->worker || c->vector))
    4262                 :             :         {
    4263                 :          10 :           gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME )"
    4264                 :             :                      " at %C marked with incompatible GANG, WORKER, or VECTOR"
    4265                 :             :                      " clause");
    4266                 :          10 :           goto cleanup;
    4267                 :             :         }
    4268                 :             :       /* ..., and no 'nohost' clause.  */
    4269                 :           6 :       if (nohost)
    4270                 :             :         {
    4271                 :           2 :           gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME )"
    4272                 :             :                      " at %C marked with incompatible NOHOST clause");
    4273                 :           2 :           goto cleanup;
    4274                 :             :         }
    4275                 :             :     }
    4276                 :         602 :   else if (sym != NULL)
    4277                 :             :     {
    4278                 :         135 :       bool add = true;
    4279                 :             : 
    4280                 :             :       /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
    4281                 :             :          match the first one.  */
    4282                 :         135 :       for (gfc_oacc_routine_name *n_p = gfc_current_ns->oacc_routine_names;
    4283                 :         306 :            n_p;
    4284                 :         171 :            n_p = n_p->next)
    4285                 :         211 :         if (n_p->sym == sym)
    4286                 :             :           {
    4287                 :          51 :             add = false;
    4288                 :          51 :             bool nohost_p = n_p->clauses ? n_p->clauses->nohost : false;
    4289                 :          51 :             if (lop != gfc_oacc_routine_lop (n_p->clauses)
    4290                 :          51 :                 || nohost != nohost_p)
    4291                 :             :               {
    4292                 :          40 :                 gfc_error ("!$ACC ROUTINE already applied at %C");
    4293                 :          40 :                 goto cleanup;
    4294                 :             :               }
    4295                 :             :           }
    4296                 :             : 
    4297                 :          95 :       if (add)
    4298                 :             :         {
    4299                 :          84 :           sym->attr.oacc_routine_lop = lop;
    4300                 :          84 :           sym->attr.oacc_routine_nohost = nohost;
    4301                 :             : 
    4302                 :          84 :           n = gfc_get_oacc_routine_name ();
    4303                 :          84 :           n->sym = sym;
    4304                 :          84 :           n->clauses = c;
    4305                 :          84 :           n->next = gfc_current_ns->oacc_routine_names;
    4306                 :          84 :           n->loc = old_loc;
    4307                 :          84 :           gfc_current_ns->oacc_routine_names = n;
    4308                 :             :         }
    4309                 :             :     }
    4310                 :         467 :   else if (gfc_current_ns->proc_name)
    4311                 :             :     {
    4312                 :             :       /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
    4313                 :             :          match the first one.  */
    4314                 :         466 :       oacc_routine_lop lop_p = gfc_current_ns->proc_name->attr.oacc_routine_lop;
    4315                 :         466 :       bool nohost_p = gfc_current_ns->proc_name->attr.oacc_routine_nohost;
    4316                 :         466 :       if (lop_p != OACC_ROUTINE_LOP_NONE
    4317                 :          86 :           && (lop != lop_p
    4318                 :          86 :               || nohost != nohost_p))
    4319                 :             :         {
    4320                 :          56 :           gfc_error ("!$ACC ROUTINE already applied at %C");
    4321                 :          56 :           goto cleanup;
    4322                 :             :         }
    4323                 :             : 
    4324                 :         410 :       if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
    4325                 :             :                                        gfc_current_ns->proc_name->name,
    4326                 :             :                                        &old_loc))
    4327                 :           1 :         goto cleanup;
    4328                 :         409 :       gfc_current_ns->proc_name->attr.oacc_routine_lop = lop;
    4329                 :         409 :       gfc_current_ns->proc_name->attr.oacc_routine_nohost = nohost;
    4330                 :             :     }
    4331                 :             :   else
    4332                 :             :     /* Something has gone wrong, possibly a syntax error.  */
    4333                 :           1 :     goto cleanup;
    4334                 :             : 
    4335                 :         508 :   if (gfc_pure (NULL) && c && (c->gang || c->worker || c->vector))
    4336                 :             :     {
    4337                 :           6 :       gfc_error ("!$ACC ROUTINE with GANG, WORKER, or VECTOR clause is not "
    4338                 :             :                  "permitted in PURE procedure at %C");
    4339                 :           6 :       goto cleanup;
    4340                 :             :     }
    4341                 :             : 
    4342                 :             : 
    4343                 :         502 :   if (n)
    4344                 :          84 :     n->clauses = c;
    4345                 :         418 :   else if (gfc_current_ns->oacc_routine)
    4346                 :           0 :     gfc_current_ns->oacc_routine_clauses = c;
    4347                 :             : 
    4348                 :         502 :   new_st.op = EXEC_OACC_ROUTINE;
    4349                 :         502 :   new_st.ext.omp_clauses = c;
    4350                 :         502 :   return MATCH_YES;  
    4351                 :             : 
    4352                 :         166 : cleanup:
    4353                 :         166 :   gfc_current_locus = old_loc;
    4354                 :         166 :   return MATCH_ERROR;
    4355                 :             : }
    4356                 :             : 
    4357                 :             : 
    4358                 :             : #define OMP_PARALLEL_CLAUSES \
    4359                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4360                 :             :    | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION       \
    4361                 :             :    | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT        \
    4362                 :             :    | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE)
    4363                 :             : #define OMP_DECLARE_SIMD_CLAUSES \
    4364                 :             :   (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR                    \
    4365                 :             :    | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH      \
    4366                 :             :    | OMP_CLAUSE_NOTINBRANCH)
    4367                 :             : #define OMP_DO_CLAUSES \
    4368                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4369                 :             :    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION                      \
    4370                 :             :    | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE     \
    4371                 :             :    | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE         \
    4372                 :             :    | OMP_CLAUSE_NOWAIT)
    4373                 :             : #define OMP_LOOP_CLAUSES \
    4374                 :             :   (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER  \
    4375                 :             :    | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
    4376                 :             : 
    4377                 :             : #define OMP_SCOPE_CLAUSES \
    4378                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) |OMP_CLAUSE_FIRSTPRIVATE               \
    4379                 :             :    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE | OMP_CLAUSE_NOWAIT)
    4380                 :             : #define OMP_SECTIONS_CLAUSES \
    4381                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4382                 :             :    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION                      \
    4383                 :             :    | OMP_CLAUSE_ALLOCATE | OMP_CLAUSE_NOWAIT)
    4384                 :             : #define OMP_SIMD_CLAUSES \
    4385                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE               \
    4386                 :             :    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN    \
    4387                 :             :    | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN        \
    4388                 :             :    | OMP_CLAUSE_IF | OMP_CLAUSE_ORDER | OMP_CLAUSE_NOTEMPORAL)
    4389                 :             : #define OMP_TASK_CLAUSES \
    4390                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4391                 :             :    | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT             \
    4392                 :             :    | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE        \
    4393                 :             :    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION  \
    4394                 :             :    | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE)
    4395                 :             : #define OMP_TASKLOOP_CLAUSES \
    4396                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4397                 :             :    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF         \
    4398                 :             :    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL          \
    4399                 :             :    | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE  \
    4400                 :             :    | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP    \
    4401                 :             :    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE)
    4402                 :             : #define OMP_TASKGROUP_CLAUSES \
    4403                 :             :   (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE)
    4404                 :             : #define OMP_TARGET_CLAUSES \
    4405                 :             :   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF        \
    4406                 :             :    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE         \
    4407                 :             :    | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP                    \
    4408                 :             :    | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION                 \
    4409                 :             :    | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE                      \
    4410                 :             :    | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS)
    4411                 :             : #define OMP_TARGET_DATA_CLAUSES \
    4412                 :             :   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF        \
    4413                 :             :    | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
    4414                 :             : #define OMP_TARGET_ENTER_DATA_CLAUSES \
    4415                 :             :   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF        \
    4416                 :             :    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
    4417                 :             : #define OMP_TARGET_EXIT_DATA_CLAUSES \
    4418                 :             :   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF        \
    4419                 :             :    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
    4420                 :             : #define OMP_TARGET_UPDATE_CLAUSES \
    4421                 :             :   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_IF | OMP_CLAUSE_TO         \
    4422                 :             :    | OMP_CLAUSE_FROM | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
    4423                 :             : #define OMP_TEAMS_CLAUSES \
    4424                 :             :   (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT            \
    4425                 :             :    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE  \
    4426                 :             :    | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
    4427                 :             : #define OMP_DISTRIBUTE_CLAUSES \
    4428                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4429                 :             :    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
    4430                 :             :    | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
    4431                 :             : #define OMP_SINGLE_CLAUSES \
    4432                 :             :   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE              \
    4433                 :             :    | OMP_CLAUSE_ALLOCATE | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_COPYPRIVATE)
    4434                 :             : #define OMP_ORDERED_CLAUSES \
    4435                 :             :   (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
    4436                 :             : #define OMP_DECLARE_TARGET_CLAUSES \
    4437                 :             :   (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \
    4438                 :             :    | OMP_CLAUSE_TO)
    4439                 :             : #define OMP_ATOMIC_CLAUSES \
    4440                 :             :   (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT  \
    4441                 :             :    | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL         \
    4442                 :             :    | OMP_CLAUSE_WEAK)
    4443                 :             : #define OMP_MASKED_CLAUSES \
    4444                 :             :   (omp_mask (OMP_CLAUSE_FILTER))
    4445                 :             : #define OMP_ERROR_CLAUSES \
    4446                 :             :   (omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY)
    4447                 :             : #define OMP_WORKSHARE_CLAUSES \
    4448                 :             :   omp_mask (OMP_CLAUSE_NOWAIT)
    4449                 :             : #define OMP_ALLOCATORS_CLAUSES \
    4450                 :             :   omp_mask (OMP_CLAUSE_ALLOCATE)
    4451                 :             : 
    4452                 :             : 
    4453                 :             : static match
    4454                 :       14400 : match_omp (gfc_exec_op op, const omp_mask mask)
    4455                 :             : {
    4456                 :       14400 :   gfc_omp_clauses *c;
    4457                 :       14400 :   if (gfc_match_omp_clauses (&c, mask, true, true, false, false,
    4458                 :             :                              op == EXEC_OMP_TARGET) != MATCH_YES)
    4459                 :             :     return MATCH_ERROR;
    4460                 :       14216 :   new_st.op = op;
    4461                 :       14216 :   new_st.ext.omp_clauses = c;
    4462                 :       14216 :   return MATCH_YES;
    4463                 :             : }
    4464                 :             : 
    4465                 :             : /* Handles both declarative and (deprecated) executable ALLOCATE directive;
    4466                 :             :    accepts optional list (for executable) and common blocks.
    4467                 :             :    If no variables have been provided, the single omp namelist has sym == NULL.
    4468                 :             : 
    4469                 :             :    Note that the executable ALLOCATE directive permits structure elements only
    4470                 :             :    in OpenMP 5.0 and 5.1 but not longer in 5.2.  See also the comment on the
    4471                 :             :    'omp allocators' directive below. The accidental change was reverted for
    4472                 :             :    OpenMP TR12, permitting them again. See also gfc_match_omp_allocators.
    4473                 :             : 
    4474                 :             :    Hence, structure elements are rejected for now, also to make resolving
    4475                 :             :    OMP_LIST_ALLOCATE simpler (check for duplicates, same symbol in
    4476                 :             :    Fortran allocate stmt).  TODO: Permit structure elements.  */
    4477                 :             : 
    4478                 :             : match
    4479                 :          92 : gfc_match_omp_allocate (void)
    4480                 :             : {
    4481                 :          92 :   match m;
    4482                 :          92 :   bool first = true;
    4483                 :          92 :   gfc_omp_namelist *vars = NULL;
    4484                 :          92 :   gfc_expr *align = NULL;
    4485                 :          92 :   gfc_expr *allocator = NULL;
    4486                 :          92 :   locus loc = gfc_current_locus;
    4487                 :             : 
    4488                 :          92 :   m = gfc_match_omp_variable_list (" (", &vars, true, NULL, NULL, true, true,
    4489                 :             :                                    NULL, true);
    4490                 :             : 
    4491                 :          92 :   if (m == MATCH_ERROR)
    4492                 :             :     return m;
    4493                 :             : 
    4494                 :         174 :   while (true)
    4495                 :             :     {
    4496                 :         174 :       gfc_gobble_whitespace ();
    4497                 :         174 :       if (gfc_match_omp_eos () == MATCH_YES)
    4498                 :             :         break;
    4499                 :          87 :       if (!first)
    4500                 :          12 :         gfc_match (", ");
    4501                 :          87 :       first = false;
    4502                 :          87 :       if ((m = gfc_match_dupl_check (!align, "align", true, &align))
    4503                 :             :           != MATCH_NO)
    4504                 :             :         {
    4505                 :          32 :           if (m == MATCH_ERROR)
    4506                 :           1 :             goto error;
    4507                 :          31 :           continue;
    4508                 :             :         }
    4509                 :          55 :       if ((m = gfc_match_dupl_check (!allocator, "allocator",
    4510                 :             :                                      true, &allocator)) != MATCH_NO)
    4511                 :             :         {
    4512                 :          54 :           if (m == MATCH_ERROR)
    4513                 :           1 :             goto error;
    4514                 :          53 :           continue;
    4515                 :             :         }
    4516                 :           1 :       gfc_error ("Expected ALIGN or ALLOCATOR clause at %C");
    4517                 :           1 :       return MATCH_ERROR;
    4518                 :             :     }
    4519                 :         181 :   for (gfc_omp_namelist *n = vars; n; n = n->next)
    4520                 :          97 :     if (n->expr)
    4521                 :             :       {
    4522                 :           3 :         if ((n->expr->ref && n->expr->ref->type == REF_COMPONENT)
    4523                 :           3 :             || (n->expr->ref->next && n->expr->ref->type == REF_COMPONENT))
    4524                 :           1 :           gfc_error ("Sorry, structure-element list item at %L in ALLOCATE "
    4525                 :             :                      "directive is not yet supported", &n->expr->where);
    4526                 :             :         else
    4527                 :           2 :           gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
    4528                 :             :                      "directive", &n->expr->where);
    4529                 :             : 
    4530                 :           3 :         gfc_free_omp_namelist (vars, false, true, false);
    4531                 :           3 :         goto error;
    4532                 :             :       }
    4533                 :             : 
    4534                 :          84 :   new_st.op = EXEC_OMP_ALLOCATE;
    4535                 :          84 :   new_st.ext.omp_clauses = gfc_get_omp_clauses ();
    4536                 :          84 :   if (vars == NULL)
    4537                 :             :     {
    4538                 :           6 :       vars = gfc_get_omp_namelist ();
    4539                 :           6 :       vars->where = loc;
    4540                 :           6 :       vars->u.align = align;
    4541                 :           6 :       vars->u2.allocator = allocator;
    4542                 :           6 :       new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = vars;
    4543                 :             :     }
    4544                 :             :   else
    4545                 :             :     {
    4546                 :          78 :       new_st.ext.omp_clauses->lists[OMP_LIST_ALLOCATE] = vars;
    4547                 :         172 :       for (; vars; vars = vars->next)
    4548                 :             :         {
    4549                 :          94 :           vars->u.align = (align) ? gfc_copy_expr (align) : NULL;
    4550                 :          94 :           vars->u2.allocator = ((allocator) ? gfc_copy_expr (allocator) : NULL);
    4551                 :             :         }
    4552                 :          78 :       gfc_free_expr (allocator);
    4553                 :          78 :       gfc_free_expr (align);
    4554                 :             :     }
    4555                 :             :   return MATCH_YES;
    4556                 :             : 
    4557                 :           5 : error:
    4558                 :           5 :   gfc_free_expr (align);
    4559                 :           5 :   gfc_free_expr (allocator);
    4560                 :           5 :   return MATCH_ERROR;
    4561                 :             : }
    4562                 :             : 
    4563                 :             : /* In line with OpenMP 5.2 derived-type components are rejected.
    4564                 :             :    See also comment before gfc_match_omp_allocate.  */
    4565                 :             : 
    4566                 :             : match
    4567                 :          11 : gfc_match_omp_allocators (void)
    4568                 :             : {
    4569                 :          11 :   return match_omp (EXEC_OMP_ALLOCATORS, OMP_ALLOCATORS_CLAUSES);
    4570                 :             : }
    4571                 :             : 
    4572                 :             : 
    4573                 :             : match
    4574                 :          17 : gfc_match_omp_assume (void)
    4575                 :             : {
    4576                 :          17 :   gfc_omp_clauses *c;
    4577                 :          17 :   locus loc = gfc_current_locus;
    4578                 :          17 :   if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
    4579                 :             :        != MATCH_YES)
    4580                 :          17 :       || (omp_verify_merge_absent_contains (ST_OMP_ASSUME, c->assume, NULL,
    4581                 :             :                                             &loc) != MATCH_YES))
    4582                 :           4 :     return MATCH_ERROR;
    4583                 :          13 :   new_st.op = EXEC_OMP_ASSUME;
    4584                 :          13 :   new_st.ext.omp_clauses = c;
    4585                 :          13 :   return MATCH_YES;
    4586                 :             : }
    4587                 :             : 
    4588                 :             : 
    4589                 :             : match
    4590                 :          28 : gfc_match_omp_assumes (void)
    4591                 :             : {
    4592                 :          28 :   gfc_omp_clauses *c;
    4593                 :          28 :   locus loc = gfc_current_locus;
    4594                 :          28 :   if (!gfc_current_ns->proc_name
    4595                 :          27 :       || (gfc_current_ns->proc_name->attr.flavor != FL_MODULE
    4596                 :             :           && !gfc_current_ns->proc_name->attr.subroutine
    4597                 :          23 :           && !gfc_current_ns->proc_name->attr.function))
    4598                 :             :     {
    4599                 :           2 :       gfc_error ("!$OMP ASSUMES at %C must be in the specification part of a "
    4600                 :             :                  "subprogram or module");
    4601                 :           2 :       return MATCH_ERROR;
    4602                 :             :     }
    4603                 :          26 :   if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
    4604                 :             :        != MATCH_YES)
    4605                 :          26 :       || (omp_verify_merge_absent_contains (ST_OMP_ASSUMES, c->assume,
    4606                 :             :                                             gfc_current_ns->omp_assumes, &loc)
    4607                 :             :           != MATCH_YES))
    4608                 :           5 :     return MATCH_ERROR;
    4609                 :          21 :   if (gfc_current_ns->omp_assumes == NULL)
    4610                 :             :     {
    4611                 :          19 :       gfc_current_ns->omp_assumes = c->assume;
    4612                 :          19 :       c->assume = NULL;
    4613                 :             :     }
    4614                 :           2 :   else if (gfc_current_ns->omp_assumes && c->assume)
    4615                 :             :     {
    4616                 :           2 :       gfc_current_ns->omp_assumes->no_openmp |= c->assume->no_openmp;
    4617                 :           2 :       gfc_current_ns->omp_assumes->no_openmp_routines
    4618                 :           2 :         |= c->assume->no_openmp_routines;
    4619                 :           2 :       gfc_current_ns->omp_assumes->no_parallelism |= c->assume->no_parallelism;
    4620                 :           2 :       if (gfc_current_ns->omp_assumes->holds && c->assume->holds)
    4621                 :             :         {
    4622                 :             :           gfc_expr_list *el = gfc_current_ns->omp_assumes->holds;
    4623                 :           1 :           for ( ; el->next ; el = el->next)
    4624                 :             :             ;
    4625                 :           1 :           el->next = c->assume->holds;
    4626                 :           1 :         }
    4627                 :           1 :       else if (c->assume->holds)
    4628                 :           0 :         gfc_current_ns->omp_assumes->holds = c->assume->holds;
    4629                 :           2 :       c->assume->holds = NULL;
    4630                 :             :     }
    4631                 :          21 :   gfc_free_omp_clauses (c);
    4632                 :          21 :   return MATCH_YES;
    4633                 :             : }
    4634                 :             : 
    4635                 :             : 
    4636                 :             : match
    4637                 :         162 : gfc_match_omp_critical (void)
    4638                 :             : {
    4639                 :         162 :   char n[GFC_MAX_SYMBOL_LEN+1];
    4640                 :         162 :   gfc_omp_clauses *c = NULL;
    4641                 :             : 
    4642                 :         162 :   if (gfc_match (" ( %n )", n) != MATCH_YES)
    4643                 :         115 :     n[0] = '\0';
    4644                 :             : 
    4645                 :         162 :   if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT),
    4646                 :         162 :                              /* first = */ n[0] == '\0') != MATCH_YES)
    4647                 :             :     return MATCH_ERROR;
    4648                 :             : 
    4649                 :         160 :   new_st.op = EXEC_OMP_CRITICAL;
    4650                 :         160 :   new_st.ext.omp_clauses = c;
    4651                 :         160 :   if (n[0])
    4652                 :          47 :     c->critical_name = xstrdup (n);
    4653                 :             :   return MATCH_YES;
    4654                 :             : }
    4655                 :             : 
    4656                 :             : 
    4657                 :             : match
    4658                 :         160 : gfc_match_omp_end_critical (void)
    4659                 :             : {
    4660                 :         160 :   char n[GFC_MAX_SYMBOL_LEN+1];
    4661                 :             : 
    4662                 :         160 :   if (gfc_match (" ( %n )", n) != MATCH_YES)
    4663                 :         113 :     n[0] = '\0';
    4664                 :         160 :   if (gfc_match_omp_eos () != MATCH_YES)
    4665                 :             :     {
    4666                 :           1 :       gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C");
    4667                 :           1 :       return MATCH_ERROR;
    4668                 :             :     }
    4669                 :             : 
    4670                 :         159 :   new_st.op = EXEC_OMP_END_CRITICAL;
    4671                 :         159 :   new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
    4672                 :         159 :   return MATCH_YES;
    4673                 :             : }
    4674                 :             : 
    4675                 :             : /* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type)
    4676                 :             :    dep-type = in/out/inout/mutexinoutset/depobj/source/sink
    4677                 :             :    depend: !source, !sink
    4678                 :             :    update: !source, !sink, !depobj
    4679                 :             :    locator = exactly one list item  .*/
    4680                 :             : match
    4681                 :         119 : gfc_match_omp_depobj (void)
    4682                 :             : {
    4683                 :         119 :   gfc_omp_clauses *c = NULL;
    4684                 :         119 :   gfc_expr *depobj;
    4685                 :             : 
    4686                 :         119 :   if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES)
    4687                 :             :     {
    4688                 :           2 :       gfc_error ("Expected %<( depobj )%> at %C");
    4689                 :           2 :       return MATCH_ERROR;
    4690                 :             :     }
    4691                 :         117 :   if (gfc_match ("update ( ") == MATCH_YES)
    4692                 :             :     {
    4693                 :          12 :       c = gfc_get_omp_clauses ();
    4694                 :          12 :       if (gfc_match ("inoutset )") == MATCH_YES)
    4695                 :           2 :         c->depobj_update = OMP_DEPEND_INOUTSET;
    4696                 :          10 :       else if (gfc_match ("inout )") == MATCH_YES)
    4697                 :           1 :         c->depobj_update = OMP_DEPEND_INOUT;
    4698                 :           9 :       else if (gfc_match ("in )") == MATCH_YES)
    4699                 :           2 :         c->depobj_update = OMP_DEPEND_IN;
    4700                 :           7 :       else if (gfc_match ("out )") == MATCH_YES)
    4701                 :           2 :         c->depobj_update = OMP_DEPEND_OUT;
    4702                 :           5 :       else if (gfc_match ("mutexinoutset )") == MATCH_YES)
    4703                 :           2 :         c->depobj_update = OMP_DEPEND_MUTEXINOUTSET;
    4704                 :             :       else
    4705                 :             :         {
    4706                 :           3 :           gfc_error ("Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET "
    4707                 :             :                      "followed by %<)%> at %C");
    4708                 :           3 :           goto error;
    4709                 :             :         }
    4710                 :             :     }
    4711                 :         105 :   else if (gfc_match ("destroy") == MATCH_YES)
    4712                 :             :     {
    4713                 :          11 :       c = gfc_get_omp_clauses ();
    4714                 :          11 :       c->destroy = true;
    4715                 :             :     }
    4716                 :          94 :   else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false)
    4717                 :             :            != MATCH_YES)
    4718                 :           2 :     goto error;
    4719                 :             : 
    4720                 :         112 :   if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
    4721                 :             :     {
    4722                 :          92 :       if (!c->doacross_source && !c->lists[OMP_LIST_DEPEND])
    4723                 :             :         {
    4724                 :           1 :           gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
    4725                 :           1 :           goto error;
    4726                 :             :         }
    4727                 :          91 :       if (c->lists[OMP_LIST_DEPEND]->u.depend_doacross_op == OMP_DEPEND_DEPOBJ)
    4728                 :             :         {
    4729                 :           1 :           gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
    4730                 :             :                      "have dependence-type DEPOBJ",
    4731                 :             :                      c->lists[OMP_LIST_DEPEND]
    4732                 :             :                      ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
    4733                 :           1 :           goto error;
    4734                 :             :         }
    4735                 :          90 :       if (c->lists[OMP_LIST_DEPEND]->next)
    4736                 :             :         {
    4737                 :           1 :           gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have "
    4738                 :             :                      "only a single locator",
    4739                 :             :                      &c->lists[OMP_LIST_DEPEND]->next->where);
    4740                 :           1 :           goto error;
    4741                 :             :         }
    4742                 :             :     }
    4743                 :             : 
    4744                 :         109 :   c->depobj = depobj;
    4745                 :         109 :   new_st.op = EXEC_OMP_DEPOBJ;
    4746                 :         109 :   new_st.ext.omp_clauses = c;
    4747                 :         109 :   return MATCH_YES;
    4748                 :             : 
    4749                 :           8 : error:
    4750                 :           8 :   gfc_free_expr (depobj);
    4751                 :           8 :   gfc_free_omp_clauses (c);
    4752                 :           8 :   return MATCH_ERROR;
    4753                 :             : }
    4754                 :             : 
    4755                 :             : match
    4756                 :          57 : gfc_match_omp_distribute (void)
    4757                 :             : {
    4758                 :          57 :   return match_omp (EXEC_OMP_DISTRIBUTE, OMP_DISTRIBUTE_CLAUSES);
    4759                 :             : }
    4760                 :             : 
    4761                 :             : 
    4762                 :             : match
    4763                 :          36 : gfc_match_omp_distribute_parallel_do (void)
    4764                 :             : {
    4765                 :          36 :   return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO,
    4766                 :          36 :                     (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
    4767                 :          36 :                      | OMP_DO_CLAUSES)
    4768                 :          36 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED)
    4769                 :          36 :                         | OMP_CLAUSE_LINEAR | OMP_CLAUSE_NOWAIT));
    4770                 :             : }
    4771                 :             : 
    4772                 :             : 
    4773                 :             : match
    4774                 :          34 : gfc_match_omp_distribute_parallel_do_simd (void)
    4775                 :             : {
    4776                 :          34 :   return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD,
    4777                 :          34 :                     (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
    4778                 :          34 :                      | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
    4779                 :          34 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED) | OMP_CLAUSE_NOWAIT));
    4780                 :             : }
    4781                 :             : 
    4782                 :             : 
    4783                 :             : match
    4784                 :          52 : gfc_match_omp_distribute_simd (void)
    4785                 :             : {
    4786                 :          52 :   return match_omp (EXEC_OMP_DISTRIBUTE_SIMD,
    4787                 :          52 :                     OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES);
    4788                 :             : }
    4789                 :             : 
    4790                 :             : 
    4791                 :             : match
    4792                 :        1155 : gfc_match_omp_do (void)
    4793                 :             : {
    4794                 :        1155 :   return match_omp (EXEC_OMP_DO, OMP_DO_CLAUSES);
    4795                 :             : }
    4796                 :             : 
    4797                 :             : 
    4798                 :             : match
    4799                 :         137 : gfc_match_omp_do_simd (void)
    4800                 :             : {
    4801                 :         137 :   return match_omp (EXEC_OMP_DO_SIMD, OMP_DO_CLAUSES | OMP_SIMD_CLAUSES);
    4802                 :             : }
    4803                 :             : 
    4804                 :             : 
    4805                 :             : match
    4806                 :          69 : gfc_match_omp_loop (void)
    4807                 :             : {
    4808                 :          69 :   return match_omp (EXEC_OMP_LOOP, OMP_LOOP_CLAUSES);
    4809                 :             : }
    4810                 :             : 
    4811                 :             : 
    4812                 :             : match
    4813                 :          12 : gfc_match_omp_teams_loop (void)
    4814                 :             : {
    4815                 :          12 :   return match_omp (EXEC_OMP_TEAMS_LOOP, OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES);
    4816                 :             : }
    4817                 :             : 
    4818                 :             : 
    4819                 :             : match
    4820                 :          15 : gfc_match_omp_target_teams_loop (void)
    4821                 :             : {
    4822                 :          15 :   return match_omp (EXEC_OMP_TARGET_TEAMS_LOOP,
    4823                 :          15 :                     OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES);
    4824                 :             : }
    4825                 :             : 
    4826                 :             : 
    4827                 :             : match
    4828                 :          12 : gfc_match_omp_parallel_loop (void)
    4829                 :             : {
    4830                 :          12 :   return match_omp (EXEC_OMP_PARALLEL_LOOP,
    4831                 :          12 :                     OMP_PARALLEL_CLAUSES | OMP_LOOP_CLAUSES);
    4832                 :             : }
    4833                 :             : 
    4834                 :             : 
    4835                 :             : match
    4836                 :          16 : gfc_match_omp_target_parallel_loop (void)
    4837                 :             : {
    4838                 :          16 :   return match_omp (EXEC_OMP_TARGET_PARALLEL_LOOP,
    4839                 :          16 :                     (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES
    4840                 :          16 :                      | OMP_LOOP_CLAUSES));
    4841                 :             : }
    4842                 :             : 
    4843                 :             : 
    4844                 :             : match
    4845                 :          88 : gfc_match_omp_error (void)
    4846                 :             : {
    4847                 :          88 :   locus loc = gfc_current_locus;
    4848                 :          88 :   match m = match_omp (EXEC_OMP_ERROR, OMP_ERROR_CLAUSES);
    4849                 :          88 :   if (m != MATCH_YES)
    4850                 :             :     return m;
    4851                 :             : 
    4852                 :          69 :   gfc_omp_clauses *c = new_st.ext.omp_clauses;
    4853                 :          69 :   if (c->severity == OMP_SEVERITY_UNSET)
    4854                 :          32 :     c->severity = OMP_SEVERITY_FATAL;
    4855                 :          69 :   if (new_st.ext.omp_clauses->at == OMP_AT_EXECUTION)
    4856                 :             :     return MATCH_YES;
    4857                 :          36 :   if (c->message
    4858                 :          36 :       && (!gfc_resolve_expr (c->message)
    4859                 :          16 :           || c->message->ts.type != BT_CHARACTER
    4860                 :          14 :           || c->message->ts.kind != gfc_default_character_kind
    4861                 :          13 :           || c->message->rank != 0))
    4862                 :             :     {
    4863                 :           4 :       gfc_error ("MESSAGE clause at %L requires a scalar default-kind "
    4864                 :             :                    "CHARACTER expression",
    4865                 :           4 :                  &new_st.ext.omp_clauses->message->where);
    4866                 :           4 :       return MATCH_ERROR;
    4867                 :             :     }
    4868                 :          32 :   if (c->message && !gfc_is_constant_expr (c->message))
    4869                 :             :     {
    4870                 :           2 :       gfc_error ("Constant character expression required in MESSAGE clause "
    4871                 :           2 :                  "at %L", &new_st.ext.omp_clauses->message->where);
    4872                 :           2 :       return MATCH_ERROR;
    4873                 :             :     }
    4874                 :          30 :   if (c->message)
    4875                 :             :     {
    4876                 :          10 :       const char *msg = G_("$OMP ERROR encountered at %L: %s");
    4877                 :          10 :       gcc_assert (c->message->expr_type == EXPR_CONSTANT);
    4878                 :          10 :       gfc_charlen_t slen = c->message->value.character.length;
    4879                 :          10 :       int i = gfc_validate_kind (BT_CHARACTER, gfc_default_character_kind,
    4880                 :             :                                  false);
    4881                 :          10 :       size_t size = slen * gfc_character_kinds[i].bit_size / 8;
    4882                 :          10 :       unsigned char *s = XCNEWVAR (unsigned char, size + 1);
    4883                 :          10 :       gfc_encode_character (gfc_default_character_kind, slen,
    4884                 :          10 :                             c->message->value.character.string,
    4885                 :             :                             (unsigned char *) s, size);
    4886                 :          10 :       s[size] = '\0';
    4887                 :          10 :       if (c->severity == OMP_SEVERITY_WARNING)
    4888                 :           6 :         gfc_warning_now (0, msg, &loc, s);
    4889                 :             :       else
    4890                 :           4 :         gfc_error_now (msg, &loc, s);
    4891                 :          10 :       free (s);
    4892                 :             :     }
    4893                 :             :   else
    4894                 :             :     {
    4895                 :          20 :       const char *msg = G_("$OMP ERROR encountered at %L");
    4896                 :          20 :       if (c->severity == OMP_SEVERITY_WARNING)
    4897                 :           7 :         gfc_warning_now (0, msg, &loc);
    4898                 :             :       else
    4899                 :          13 :         gfc_error_now (msg, &loc);
    4900                 :             :     }
    4901                 :             :   return MATCH_YES;
    4902                 :             : }
    4903                 :             : 
    4904                 :             : match
    4905                 :          82 : gfc_match_omp_flush (void)
    4906                 :             : {
    4907                 :          82 :   gfc_omp_namelist *list = NULL;
    4908                 :          82 :   gfc_omp_clauses *c = NULL;
    4909                 :          82 :   gfc_gobble_whitespace ();
    4910                 :          82 :   enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET;
    4911                 :          82 :   if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
    4912                 :             :     {
    4913                 :          14 :       if (gfc_match ("seq_cst") == MATCH_YES)
    4914                 :             :         mo = OMP_MEMORDER_SEQ_CST;
    4915                 :          11 :       else if (gfc_match ("acq_rel") == MATCH_YES)
    4916                 :             :         mo = OMP_MEMORDER_ACQ_REL;
    4917                 :           8 :       else if (gfc_match ("release") == MATCH_YES)
    4918                 :             :         mo = OMP_MEMORDER_RELEASE;
    4919                 :           5 :       else if (gfc_match ("acquire") == MATCH_YES)
    4920                 :             :         mo = OMP_MEMORDER_ACQUIRE;
    4921                 :             :       else
    4922                 :             :         {
    4923                 :           2 :           gfc_error ("Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE at %C");
    4924                 :           2 :           return MATCH_ERROR;
    4925                 :             :         }
    4926                 :          12 :       c = gfc_get_omp_clauses ();
    4927                 :          12 :       c->memorder = mo;
    4928                 :             :     }
    4929                 :          80 :   gfc_match_omp_variable_list (" (", &list, true);
    4930                 :          80 :   if (list && mo != OMP_MEMORDER_UNSET)
    4931                 :             :     {
    4932                 :           4 :       gfc_error ("List specified together with memory order clause in FLUSH "
    4933                 :             :                  "directive at %C");
    4934                 :           4 :       gfc_free_omp_namelist (list, false, false, false);
    4935                 :           4 :       gfc_free_omp_clauses (c);
    4936                 :           4 :       return MATCH_ERROR;
    4937                 :             :     }
    4938                 :          76 :   if (gfc_match_omp_eos () != MATCH_YES)
    4939                 :             :     {
    4940                 :           0 :       gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
    4941                 :           0 :       gfc_free_omp_namelist (list, false, false, false);
    4942                 :           0 :       gfc_free_omp_clauses (c);
    4943                 :           0 :       return MATCH_ERROR;
    4944                 :             :     }
    4945                 :          76 :   new_st.op = EXEC_OMP_FLUSH;
    4946                 :          76 :   new_st.ext.omp_namelist = list;
    4947                 :          76 :   new_st.ext.omp_clauses = c;
    4948                 :          76 :   return MATCH_YES;
    4949                 :             : }
    4950                 :             : 
    4951                 :             : 
    4952                 :             : match
    4953                 :         193 : gfc_match_omp_declare_simd (void)
    4954                 :             : {
    4955                 :         193 :   locus where = gfc_current_locus;
    4956                 :         193 :   gfc_symbol *proc_name;
    4957                 :         193 :   gfc_omp_clauses *c;
    4958                 :         193 :   gfc_omp_declare_simd *ods;
    4959                 :         193 :   bool needs_space = false;
    4960                 :             : 
    4961                 :         193 :   switch (gfc_match (" ( "))
    4962                 :             :     {
    4963                 :         149 :     case MATCH_YES:
    4964                 :         149 :       if (gfc_match_symbol (&proc_name, /* host assoc = */ true) != MATCH_YES
    4965                 :         149 :           || gfc_match (" ) ") != MATCH_YES)
    4966                 :           0 :         return MATCH_ERROR;
    4967                 :             :       break;
    4968                 :          44 :     case MATCH_NO: proc_name = NULL; needs_space = true; break;
    4969                 :             :     case MATCH_ERROR: return MATCH_ERROR;
    4970                 :             :     }
    4971                 :             : 
    4972                 :         193 :   if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
    4973                 :             :                              needs_space) != MATCH_YES)
    4974                 :             :     return MATCH_ERROR;
    4975                 :             : 
    4976                 :         188 :   if (gfc_current_ns->is_block_data)
    4977                 :             :     {
    4978                 :           1 :       gfc_free_omp_clauses (c);
    4979                 :           1 :       return MATCH_YES;
    4980                 :             :     }
    4981                 :             : 
    4982                 :         187 :   ods = gfc_get_omp_declare_simd ();
    4983                 :         187 :   ods->where = where;
    4984                 :         187 :   ods->proc_name = proc_name;
    4985                 :         187 :   ods->clauses = c;
    4986                 :         187 :   ods->next = gfc_current_ns->omp_declare_simd;
    4987                 :         187 :   gfc_current_ns->omp_declare_simd = ods;
    4988                 :         187 :   return MATCH_YES;
    4989                 :             : }
    4990                 :             : 
    4991                 :             : 
    4992                 :             : static bool
    4993                 :         877 : match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2)
    4994                 :             : {
    4995                 :         877 :   match m;
    4996                 :         877 :   locus old_loc = gfc_current_locus;
    4997                 :         877 :   char sname[GFC_MAX_SYMBOL_LEN + 1];
    4998                 :         877 :   gfc_symbol *sym;
    4999                 :         877 :   gfc_namespace *ns = gfc_current_ns;
    5000                 :         877 :   gfc_expr *lvalue = NULL, *rvalue = NULL;
    5001                 :         877 :   gfc_symtree *st;
    5002                 :         877 :   gfc_actual_arglist *arglist;
    5003                 :             : 
    5004                 :         877 :   m = gfc_match (" %v =", &lvalue);
    5005                 :         877 :   if (m != MATCH_YES)
    5006                 :         200 :     gfc_current_locus = old_loc;
    5007                 :             :   else
    5008                 :             :     {
    5009                 :         677 :       m = gfc_match (" %e )", &rvalue);
    5010                 :         677 :       if (m == MATCH_YES)
    5011                 :             :         {
    5012                 :         675 :           ns->code = gfc_get_code (EXEC_ASSIGN);
    5013                 :         675 :           ns->code->expr1 = lvalue;
    5014                 :         675 :           ns->code->expr2 = rvalue;
    5015                 :         675 :           ns->code->loc = old_loc;
    5016                 :         675 :           return true;
    5017                 :             :         }
    5018                 :             : 
    5019                 :           2 :       gfc_current_locus = old_loc;
    5020                 :           2 :       gfc_free_expr (lvalue);
    5021                 :             :     }
    5022                 :             : 
    5023                 :         202 :   m = gfc_match (" %n", sname);
    5024                 :         202 :   if (m != MATCH_YES)
    5025                 :             :     return false;
    5026                 :             : 
    5027                 :         202 :   if (strcmp (sname, omp_sym1->name) == 0
    5028                 :         200 :       || strcmp (sname, omp_sym2->name) == 0)
    5029                 :             :     return false;
    5030                 :             : 
    5031                 :         200 :   gfc_current_ns = ns->parent;
    5032                 :         200 :   if (gfc_get_ha_sym_tree (sname, &st))
    5033                 :             :     return false;
    5034                 :             : 
    5035                 :         200 :   sym = st->n.sym;
    5036                 :         200 :   if (sym->attr.flavor != FL_PROCEDURE
    5037                 :          72 :       && sym->attr.flavor != FL_UNKNOWN)
    5038                 :             :     return false;
    5039                 :             : 
    5040                 :         199 :   if (!sym->attr.generic
    5041                 :             :       && !sym->attr.subroutine
    5042                 :         199 :       && !sym->attr.function)
    5043                 :             :     {
    5044                 :          71 :       if (!(sym->attr.external && !sym->attr.referenced))
    5045                 :             :         {
    5046                 :             :           /* ...create a symbol in this scope...  */
    5047                 :          71 :           if (sym->ns != gfc_current_ns
    5048                 :          71 :               && gfc_get_sym_tree (sname, NULL, &st, false) == 1)
    5049                 :             :             return false;
    5050                 :             : 
    5051                 :          71 :           if (sym != st->n.sym)
    5052                 :          71 :             sym = st->n.sym;
    5053                 :             :         }
    5054                 :             : 
    5055                 :             :       /* ...and then to try to make the symbol into a subroutine.  */
    5056                 :          71 :       if (!gfc_add_subroutine (&sym->attr, sym->name, NULL))
    5057                 :             :         return false;
    5058                 :             :     }
    5059                 :             : 
    5060                 :         199 :   gfc_set_sym_referenced (sym);
    5061                 :         199 :   gfc_gobble_whitespace ();
    5062                 :         199 :   if (gfc_peek_ascii_char () != '(')
    5063                 :             :     return false;
    5064                 :             : 
    5065                 :         195 :   gfc_current_ns = ns;
    5066                 :         195 :   m = gfc_match_actual_arglist (1, &arglist);
    5067                 :         195 :   if (m != MATCH_YES)
    5068                 :             :     return false;
    5069                 :             : 
    5070                 :         195 :   if (gfc_match_char (')') != MATCH_YES)
    5071                 :             :     return false;
    5072                 :             : 
    5073                 :         195 :   ns->code = gfc_get_code (EXEC_CALL);
    5074                 :         195 :   ns->code->symtree = st;
    5075                 :         195 :   ns->code->ext.actual = arglist;
    5076                 :         195 :   ns->code->loc = old_loc;
    5077                 :         195 :   return true;
    5078                 :             : }
    5079                 :             : 
    5080                 :             : static bool
    5081                 :        1156 : gfc_omp_udr_predef (gfc_omp_reduction_op rop, const char *name,
    5082                 :             :                     gfc_typespec *ts, const char **n)
    5083                 :             : {
    5084                 :        1156 :   if (!gfc_numeric_ts (ts) && ts->type != BT_LOGICAL)
    5085                 :             :     return false;
    5086                 :             : 
    5087                 :         648 :   switch (rop)
    5088                 :             :     {
    5089                 :          21 :     case OMP_REDUCTION_PLUS:
    5090                 :          21 :     case OMP_REDUCTION_MINUS:
    5091                 :          21 :     case OMP_REDUCTION_TIMES:
    5092                 :          21 :       return ts->type != BT_LOGICAL;
    5093                 :           8 :     case OMP_REDUCTION_AND:
    5094                 :           8 :     case OMP_REDUCTION_OR:
    5095                 :           8 :     case OMP_REDUCTION_EQV:
    5096                 :           8 :     case OMP_REDUCTION_NEQV:
    5097                 :           8 :       return ts->type == BT_LOGICAL;
    5098                 :         618 :     case OMP_REDUCTION_USER:
    5099                 :         618 :       if (name[0] != '.' && (ts->type == BT_INTEGER || ts->type == BT_REAL))
    5100                 :             :         {
    5101                 :         546 :           gfc_symbol *sym;
    5102                 :             : 
    5103                 :         546 :           gfc_find_symbol (name, NULL, 1, &sym);
    5104                 :         546 :           if (sym != NULL)
    5105                 :             :             {
    5106                 :          93 :               if (sym->attr.intrinsic)
    5107                 :           0 :                 *n = sym->name;
    5108                 :          93 :               else if ((sym->attr.flavor != FL_UNKNOWN
    5109                 :          81 :                         && sym->attr.flavor != FL_PROCEDURE)
    5110                 :             :                        || sym->attr.external
    5111                 :          69 :                        || sym->attr.generic
    5112                 :          54 :                        || sym->attr.entry
    5113                 :             :                        || sym->attr.result
    5114                 :             :                        || sym->attr.dummy
    5115                 :             :                        || sym->attr.subroutine
    5116                 :             :                        || sym->attr.pointer
    5117                 :          54 :                        || sym->attr.target
    5118                 :             :                        || sym->attr.cray_pointer
    5119                 :          50 :                        || sym->attr.cray_pointee
    5120                 :          50 :                        || (sym->attr.proc != PROC_UNKNOWN
    5121                 :           0 :                            && sym->attr.proc != PROC_INTRINSIC)
    5122                 :          50 :                        || sym->attr.if_source != IFSRC_UNKNOWN
    5123                 :          50 :                        || sym == sym->ns->proc_name)
    5124                 :          43 :                 *n = NULL;
    5125                 :             :               else
    5126                 :          50 :                 *n = sym->name;
    5127                 :             :             }
    5128                 :             :           else
    5129                 :         453 :             *n = name;
    5130                 :         546 :           if (*n
    5131                 :         503 :               && (strcmp (*n, "max") == 0 || strcmp (*n, "min") == 0))
    5132                 :          54 :             return true;
    5133                 :         510 :           else if (*n
    5134                 :         467 :                    && ts->type == BT_INTEGER
    5135                 :         383 :                    && (strcmp (*n, "iand") == 0
    5136                 :         377 :                        || strcmp (*n, "ior") == 0
    5137                 :         371 :                        || strcmp (*n, "ieor") == 0))
    5138                 :             :             return true;
    5139                 :             :         }
    5140                 :             :       break;
    5141                 :             :     default:
    5142                 :             :       break;
    5143                 :             :     }
    5144                 :             :   return false;
    5145                 :             : }
    5146                 :             : 
    5147                 :             : gfc_omp_udr *
    5148                 :         639 : gfc_omp_udr_find (gfc_symtree *st, gfc_typespec *ts)
    5149                 :             : {
    5150                 :         639 :   gfc_omp_udr *omp_udr;
    5151                 :             : 
    5152                 :         639 :   if (st == NULL)
    5153                 :             :     return NULL;
    5154                 :             : 
    5155                 :         250 :   for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
    5156                 :         154 :     if (omp_udr->ts.type == ts->type
    5157                 :          89 :         || ((omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS)
    5158                 :           0 :             && (ts->type == BT_DERIVED || ts->type == BT_CLASS)))
    5159                 :             :       {
    5160                 :          65 :         if (omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS)
    5161                 :             :           {
    5162                 :          12 :             if (strcmp (omp_udr->ts.u.derived->name, ts->u.derived->name) == 0)
    5163                 :           6 :               return omp_udr;
    5164                 :             :           }
    5165                 :          53 :         else if (omp_udr->ts.kind == ts->kind)
    5166                 :             :           {
    5167                 :          19 :             if (omp_udr->ts.type == BT_CHARACTER)
    5168                 :             :               {
    5169                 :          17 :                 if (omp_udr->ts.u.cl->length == NULL
    5170                 :          15 :                     || ts->u.cl->length == NULL)
    5171                 :           2 :                   return omp_udr;
    5172                 :          15 :                 if (omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
    5173                 :           0 :                   return omp_udr;
    5174                 :          15 :                 if (ts->u.cl->length->expr_type != EXPR_CONSTANT)
    5175                 :           0 :                   return omp_udr;
    5176                 :          15 :                 if (omp_udr->ts.u.cl->length->ts.type != BT_INTEGER)
    5177                 :           0 :                   return omp_udr;
    5178                 :          15 :                 if (ts->u.cl->length->ts.type != BT_INTEGER)
    5179                 :           0 :                   return omp_udr;
    5180                 :          15 :                 if (gfc_compare_expr (omp_udr->ts.u.cl->length,
    5181                 :             :                                       ts->u.cl->length, INTRINSIC_EQ) != 0)
    5182                 :          15 :                   continue;
    5183                 :             :               }
    5184                 :           2 :             return omp_udr;
    5185                 :             :           }
    5186                 :             :       }
    5187                 :             :   return NULL;
    5188                 :             : }
    5189                 :             : 
    5190                 :             : match
    5191                 :         532 : gfc_match_omp_declare_reduction (void)
    5192                 :             : {
    5193                 :         532 :   match m;
    5194                 :         532 :   gfc_intrinsic_op op;
    5195                 :         532 :   char name[GFC_MAX_SYMBOL_LEN + 3];
    5196                 :         532 :   auto_vec<gfc_typespec, 5> tss;
    5197                 :         532 :   gfc_typespec ts;
    5198                 :         532 :   unsigned int i;
    5199                 :         532 :   gfc_symtree *st;
    5200                 :         532 :   locus where = gfc_current_locus;
    5201                 :         532 :   locus end_loc = gfc_current_locus;
    5202                 :         532 :   bool end_loc_set = false;
    5203                 :         532 :   gfc_omp_reduction_op rop = OMP_REDUCTION_NONE;
    5204                 :             : 
    5205                 :         532 :   if (gfc_match_char ('(') != MATCH_YES)
    5206                 :             :     return MATCH_ERROR;
    5207                 :             : 
    5208                 :         530 :   m = gfc_match (" %o : ", &op);
    5209                 :         530 :   if (m == MATCH_ERROR)
    5210                 :             :     return MATCH_ERROR;
    5211                 :         530 :   if (m == MATCH_YES)
    5212                 :             :     {
    5213                 :         117 :       snprintf (name, sizeof name, "operator %s", gfc_op2string (op));
    5214                 :         117 :       rop = (gfc_omp_reduction_op) op;
    5215                 :             :     }
    5216                 :             :   else
    5217                 :             :     {
    5218                 :         413 :       m = gfc_match_defined_op_name (name + 1, 1);
    5219                 :         413 :       if (m == MATCH_ERROR)
    5220                 :             :         return MATCH_ERROR;
    5221                 :         413 :       if (m == MATCH_YES)
    5222                 :             :         {
    5223                 :          41 :           name[0] = '.';
    5224                 :          41 :           strcat (name, ".");
    5225                 :          41 :           if (gfc_match (" : ") != MATCH_YES)
    5226                 :             :             return MATCH_ERROR;
    5227                 :             :         }
    5228                 :             :       else
    5229                 :             :         {
    5230                 :         372 :           if (gfc_match (" %n : ", name) != MATCH_YES)
    5231                 :             :             return MATCH_ERROR;
    5232                 :             :         }
    5233                 :             :       rop = OMP_REDUCTION_USER;
    5234                 :             :     }
    5235                 :             : 
    5236                 :         529 :   m = gfc_match_type_spec (&ts);
    5237                 :         529 :   if (m != MATCH_YES)
    5238                 :             :     return MATCH_ERROR;
    5239                 :             :   /* Treat len=: the same as len=*.  */
    5240                 :         528 :   if (ts.type == BT_CHARACTER)
    5241                 :          61 :     ts.deferred = false;
    5242                 :         528 :   tss.safe_push (ts);
    5243                 :             : 
    5244                 :        1093 :   while (gfc_match_char (',') == MATCH_YES)
    5245                 :             :     {
    5246                 :          37 :       m = gfc_match_type_spec (&ts);
    5247                 :          37 :       if (m != MATCH_YES)
    5248                 :             :         return MATCH_ERROR;
    5249                 :          37 :       tss.safe_push (ts);
    5250                 :             :     }
    5251                 :         528 :   if (gfc_match_char (':') != MATCH_YES)
    5252                 :             :     return MATCH_ERROR;
    5253                 :             : 
    5254                 :         527 :   st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name);
    5255                 :        2168 :   for (i = 0; i < tss.length (); i++)
    5256                 :             :     {
    5257                 :         564 :       gfc_symtree *omp_out, *omp_in;
    5258                 :         564 :       gfc_symtree *omp_priv = NULL, *omp_orig = NULL;
    5259                 :         564 :       gfc_namespace *combiner_ns, *initializer_ns = NULL;
    5260                 :         564 :       gfc_omp_udr *prev_udr, *omp_udr;
    5261                 :         564 :       const char *predef_name = NULL;
    5262                 :             : 
    5263                 :         564 :       omp_udr = gfc_get_omp_udr ();
    5264                 :         564 :       omp_udr->name = gfc_get_string ("%s", name);
    5265                 :         564 :       omp_udr->rop = rop;
    5266                 :         564 :       omp_udr->ts = tss[i];
    5267                 :         564 :       omp_udr->where = where;
    5268                 :             : 
    5269                 :         564 :       gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1);
    5270                 :         564 :       combiner_ns->proc_name = combiner_ns->parent->proc_name;
    5271                 :             : 
    5272                 :         564 :       gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false);
    5273                 :         564 :       gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false);
    5274                 :         564 :       combiner_ns->omp_udr_ns = 1;
    5275                 :         564 :       omp_out->n.sym->ts = tss[i];
    5276                 :         564 :       omp_in->n.sym->ts = tss[i];
    5277                 :         564 :       omp_out->n.sym->attr.omp_udr_artificial_var = 1;
    5278                 :         564 :       omp_in->n.sym->attr.omp_udr_artificial_var = 1;
    5279                 :         564 :       omp_out->n.sym->attr.flavor = FL_VARIABLE;
    5280                 :         564 :       omp_in->n.sym->attr.flavor = FL_VARIABLE;
    5281                 :         564 :       gfc_commit_symbols ();
    5282                 :         564 :       omp_udr->combiner_ns = combiner_ns;
    5283                 :         564 :       omp_udr->omp_out = omp_out->n.sym;
    5284                 :         564 :       omp_udr->omp_in = omp_in->n.sym;
    5285                 :             : 
    5286                 :         564 :       locus old_loc = gfc_current_locus;
    5287                 :             : 
    5288                 :         564 :       if (!match_udr_expr (omp_out, omp_in))
    5289                 :             :         {
    5290                 :           4 :          syntax:
    5291                 :           7 :           gfc_current_locus = old_loc;
    5292                 :           7 :           gfc_current_ns = combiner_ns->parent;
    5293                 :           7 :           gfc_undo_symbols ();
    5294                 :           7 :           gfc_free_omp_udr (omp_udr);
    5295                 :           7 :           return MATCH_ERROR;
    5296                 :             :         }
    5297                 :             : 
    5298                 :         560 :       if (gfc_match (" initializer ( ") == MATCH_YES)
    5299                 :             :         {
    5300                 :         313 :           gfc_current_ns = combiner_ns->parent;
    5301                 :         313 :           initializer_ns = gfc_get_namespace (gfc_current_ns, 1);
    5302                 :         313 :           gfc_current_ns = initializer_ns;
    5303                 :         313 :           initializer_ns->proc_name = initializer_ns->parent->proc_name;
    5304                 :             : 
    5305                 :         313 :           gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false);
    5306                 :         313 :           gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false);
    5307                 :         313 :           initializer_ns->omp_udr_ns = 1;
    5308                 :         313 :           omp_priv->n.sym->ts = tss[i];
    5309                 :         313 :           omp_orig->n.sym->ts = tss[i];
    5310                 :         313 :           omp_priv->n.sym->attr.omp_udr_artificial_var = 1;
    5311                 :         313 :           omp_orig->n.sym->attr.omp_udr_artificial_var = 1;
    5312                 :         313 :           omp_priv->n.sym->attr.flavor = FL_VARIABLE;
    5313                 :         313 :           omp_orig->n.sym->attr.flavor = FL_VARIABLE;
    5314                 :         313 :           gfc_commit_symbols ();
    5315                 :         313 :           omp_udr->initializer_ns = initializer_ns;
    5316                 :         313 :           omp_udr->omp_priv = omp_priv->n.sym;
    5317                 :         313 :           omp_udr->omp_orig = omp_orig->n.sym;
    5318                 :             : 
    5319                 :         313 :           if (!match_udr_expr (omp_priv, omp_orig))
    5320                 :           3 :             goto syntax;
    5321                 :             :         }
    5322                 :             : 
    5323                 :         557 :       gfc_current_ns = combiner_ns->parent;
    5324                 :         557 :       if (!end_loc_set)
    5325                 :             :         {
    5326                 :         520 :           end_loc_set = true;
    5327                 :         520 :           end_loc = gfc_current_locus;
    5328                 :             :         }
    5329                 :         557 :       gfc_current_locus = old_loc;
    5330                 :             : 
    5331                 :         557 :       prev_udr = gfc_omp_udr_find (st, &tss[i]);
    5332                 :         557 :       if (gfc_omp_udr_predef (rop, name, &tss[i], &predef_name)
    5333                 :             :           /* Don't error on !$omp declare reduction (min : integer : ...)
    5334                 :             :              just yet, there could be integer :: min afterwards,
    5335                 :             :              making it valid.  When the UDR is resolved, we'll get
    5336                 :             :              to it again.  */
    5337                 :         557 :           && (rop != OMP_REDUCTION_USER || name[0] == '.'))
    5338                 :             :         {
    5339                 :          29 :           if (predef_name)
    5340                 :           0 :             gfc_error_now ("Redefinition of predefined %s "
    5341                 :             :                            "!$OMP DECLARE REDUCTION at %L",
    5342                 :             :                            predef_name, &where);
    5343                 :             :           else
    5344                 :          29 :             gfc_error_now ("Redefinition of predefined "
    5345                 :             :                            "!$OMP DECLARE REDUCTION at %L", &where);
    5346                 :             :         }
    5347                 :         528 :       else if (prev_udr)
    5348                 :             :         {
    5349                 :           6 :           gfc_error_now ("Redefinition of !$OMP DECLARE REDUCTION at %L",
    5350                 :             :                          &where);
    5351                 :           6 :           gfc_error_now ("Previous !$OMP DECLARE REDUCTION at %L",
    5352                 :             :                          &prev_udr->where);
    5353                 :             :         }
    5354                 :         522 :       else if (st)
    5355                 :             :         {
    5356                 :          96 :           omp_udr->next = st->n.omp_udr;
    5357                 :          96 :           st->n.omp_udr = omp_udr;
    5358                 :             :         }
    5359                 :             :       else
    5360                 :             :         {
    5361                 :         426 :           st = gfc_new_symtree (&gfc_current_ns->omp_udr_root, name);
    5362                 :         426 :           st->n.omp_udr = omp_udr;
    5363                 :             :         }
    5364                 :             :     }
    5365                 :             : 
    5366                 :         520 :   if (end_loc_set)
    5367                 :             :     {
    5368                 :         520 :       gfc_current_locus = end_loc;
    5369                 :         520 :       if (gfc_match_omp_eos () != MATCH_YES)
    5370                 :             :         {
    5371                 :           1 :           gfc_error ("Unexpected junk after !$OMP DECLARE REDUCTION at %C");
    5372                 :           1 :           gfc_current_locus = where;
    5373                 :           1 :           return MATCH_ERROR;
    5374                 :             :         }
    5375                 :             : 
    5376                 :             :       return MATCH_YES;
    5377                 :             :     }
    5378                 :           0 :   gfc_clear_error ();
    5379                 :           0 :   return MATCH_ERROR;
    5380                 :         532 : }
    5381                 :             : 
    5382                 :             : 
    5383                 :             : match
    5384                 :         358 : gfc_match_omp_declare_target (void)
    5385                 :             : {
    5386                 :         358 :   locus old_loc;
    5387                 :         358 :   match m;
    5388                 :         358 :   gfc_omp_clauses *c = NULL;
    5389                 :         358 :   int list;
    5390                 :         358 :   gfc_omp_namelist *n;
    5391                 :         358 :   gfc_symbol *s;
    5392                 :             : 
    5393                 :         358 :   old_loc = gfc_current_locus;
    5394                 :             : 
    5395                 :         358 :   if (gfc_current_ns->proc_name
    5396                 :         358 :       && gfc_match_omp_eos () == MATCH_YES)
    5397                 :             :     {
    5398                 :         127 :       if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
    5399                 :         127 :                                        gfc_current_ns->proc_name->name,
    5400                 :             :                                        &old_loc))
    5401                 :           0 :         goto cleanup;
    5402                 :             :       return MATCH_YES;
    5403                 :             :     }
    5404                 :             : 
    5405                 :         231 :   if (gfc_current_ns->proc_name
    5406                 :         231 :       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
    5407                 :             :     {
    5408                 :           2 :       gfc_error ("Only the !$OMP DECLARE TARGET form without "
    5409                 :             :                  "clauses is allowed in interface block at %C");
    5410                 :           2 :       goto cleanup;
    5411                 :             :     }
    5412                 :             : 
    5413                 :         229 :   m = gfc_match (" (");
    5414                 :         229 :   if (m == MATCH_YES)
    5415                 :             :     {
    5416                 :          85 :       c = gfc_get_omp_clauses ();
    5417                 :          85 :       gfc_current_locus = old_loc;
    5418                 :          85 :       m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_ENTER]);
    5419                 :          85 :       if (m != MATCH_YES)
    5420                 :           0 :         goto syntax;
    5421                 :          85 :       if (gfc_match_omp_eos () != MATCH_YES)
    5422                 :             :         {
    5423                 :           0 :           gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C");
    5424                 :           0 :           goto cleanup;
    5425                 :             :         }
    5426                 :             :     }
    5427                 :         144 :   else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES)
    5428                 :             :     return MATCH_ERROR;
    5429                 :             : 
    5430                 :         228 :   gfc_buffer_error (false);
    5431                 :             : 
    5432                 :         228 :   static const int to_enter_link_lists[]
    5433                 :             :     = { OMP_LIST_TO, OMP_LIST_ENTER, OMP_LIST_LINK };
    5434                 :         912 :   for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists)
    5435                 :         912 :                          && (list = to_enter_link_lists[listn], true); ++listn)
    5436                 :        1110 :     for (n = c->lists[list]; n; n = n->next)
    5437                 :         426 :       if (n->sym)
    5438                 :         401 :         n->sym->mark = 0;
    5439                 :          25 :       else if (n->u.common->head)
    5440                 :          25 :         n->u.common->head->mark = 0;
    5441                 :             : 
    5442                 :         684 :   for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists)
    5443                 :         912 :                          && (list = to_enter_link_lists[listn], true); ++listn)
    5444                 :        1110 :     for (n = c->lists[list]; n; n = n->next)
    5445                 :         426 :       if (n->sym)
    5446                 :             :         {
    5447                 :         401 :           if (n->sym->attr.in_common)
    5448                 :           1 :             gfc_error_now ("OMP DECLARE TARGET variable at %L is an "
    5449                 :             :                            "element of a COMMON block", &n->where);
    5450                 :         400 :           else if (n->sym->mark)
    5451                 :           9 :             gfc_error_now ("Variable at %L mentioned multiple times in "
    5452                 :             :                            "clauses of the same OMP DECLARE TARGET directive",
    5453                 :             :                            &n->where);
    5454                 :         391 :           else if (n->sym->attr.omp_declare_target
    5455                 :         391 :                    && n->sym->attr.omp_declare_target_link
    5456                 :           9 :                    && list != OMP_LIST_LINK)
    5457                 :           1 :             gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
    5458                 :             :                            "mentioned in LINK clause and later in %s clause",
    5459                 :             :                            &n->where, list == OMP_LIST_TO ? "TO" : "ENTER");
    5460                 :         390 :           else if (n->sym->attr.omp_declare_target
    5461                 :             :                    && !n->sym->attr.omp_declare_target_link
    5462                 :          14 :                    && list == OMP_LIST_LINK)
    5463                 :           1 :             gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
    5464                 :             :                            "mentioned in TO or ENTER clause and later in "
    5465                 :             :                            "LINK clause", &n->where);
    5466                 :         389 :           else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
    5467                 :             :                                                &n->sym->declared_at))
    5468                 :             :             {
    5469                 :         383 :               if (list == OMP_LIST_LINK)
    5470                 :          20 :                 gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
    5471                 :          20 :                                                  &n->sym->declared_at);
    5472                 :             :             }
    5473                 :         401 :           if (c->device_type != OMP_DEVICE_TYPE_UNSET)
    5474                 :             :             {
    5475                 :          41 :               if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
    5476                 :          17 :                   && n->sym->attr.omp_device_type != c->device_type)
    5477                 :          13 :                 gfc_error_now ("List item %qs at %L set in previous OMP DECLARE "
    5478                 :             :                                "TARGET directive to a different DEVICE_TYPE",
    5479                 :             :                                n->sym->name, &n->where);
    5480                 :          41 :               n->sym->attr.omp_device_type = c->device_type;
    5481                 :             :             }
    5482                 :         401 :           n->sym->mark = 1;
    5483                 :             :         }
    5484                 :          25 :       else if (n->u.common->omp_declare_target
    5485                 :          25 :                && n->u.common->omp_declare_target_link
    5486                 :           6 :                && list != OMP_LIST_LINK)
    5487                 :           2 :         gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
    5488                 :             :                        "mentioned in LINK clause and later in %s clause",
    5489                 :             :                        &n->where, list == OMP_LIST_TO ? "TO" : "ENTER");
    5490                 :          24 :       else if (n->u.common->omp_declare_target
    5491                 :             :                && !n->u.common->omp_declare_target_link
    5492                 :           6 :                && list == OMP_LIST_LINK)
    5493                 :           1 :         gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
    5494                 :             :                        "mentioned in TO or ENTER clause and later in "
    5495                 :             :                        "LINK clause", &n->where);
    5496                 :          23 :       else if (n->u.common->head && n->u.common->head->mark)
    5497                 :           4 :         gfc_error_now ("COMMON at %L mentioned multiple times in "
    5498                 :             :                        "clauses of the same OMP DECLARE TARGET directive",
    5499                 :             :                        &n->where);
    5500                 :             :       else
    5501                 :             :         {
    5502                 :          19 :           n->u.common->omp_declare_target = 1;
    5503                 :          19 :           n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
    5504                 :          19 :           if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET
    5505                 :           0 :               && n->u.common->omp_device_type != c->device_type)
    5506                 :           0 :             gfc_error_now ("COMMON at %L set in previous OMP DECLARE "
    5507                 :             :                            "TARGET directive to a different DEVICE_TYPE",
    5508                 :             :                            &n->where);
    5509                 :          19 :           n->u.common->omp_device_type = c->device_type;
    5510                 :             : 
    5511                 :          59 :           for (s = n->u.common->head; s; s = s->common_next)
    5512                 :             :             {
    5513                 :          40 :               s->mark = 1;
    5514                 :          40 :               if (gfc_add_omp_declare_target (&s->attr, s->name,
    5515                 :             :                                               &s->declared_at))
    5516                 :             :                 {
    5517                 :          40 :                   if (list == OMP_LIST_LINK)
    5518                 :          21 :                     gfc_add_omp_declare_target_link (&s->attr, s->name,
    5519                 :             :                                                      &s->declared_at);
    5520                 :             :                 }
    5521                 :          40 :               if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
    5522                 :           0 :                   && s->attr.omp_device_type != c->device_type)
    5523                 :           0 :                 gfc_error_now ("List item %qs at %L set in previous OMP DECLARE"
    5524                 :             :                                " TARGET directive to a different DEVICE_TYPE",
    5525                 :             :                                s->name, &n->where);
    5526                 :          40 :               s->attr.omp_device_type = c->device_type;
    5527                 :             :             }
    5528                 :             :         }
    5529                 :         228 :   if (c->device_type
    5530                 :          48 :       && !c->lists[OMP_LIST_ENTER]
    5531                 :          47 :       && !c->lists[OMP_LIST_TO]
    5532                 :          18 :       && !c->lists[OMP_LIST_LINK])
    5533                 :           1 :     gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only "
    5534                 :             :                         "DEVICE_TYPE clause is ignored", &old_loc);
    5535                 :             : 
    5536                 :         228 :   gfc_buffer_error (true);
    5537                 :             : 
    5538                 :         228 :   if (c)
    5539                 :         228 :     gfc_free_omp_clauses (c);
    5540                 :         228 :   return MATCH_YES;
    5541                 :             : 
    5542                 :           0 : syntax:
    5543                 :           0 :   gfc_error ("Syntax error in !$OMP DECLARE TARGET list at %C");
    5544                 :             : 
    5545                 :           2 : cleanup:
    5546                 :           2 :   gfc_current_locus = old_loc;
    5547                 :           2 :   if (c)
    5548                 :           0 :     gfc_free_omp_clauses (c);
    5549                 :             :   return MATCH_ERROR;
    5550                 :             : }
    5551                 :             : 
    5552                 :             : 
    5553                 :             : static const char *const omp_construct_selectors[] = {
    5554                 :             :   "simd", "target", "teams", "parallel", "do", NULL };
    5555                 :             : static const char *const omp_device_selectors[] = {
    5556                 :             :   "kind", "isa", "arch", NULL };
    5557                 :             : static const char *const omp_implementation_selectors[] = {
    5558                 :             :   "vendor", "extension", "atomic_default_mem_order", "unified_address",
    5559                 :             :   "unified_shared_memory", "dynamic_allocators", "reverse_offload", NULL };
    5560                 :             : static const char *const omp_user_selectors[] = {
    5561                 :             :   "condition", NULL };
    5562                 :             : 
    5563                 :             : 
    5564                 :             : /* OpenMP 5.0:
    5565                 :             : 
    5566                 :             :    trait-selector:
    5567                 :             :      trait-selector-name[([trait-score:]trait-property[,trait-property[,...]])]
    5568                 :             : 
    5569                 :             :    trait-score:
    5570                 :             :      score(score-expression)  */
    5571                 :             : 
    5572                 :             : match
    5573                 :         330 : gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
    5574                 :             : {
    5575                 :         524 :   do
    5576                 :             :     {
    5577                 :         427 :       char selector[GFC_MAX_SYMBOL_LEN + 1];
    5578                 :             : 
    5579                 :         427 :       if (gfc_match_name (selector) != MATCH_YES)
    5580                 :             :         {
    5581                 :           2 :           gfc_error ("expected trait selector name at %C");
    5582                 :          45 :           return MATCH_ERROR;
    5583                 :             :         }
    5584                 :             : 
    5585                 :         425 :       gfc_omp_selector *os = gfc_get_omp_selector ();
    5586                 :         425 :       os->trait_selector_name = XNEWVEC (char, strlen (selector) + 1);
    5587                 :         425 :       strcpy (os->trait_selector_name, selector);
    5588                 :         425 :       os->next = oss->trait_selectors;
    5589                 :         425 :       oss->trait_selectors = os;
    5590                 :             : 
    5591                 :         425 :       const char *const *selectors = NULL;
    5592                 :         425 :       bool allow_score = true;
    5593                 :         425 :       bool allow_user = false;
    5594                 :         425 :       int property_limit = 0;
    5595                 :         425 :       enum gfc_omp_trait_property_kind property_kind = CTX_PROPERTY_NONE;
    5596                 :         425 :       switch (oss->trait_set_selector_name[0])
    5597                 :             :         {
    5598                 :             :         case 'c': /* construct */
    5599                 :             :           selectors = omp_construct_selectors;
    5600                 :             :           allow_score = false;
    5601                 :             :           property_limit = 1;
    5602                 :             :           property_kind = CTX_PROPERTY_SIMD;
    5603                 :             :           break;
    5604                 :          98 :         case 'd': /* device */
    5605                 :          98 :           selectors = omp_device_selectors;
    5606                 :          98 :           allow_score = false;
    5607                 :          98 :           allow_user = true;
    5608                 :          98 :           property_limit = 3;
    5609                 :          98 :           property_kind = CTX_PROPERTY_NAME_LIST;
    5610                 :          98 :           break;
    5611                 :         100 :         case 'i': /* implementation */
    5612                 :         100 :           selectors = omp_implementation_selectors;
    5613                 :         100 :           allow_user = true;
    5614                 :         100 :           property_limit = 3;
    5615                 :         100 :           property_kind = CTX_PROPERTY_NAME_LIST;
    5616                 :         100 :           break;
    5617                 :          41 :         case 'u': /* user */
    5618                 :          41 :           selectors = omp_user_selectors;
    5619                 :          41 :           property_limit = 1;
    5620                 :          41 :           property_kind = CTX_PROPERTY_EXPR;
    5621                 :          41 :           break;
    5622                 :           0 :         default:
    5623                 :           0 :           gcc_unreachable ();
    5624                 :             :         }
    5625                 :        1166 :       for (int i = 0; ; i++)
    5626                 :             :         {
    5627                 :        1166 :           if (selectors[i] == NULL)
    5628                 :             :             {
    5629                 :          18 :               if (allow_user)
    5630                 :             :                 {
    5631                 :             :                   property_kind = CTX_PROPERTY_USER;
    5632                 :             :                   break;
    5633                 :             :                 }
    5634                 :             :               else
    5635                 :             :                 {
    5636                 :          15 :                   gfc_error ("selector %qs not allowed for context selector "
    5637                 :             :                              "set %qs at %C",
    5638                 :             :                              selector, oss->trait_set_selector_name);
    5639                 :          15 :                   return MATCH_ERROR;
    5640                 :             :                 }
    5641                 :             :             }
    5642                 :        1148 :           if (i == property_limit)
    5643                 :         187 :             property_kind = CTX_PROPERTY_NONE;
    5644                 :        1148 :           if (strcmp (selectors[i], selector) == 0)
    5645                 :             :             break;
    5646                 :             :         }
    5647                 :         407 :       if (property_kind == CTX_PROPERTY_NAME_LIST
    5648                 :         180 :           && oss->trait_set_selector_name[0] == 'i'
    5649                 :          83 :           && strcmp (selector, "atomic_default_mem_order") == 0)
    5650                 :         410 :         property_kind = CTX_PROPERTY_ID;
    5651                 :             : 
    5652                 :         410 :       if (gfc_match (" (") == MATCH_YES)
    5653                 :             :         {
    5654                 :         236 :           if (property_kind == CTX_PROPERTY_NONE)
    5655                 :             :             {
    5656                 :           6 :               gfc_error ("selector %qs does not accept any properties at %C",
    5657                 :             :                          selector);
    5658                 :           6 :               return MATCH_ERROR;
    5659                 :             :             }
    5660                 :             : 
    5661                 :         230 :           if (allow_score && gfc_match (" score") == MATCH_YES)
    5662                 :             :             {
    5663                 :          52 :               if (gfc_match (" (") != MATCH_YES)
    5664                 :             :                 {
    5665                 :           0 :                   gfc_error ("expected %<(%> at %C");
    5666                 :           0 :                   return MATCH_ERROR;
    5667                 :             :                 }
    5668                 :          52 :               if (gfc_match_expr (&os->score) != MATCH_YES
    5669                 :          51 :                   || !gfc_resolve_expr (os->score)
    5670                 :          51 :                   || os->score->ts.type != BT_INTEGER
    5671                 :         103 :                   || os->score->rank != 0)
    5672                 :             :                 {
    5673                 :           1 :                   gfc_error ("score argument must be constant integer "
    5674                 :             :                              "expression at %C");
    5675                 :           1 :                   return MATCH_ERROR;
    5676                 :             :                 }
    5677                 :             : 
    5678                 :          51 :               if (os->score->expr_type == EXPR_CONSTANT
    5679                 :          51 :                   && mpz_sgn (os->score->value.integer) < 0)
    5680                 :             :                 {
    5681                 :           1 :                   gfc_error ("score argument must be non-negative at %C");
    5682                 :           1 :                   return MATCH_ERROR;
    5683                 :             :                 }
    5684                 :             : 
    5685                 :          50 :               if (gfc_match (" )") != MATCH_YES)
    5686                 :             :                 {
    5687                 :           0 :                   gfc_error ("expected %<)%> at %C");
    5688                 :           0 :                   return MATCH_ERROR;
    5689                 :             :                 }
    5690                 :             : 
    5691                 :          50 :               if (gfc_match (" :") != MATCH_YES)
    5692                 :             :                 {
    5693                 :           0 :                   gfc_error ("expected : at %C");
    5694                 :           0 :                   return MATCH_ERROR;
    5695                 :             :                 }
    5696                 :             :             }
    5697                 :             : 
    5698                 :         228 :           gfc_omp_trait_property *otp = gfc_get_omp_trait_property ();
    5699                 :         228 :           otp->property_kind = property_kind;
    5700                 :         228 :           otp->next = os->properties;
    5701                 :         228 :           os->properties = otp;
    5702                 :             : 
    5703                 :         228 :           switch (property_kind)
    5704                 :             :             {
    5705                 :           5 :             case CTX_PROPERTY_USER:
    5706                 :           5 :               do
    5707                 :             :                 {
    5708                 :           5 :                   if (gfc_match_expr (&otp->expr) != MATCH_YES)
    5709                 :             :                     {
    5710                 :           0 :                       gfc_error ("property must be constant integer "
    5711                 :             :                                  "expression or string literal at %C");
    5712                 :           0 :                       return MATCH_ERROR;
    5713                 :             :                     }
    5714                 :             : 
    5715                 :           5 :                   if (gfc_match (" ,") != MATCH_YES)
    5716                 :             :                     break;
    5717                 :             :                 }
    5718                 :             :               while (1);
    5719                 :             :               break;
    5720                 :          25 :             case CTX_PROPERTY_ID:
    5721                 :          25 :               {
    5722                 :          25 :                 char buf[GFC_MAX_SYMBOL_LEN + 1];
    5723                 :          25 :                 if (gfc_match_name (buf) == MATCH_YES)
    5724                 :             :                   {
    5725                 :          24 :                     otp->name = XNEWVEC (char, strlen (buf) + 1);
    5726                 :          24 :                     strcpy (otp->name, buf);
    5727                 :             :                   }
    5728                 :             :                 else
    5729                 :             :                   {
    5730                 :           1 :                     gfc_error ("expected identifier at %C");
    5731                 :           1 :                     return MATCH_ERROR;
    5732                 :             :                   }
    5733                 :             :               }
    5734                 :          24 :               break;
    5735                 :         194 :             case CTX_PROPERTY_NAME_LIST:
    5736                 :         240 :               do
    5737                 :             :                 {
    5738                 :         194 :                   char buf[GFC_MAX_SYMBOL_LEN + 1];
    5739                 :         194 :                   if (gfc_match_name (buf) == MATCH_YES)
    5740                 :             :                     {
    5741                 :         147 :                       otp->name = XNEWVEC (char, strlen (buf) + 1);
    5742                 :         147 :                       strcpy (otp->name, buf);
    5743                 :         147 :                       otp->is_name = true;
    5744                 :             :                     }
    5745                 :          47 :                   else if (gfc_match_literal_constant (&otp->expr, 0)
    5746                 :             :                            != MATCH_YES
    5747                 :          47 :                            || otp->expr->ts.type != BT_CHARACTER)
    5748                 :             :                     {
    5749                 :           5 :                       gfc_error ("expected identifier or string literal "
    5750                 :             :                                  "at %C");
    5751                 :           5 :                       return MATCH_ERROR;
    5752                 :             :                     }
    5753                 :             : 
    5754                 :         189 :                   if (gfc_match (" ,") == MATCH_YES)
    5755                 :             :                     {
    5756                 :          46 :                       otp = gfc_get_omp_trait_property ();
    5757                 :          46 :                       otp->property_kind = property_kind;
    5758                 :          46 :                       otp->next = os->properties;
    5759                 :          46 :                       os->properties = otp;
    5760                 :             :                     }
    5761                 :             :                   else
    5762                 :             :                     break;
    5763                 :          46 :                 }
    5764                 :             :               while (1);
    5765                 :         143 :               break;
    5766                 :          37 :             case CTX_PROPERTY_EXPR:
    5767                 :          37 :               if (gfc_match_expr (&otp->expr) != MATCH_YES)
    5768                 :             :                 {
    5769                 :           3 :                   gfc_error ("expected expression at %C");
    5770                 :           3 :                   return MATCH_ERROR;
    5771                 :             :                 }
    5772                 :          34 :               if (!gfc_resolve_expr (otp->expr)
    5773                 :          34 :                   || (otp->expr->ts.type != BT_LOGICAL
    5774                 :          34 :                       && otp->expr->ts.type != BT_INTEGER)
    5775                 :          68 :                   || otp->expr->rank != 0)
    5776                 :             :                 {
    5777                 :           0 :                   gfc_error ("property must be constant integer or logical "
    5778                 :             :                              "expression at %C");
    5779                 :           0 :                   return MATCH_ERROR;
    5780                 :             :                 }
    5781                 :             :               break;
    5782                 :          15 :             case CTX_PROPERTY_SIMD:
    5783                 :          15 :               {
    5784                 :          15 :                 if (gfc_match_omp_clauses (&otp->clauses,
    5785                 :          15 :                                            OMP_DECLARE_SIMD_CLAUSES,
    5786                 :             :                                            true, false, false, true)
    5787                 :             :                     != MATCH_YES)
    5788                 :             :                   {
    5789                 :           1 :                   gfc_error ("expected simd clause at %C");
    5790                 :           1 :                     return MATCH_ERROR;
    5791                 :             :                   }
    5792                 :             :                 break;
    5793                 :             :               }
    5794                 :           0 :             default:
    5795                 :           0 :               gcc_unreachable ();
    5796                 :             :             }
    5797                 :             : 
    5798                 :         218 :           if (gfc_match (" )") != MATCH_YES)
    5799                 :             :             {
    5800                 :           2 :               gfc_error ("expected %<)%> at %C");
    5801                 :           2 :               return MATCH_ERROR;
    5802                 :             :             }
    5803                 :             :         }
    5804                 :         174 :       else if (property_kind == CTX_PROPERTY_NAME_LIST
    5805                 :             :                || property_kind == CTX_PROPERTY_ID
    5806                 :         174 :                || property_kind == CTX_PROPERTY_EXPR)
    5807                 :             :         {
    5808                 :           8 :           if (gfc_match (" (") != MATCH_YES)
    5809                 :             :             {
    5810                 :           8 :               gfc_error ("expected %<(%> at %C");
    5811                 :           8 :               return MATCH_ERROR;
    5812                 :             :             }
    5813                 :             :         }
    5814                 :             : 
    5815                 :         382 :       if (gfc_match (" ,") != MATCH_YES)
    5816                 :             :         break;
    5817                 :          97 :     }
    5818                 :             :   while (1);
    5819                 :             : 
    5820                 :         285 :   return MATCH_YES;
    5821                 :             : }
    5822                 :             : 
    5823                 :             : /* OpenMP 5.0:
    5824                 :             : 
    5825                 :             :    trait-set-selector[,trait-set-selector[,...]]
    5826                 :             : 
    5827                 :             :    trait-set-selector:
    5828                 :             :      trait-set-selector-name = { trait-selector[, trait-selector[, ...]] }
    5829                 :             : 
    5830                 :             :    trait-set-selector-name:
    5831                 :             :      constructor
    5832                 :             :      device
    5833                 :             :      implementation
    5834                 :             :      user  */
    5835                 :             : 
    5836                 :             : match
    5837                 :         289 : gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
    5838                 :             : {
    5839                 :         387 :   do
    5840                 :             :     {
    5841                 :         338 :       match m;
    5842                 :         338 :       const char *selector_sets[] = { "construct", "device",
    5843                 :             :                                       "implementation", "user" };
    5844                 :         338 :       const int selector_set_count = ARRAY_SIZE (selector_sets);
    5845                 :         338 :       int i;
    5846                 :         338 :       char buf[GFC_MAX_SYMBOL_LEN + 1];
    5847                 :             : 
    5848                 :         338 :       m = gfc_match_name (buf);
    5849                 :         338 :       if (m == MATCH_YES)
    5850                 :         748 :         for (i = 0; i < selector_set_count; i++)
    5851                 :         745 :           if (strcmp (buf, selector_sets[i]) == 0)
    5852                 :             :             break;
    5853                 :             : 
    5854                 :         338 :       if (m != MATCH_YES || i == selector_set_count)
    5855                 :             :         {
    5856                 :           5 :           gfc_error ("expected %<construct%>, %<device%>, %<implementation%> "
    5857                 :             :                      "or %<user%> at %C");
    5858                 :          53 :           return MATCH_ERROR;
    5859                 :             :         }
    5860                 :             : 
    5861                 :         333 :       m = gfc_match (" =");
    5862                 :         333 :       if (m != MATCH_YES)
    5863                 :             :         {
    5864                 :           1 :           gfc_error ("expected %<=%> at %C");
    5865                 :           1 :           return MATCH_ERROR;
    5866                 :             :         }
    5867                 :             : 
    5868                 :         332 :       m = gfc_match (" {");
    5869                 :         332 :       if (m != MATCH_YES)
    5870                 :             :         {
    5871                 :           2 :           gfc_error ("expected %<{%> at %C");
    5872                 :           2 :           return MATCH_ERROR;
    5873                 :             :         }
    5874                 :             : 
    5875                 :         330 :       gfc_omp_set_selector *oss = gfc_get_omp_set_selector ();
    5876                 :         330 :       oss->next = odv->set_selectors;
    5877                 :         330 :       oss->trait_set_selector_name = selector_sets[i];
    5878                 :         330 :       odv->set_selectors = oss;
    5879                 :             : 
    5880                 :         330 :       if (gfc_match_omp_context_selector (oss) != MATCH_YES)
    5881                 :             :         return MATCH_ERROR;
    5882                 :             : 
    5883                 :         285 :       m = gfc_match (" }");
    5884                 :         285 :       if (m != MATCH_YES)
    5885                 :             :         {
    5886                 :           0 :           gfc_error ("expected %<}%> at %C");
    5887                 :           0 :           return MATCH_ERROR;
    5888                 :             :         }
    5889                 :             : 
    5890                 :         285 :       m = gfc_match (" ,");
    5891                 :         285 :       if (m != MATCH_YES)
    5892                 :             :         break;
    5893                 :          49 :     }
    5894                 :             :   while (1);
    5895                 :             : 
    5896                 :         236 :   return MATCH_YES;
    5897                 :             : }
    5898                 :             : 
    5899                 :             : 
    5900                 :             : match
    5901                 :         297 : gfc_match_omp_declare_variant (void)
    5902                 :             : {
    5903                 :         297 :   bool first_p = true;
    5904                 :         297 :   char buf[GFC_MAX_SYMBOL_LEN + 1];
    5905                 :             : 
    5906                 :         297 :   if (gfc_match (" (") != MATCH_YES)
    5907                 :             :     {
    5908                 :           2 :       gfc_error ("expected %<(%> at %C");
    5909                 :           2 :       return MATCH_ERROR;
    5910                 :             :     }
    5911                 :             : 
    5912                 :         295 :   gfc_symtree *base_proc_st, *variant_proc_st;
    5913                 :         295 :   if (gfc_match_name (buf) != MATCH_YES)
    5914                 :             :     {
    5915                 :           2 :       gfc_error ("expected name at %C");
    5916                 :           2 :       return MATCH_ERROR;
    5917                 :             :     }
    5918                 :             : 
    5919                 :         293 :   if (gfc_get_ha_sym_tree (buf, &base_proc_st))
    5920                 :             :     return MATCH_ERROR;
    5921                 :             : 
    5922                 :         293 :   if (gfc_match (" :") == MATCH_YES)
    5923                 :             :     {
    5924                 :          10 :       if (gfc_match_name (buf) != MATCH_YES)
    5925                 :             :         {
    5926                 :           0 :           gfc_error ("expected variant name at %C");
    5927                 :           0 :           return MATCH_ERROR;
    5928                 :             :         }
    5929                 :             : 
    5930                 :          10 :       if (gfc_get_ha_sym_tree (buf, &variant_proc_st))
    5931                 :             :         return MATCH_ERROR;
    5932                 :             :     }
    5933                 :             :   else
    5934                 :             :     {
    5935                 :             :       /* Base procedure not specified.  */
    5936                 :         283 :       variant_proc_st = base_proc_st;
    5937                 :         283 :       base_proc_st = NULL;
    5938                 :             :     }
    5939                 :             : 
    5940                 :         293 :   gfc_omp_declare_variant *odv;
    5941                 :         293 :   odv = gfc_get_omp_declare_variant ();
    5942                 :         293 :   odv->where = gfc_current_locus;
    5943                 :         293 :   odv->variant_proc_symtree = variant_proc_st;
    5944                 :         293 :   odv->base_proc_symtree = base_proc_st;
    5945                 :         293 :   odv->next = NULL;
    5946                 :         293 :   odv->error_p = false;
    5947                 :             : 
    5948                 :             :   /* Add the new declare variant to the end of the list.  */
    5949                 :         293 :   gfc_omp_declare_variant **prev_next = &gfc_current_ns->omp_declare_variant;
    5950                 :         372 :   while (*prev_next)
    5951                 :          79 :     prev_next = &((*prev_next)->next);
    5952                 :         293 :   *prev_next = odv;
    5953                 :             : 
    5954                 :         293 :   if (gfc_match (" )") != MATCH_YES)
    5955                 :             :     {
    5956                 :           0 :       gfc_error ("expected %<)%> at %C");
    5957                 :           0 :       return MATCH_ERROR;
    5958                 :             :     }
    5959                 :             : 
    5960                 :         529 :   for (;;)
    5961                 :             :     {
    5962                 :         529 :       if (gfc_match (" match") != MATCH_YES)
    5963                 :             :         {
    5964                 :         239 :           if (first_p)
    5965                 :             :             {
    5966                 :           3 :               gfc_error ("expected %<match%> at %C");
    5967                 :           3 :               return MATCH_ERROR;
    5968                 :             :             }
    5969                 :             :           else
    5970                 :             :             break;
    5971                 :             :         }
    5972                 :             : 
    5973                 :         290 :       if (gfc_match (" (") != MATCH_YES)
    5974                 :             :         {
    5975                 :           1 :           gfc_error ("expected %<(%> at %C");
    5976                 :           1 :           return MATCH_ERROR;
    5977                 :             :         }
    5978                 :             : 
    5979                 :         289 :       if (gfc_match_omp_context_selector_specification (odv) != MATCH_YES)
    5980                 :             :         return MATCH_ERROR;
    5981                 :             : 
    5982                 :         236 :       if (gfc_match (" )") != MATCH_YES)
    5983                 :             :         {
    5984                 :           0 :           gfc_error ("expected %<)%> at %C");
    5985                 :           0 :           return MATCH_ERROR;
    5986                 :             :         }
    5987                 :             : 
    5988                 :             :       first_p = false;
    5989                 :             :     }
    5990                 :             : 
    5991                 :             :   return MATCH_YES;
    5992                 :             : }
    5993                 :             : 
    5994                 :             : 
    5995                 :             : match
    5996                 :         203 : gfc_match_omp_threadprivate (void)
    5997                 :             : {
    5998                 :         203 :   locus old_loc;
    5999                 :         203 :   char n[GFC_MAX_SYMBOL_LEN+1];
    6000                 :         203 :   gfc_symbol *sym;
    6001                 :         203 :   match m;
    6002                 :         203 :   gfc_symtree *st;
    6003                 :             : 
    6004                 :         203 :   old_loc = gfc_current_locus;
    6005                 :             : 
    6006                 :         203 :   m = gfc_match (" (");
    6007                 :         203 :   if (m != MATCH_YES)
    6008                 :             :     return m;
    6009                 :             : 
    6010                 :         245 :   for (;;)
    6011                 :             :     {
    6012                 :         245 :       m = gfc_match_symbol (&sym, 0);
    6013                 :         245 :       switch (m)
    6014                 :             :         {
    6015                 :         174 :         case MATCH_YES:
    6016                 :         174 :           if (sym->attr.in_common)
    6017                 :           0 :             gfc_error_now ("Threadprivate variable at %C is an element of "
    6018                 :             :                            "a COMMON block");
    6019                 :         174 :           else if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
    6020                 :           1 :             goto cleanup;
    6021                 :         173 :           goto next_item;
    6022                 :             :         case MATCH_NO:
    6023                 :             :           break;
    6024                 :           0 :         case MATCH_ERROR:
    6025                 :           0 :           goto cleanup;
    6026                 :             :         }
    6027                 :             : 
    6028                 :          71 :       m = gfc_match (" / %n /", n);
    6029                 :          71 :       if (m == MATCH_ERROR)
    6030                 :           0 :         goto cleanup;
    6031                 :          71 :       if (m == MATCH_NO || n[0] == '\0')
    6032                 :           0 :         goto syntax;
    6033                 :             : 
    6034                 :          71 :       st = gfc_find_symtree (gfc_current_ns->common_root, n);
    6035                 :          71 :       if (st == NULL)
    6036                 :             :         {
    6037                 :           2 :           gfc_error ("COMMON block /%s/ not found at %C", n);
    6038                 :           2 :           goto cleanup;
    6039                 :             :         }
    6040                 :          69 :       st->n.common->threadprivate = 1;
    6041                 :         176 :       for (sym = st->n.common->head; sym; sym = sym->common_next)
    6042                 :         107 :         if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
    6043                 :           0 :           goto cleanup;
    6044                 :             : 
    6045                 :          69 :     next_item:
    6046                 :         242 :       if (gfc_match_char (')') == MATCH_YES)
    6047                 :             :         break;
    6048                 :          42 :       if (gfc_match_char (',') != MATCH_YES)
    6049                 :           0 :         goto syntax;
    6050                 :             :     }
    6051                 :             : 
    6052                 :         200 :   if (gfc_match_omp_eos () != MATCH_YES)
    6053                 :             :     {
    6054                 :           0 :       gfc_error ("Unexpected junk after OMP THREADPRIVATE at %C");
    6055                 :           0 :       goto cleanup;
    6056                 :             :     }
    6057                 :             : 
    6058                 :             :   return MATCH_YES;
    6059                 :             : 
    6060                 :           0 : syntax:
    6061                 :           0 :   gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C");
    6062                 :             : 
    6063                 :           3 : cleanup:
    6064                 :           3 :   gfc_current_locus = old_loc;
    6065                 :           3 :   return MATCH_ERROR;
    6066                 :             : }
    6067                 :             : 
    6068                 :             : 
    6069                 :             : match
    6070                 :        2049 : gfc_match_omp_parallel (void)
    6071                 :             : {
    6072                 :        2049 :   return match_omp (EXEC_OMP_PARALLEL, OMP_PARALLEL_CLAUSES);
    6073                 :             : }
    6074                 :             : 
    6075                 :             : 
    6076                 :             : match
    6077                 :         903 : gfc_match_omp_parallel_do (void)
    6078                 :             : {
    6079                 :         903 :   return match_omp (EXEC_OMP_PARALLEL_DO,
    6080                 :         903 :                     (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
    6081                 :         903 :                     & ~(omp_mask (OMP_CLAUSE_NOWAIT)));
    6082                 :             : }
    6083                 :             : 
    6084                 :             : 
    6085                 :             : match
    6086                 :         290 : gfc_match_omp_parallel_do_simd (void)
    6087                 :             : {
    6088                 :         290 :   return match_omp (EXEC_OMP_PARALLEL_DO_SIMD,
    6089                 :         290 :                     (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
    6090                 :         290 :                     & ~(omp_mask (OMP_CLAUSE_NOWAIT)));
    6091                 :             : }
    6092                 :             : 
    6093                 :             : 
    6094                 :             : match
    6095                 :          14 : gfc_match_omp_parallel_masked (void)
    6096                 :             : {
    6097                 :          14 :   return match_omp (EXEC_OMP_PARALLEL_MASKED,
    6098                 :          14 :                     OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES);
    6099                 :             : }
    6100                 :             : 
    6101                 :             : match
    6102                 :          10 : gfc_match_omp_parallel_masked_taskloop (void)
    6103                 :             : {
    6104                 :          10 :   return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP,
    6105                 :          10 :                     (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES
    6106                 :          10 :                      | OMP_TASKLOOP_CLAUSES)
    6107                 :          10 :                     & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
    6108                 :             : }
    6109                 :             : 
    6110                 :             : match
    6111                 :          13 : gfc_match_omp_parallel_masked_taskloop_simd (void)
    6112                 :             : {
    6113                 :          13 :   return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
    6114                 :          13 :                     (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES
    6115                 :          13 :                      | OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES)
    6116                 :          13 :                     & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
    6117                 :             : }
    6118                 :             : 
    6119                 :             : match
    6120                 :          14 : gfc_match_omp_parallel_master (void)
    6121                 :             : {
    6122                 :          14 :   return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES);
    6123                 :             : }
    6124                 :             : 
    6125                 :             : match
    6126                 :          15 : gfc_match_omp_parallel_master_taskloop (void)
    6127                 :             : {
    6128                 :          15 :   return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
    6129                 :          15 :                     (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES)
    6130                 :          15 :                     & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
    6131                 :             : }
    6132                 :             : 
    6133                 :             : match
    6134                 :          20 : gfc_match_omp_parallel_master_taskloop_simd (void)
    6135                 :             : {
    6136                 :          20 :   return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD,
    6137                 :          20 :                     (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES
    6138                 :          20 :                      | OMP_SIMD_CLAUSES)
    6139                 :          20 :                     & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
    6140                 :             : }
    6141                 :             : 
    6142                 :             : match
    6143                 :          59 : gfc_match_omp_parallel_sections (void)
    6144                 :             : {
    6145                 :          59 :   return match_omp (EXEC_OMP_PARALLEL_SECTIONS,
    6146                 :          59 :                     (OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES)
    6147                 :          59 :                     & ~(omp_mask (OMP_CLAUSE_NOWAIT)));
    6148                 :             : }
    6149                 :             : 
    6150                 :             : 
    6151                 :             : match
    6152                 :          56 : gfc_match_omp_parallel_workshare (void)
    6153                 :             : {
    6154                 :          56 :   return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
    6155                 :             : }
    6156                 :             : 
    6157                 :             : void
    6158                 :       45070 : gfc_check_omp_requires (gfc_namespace *ns, int ref_omp_requires)
    6159                 :             : {
    6160                 :       45070 :   if (ns->omp_target_seen
    6161                 :         843 :       && (ns->omp_requires & OMP_REQ_TARGET_MASK)
    6162                 :         843 :          != (ref_omp_requires & OMP_REQ_TARGET_MASK))
    6163                 :             :     {
    6164                 :           3 :       gcc_assert (ns->proc_name);
    6165                 :           3 :       if ((ref_omp_requires & OMP_REQ_REVERSE_OFFLOAD)
    6166                 :           3 :           && !(ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
    6167                 :           2 :         gfc_error ("Program unit at %L has OpenMP device constructs/routines "
    6168                 :             :                    "but does not set !$OMP REQUIRES REVERSE_OFFLOAD but other "
    6169                 :             :                    "program units do", &ns->proc_name->declared_at);
    6170                 :           3 :       if ((ref_omp_requires & OMP_REQ_UNIFIED_ADDRESS)
    6171                 :           1 :           && !(ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS))
    6172                 :           1 :         gfc_error ("Program unit at %L has OpenMP device constructs/routines "
    6173                 :             :                    "but does not set !$OMP REQUIRES UNIFIED_ADDRESS but other "
    6174                 :           1 :                    "program units do", &ns->proc_name->declared_at);
    6175                 :           3 :       if ((ref_omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)
    6176                 :           3 :           && !(ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY))
    6177                 :           2 :         gfc_error ("Program unit at %L has OpenMP device constructs/routines "
    6178                 :             :                    "but does not set !$OMP REQUIRES UNIFIED_SHARED_MEMORY but "
    6179                 :           2 :                    "other program units do", &ns->proc_name->declared_at);
    6180                 :             :     }
    6181                 :       45070 : }
    6182                 :             : 
    6183                 :             : bool
    6184                 :         109 : gfc_omp_requires_add_clause (gfc_omp_requires_kind clause,
    6185                 :             :                              const char *clause_name, locus *loc,
    6186                 :             :                              const char *module_name)
    6187                 :             : {
    6188                 :         109 :   gfc_namespace *prog_unit = gfc_current_ns;
    6189                 :         133 :   while (prog_unit->parent)
    6190                 :             :     {
    6191                 :          25 :       if (gfc_state_stack->previous
    6192                 :          25 :           && gfc_state_stack->previous->state == COMP_INTERFACE)
    6193                 :             :         break;
    6194                 :             :       prog_unit = prog_unit->parent;
    6195                 :             :     }
    6196                 :             : 
    6197                 :             :   /* Requires added after use.  */
    6198                 :         109 :   if (prog_unit->omp_target_seen
    6199                 :          24 :       && (clause & OMP_REQ_TARGET_MASK)
    6200                 :          24 :       && !(prog_unit->omp_requires & clause))
    6201                 :             :     {
    6202                 :           0 :       if (module_name)
    6203                 :           0 :         gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use "
    6204                 :             :                    "at %L comes after using a device construct/routine",
    6205                 :             :                    clause_name, module_name, loc);
    6206                 :             :       else
    6207                 :           0 :         gfc_error ("!$OMP REQUIRES clause %qs specified at %L comes after "
    6208                 :             :                    "using a device construct/routine", clause_name, loc);
    6209                 :           0 :       return false;
    6210                 :             :     }
    6211                 :             : 
    6212                 :             :   /* Overriding atomic_default_mem_order clause value.  */
    6213                 :         109 :   if ((clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6214                 :          28 :       && (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6215                 :           5 :       && (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6216                 :           5 :          != (int) clause)
    6217                 :             :     {
    6218                 :           2 :       const char *other;
    6219                 :           2 :       if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
    6220                 :             :         other = "seq_cst";
    6221                 :           0 :       else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
    6222                 :             :         other = "acq_rel";
    6223                 :           0 :       else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
    6224                 :             :         other = "relaxed";
    6225                 :             :       else
    6226                 :             :         gcc_unreachable ();
    6227                 :             : 
    6228                 :           2 :       if (module_name)
    6229                 :           0 :         gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
    6230                 :             :                    "specified via module %qs use at %L overrides a previous "
    6231                 :             :                    "%<atomic_default_mem_order(%s)%> (which might be through "
    6232                 :             :                    "using a module)", clause_name, module_name, loc, other);
    6233                 :             :       else
    6234                 :           2 :         gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
    6235                 :             :                    "specified at %L overrides a previous "
    6236                 :             :                    "%<atomic_default_mem_order(%s)%> (which might be through "
    6237                 :             :                    "using a module)", clause_name, loc, other);
    6238                 :           2 :       return false;
    6239                 :             :     }
    6240                 :             : 
    6241                 :             :   /* Requires via module not at program-unit level and not repeating clause.  */
    6242                 :         107 :   if (prog_unit != gfc_current_ns && !(prog_unit->omp_requires & clause))
    6243                 :             :     {
    6244                 :           0 :       if (clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6245                 :           0 :         gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
    6246                 :             :                    "specified via module %qs use at %L but same clause is "
    6247                 :             :                    "not specified for the program unit", clause_name,
    6248                 :             :                    module_name, loc);
    6249                 :             :       else
    6250                 :           0 :         gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use at "
    6251                 :             :                    "%L but same clause is not specified for the program unit",
    6252                 :             :                    clause_name, module_name, loc);
    6253                 :           0 :       return false;
    6254                 :             :     }
    6255                 :             : 
    6256                 :         107 :   if (!gfc_state_stack->previous
    6257                 :         100 :       || gfc_state_stack->previous->state != COMP_INTERFACE)
    6258                 :         106 :     prog_unit->omp_requires |= clause;
    6259                 :             :   return true;
    6260                 :             : }
    6261                 :             : 
    6262                 :             : match
    6263                 :          84 : gfc_match_omp_requires (void)
    6264                 :             : {
    6265                 :          84 :   static const char *clauses[] = {"reverse_offload",
    6266                 :             :                                   "unified_address",
    6267                 :             :                                   "unified_shared_memory",
    6268                 :             :                                   "dynamic_allocators",
    6269                 :             :                                   "atomic_default"};
    6270                 :          84 :   const char *clause = NULL;
    6271                 :          84 :   int requires_clauses = 0;
    6272                 :          84 :   bool first = true;
    6273                 :          84 :   locus old_loc;
    6274                 :             : 
    6275                 :          84 :   if (gfc_current_ns->parent
    6276                 :           7 :       && (!gfc_state_stack->previous
    6277                 :           7 :           || gfc_state_stack->previous->state != COMP_INTERFACE))
    6278                 :             :     {
    6279                 :           6 :       gfc_error ("!$OMP REQUIRES at %C must appear in the specification part "
    6280                 :             :                  "of a program unit");
    6281                 :           6 :       return MATCH_ERROR;
    6282                 :             :     }
    6283                 :             : 
    6284                 :         232 :   while (true)
    6285                 :             :     {
    6286                 :         155 :       old_loc = gfc_current_locus;
    6287                 :         155 :       gfc_omp_requires_kind requires_clause;
    6288                 :          77 :       if ((first || gfc_match_char (',') != MATCH_YES)
    6289                 :         155 :           && (first && gfc_match_space () != MATCH_YES))
    6290                 :           0 :         goto error;
    6291                 :         155 :       first = false;
    6292                 :         155 :       gfc_gobble_whitespace ();
    6293                 :         155 :       old_loc = gfc_current_locus;
    6294                 :             : 
    6295                 :         155 :       if (gfc_match_omp_eos () != MATCH_NO)
    6296                 :             :         break;
    6297                 :          89 :       if (gfc_match (clauses[0]) == MATCH_YES)
    6298                 :             :         {
    6299                 :          33 :           clause = clauses[0];
    6300                 :          33 :           requires_clause = OMP_REQ_REVERSE_OFFLOAD;
    6301                 :          33 :           if (requires_clauses & OMP_REQ_REVERSE_OFFLOAD)
    6302                 :           1 :             goto duplicate_clause;
    6303                 :             :         }
    6304                 :          56 :       else if (gfc_match (clauses[1]) == MATCH_YES)
    6305                 :             :         {
    6306                 :           9 :           clause = clauses[1];
    6307                 :           9 :           requires_clause = OMP_REQ_UNIFIED_ADDRESS;
    6308                 :           9 :           if (requires_clauses & OMP_REQ_UNIFIED_ADDRESS)
    6309                 :           1 :             goto duplicate_clause;
    6310                 :             :         }
    6311                 :          47 :       else if (gfc_match (clauses[2]) == MATCH_YES)
    6312                 :             :         {
    6313                 :          14 :           clause = clauses[2];
    6314                 :          14 :           requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY;
    6315                 :          14 :           if (requires_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY)
    6316                 :           1 :             goto duplicate_clause;
    6317                 :             :         }
    6318                 :          33 :       else if (gfc_match (clauses[3]) == MATCH_YES)
    6319                 :             :         {
    6320                 :           5 :           clause = clauses[3];
    6321                 :           5 :           requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS;
    6322                 :           5 :           if (requires_clauses & OMP_REQ_DYNAMIC_ALLOCATORS)
    6323                 :           1 :             goto duplicate_clause;
    6324                 :             :         }
    6325                 :          28 :       else if (gfc_match ("atomic_default_mem_order (") == MATCH_YES)
    6326                 :             :         {
    6327                 :          27 :           clause = clauses[4];
    6328                 :          27 :           if (requires_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6329                 :           1 :             goto duplicate_clause;
    6330                 :          26 :           if (gfc_match (" seq_cst )") == MATCH_YES)
    6331                 :             :             {
    6332                 :             :               clause = "seq_cst";
    6333                 :             :               requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST;
    6334                 :             :             }
    6335                 :          14 :           else if (gfc_match (" acq_rel )") == MATCH_YES)
    6336                 :             :             {
    6337                 :             :               clause = "acq_rel";
    6338                 :             :               requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL;
    6339                 :             :             }
    6340                 :           8 :           else if (gfc_match (" relaxed )") == MATCH_YES)
    6341                 :             :             {
    6342                 :             :               clause = "relaxed";
    6343                 :             :               requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_RELAXED;
    6344                 :             :             }
    6345                 :             :           else
    6346                 :             :             {
    6347                 :           4 :               gfc_error ("Expected SEQ_CST, ACQ_REL or RELAXED for "
    6348                 :             :                          "ATOMIC_DEFAULT_MEM_ORDER clause at %C");
    6349                 :           4 :               goto error;
    6350                 :             :             }
    6351                 :             :         }
    6352                 :             :       else
    6353                 :           1 :         goto error;
    6354                 :             : 
    6355                 :          79 :       if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL))
    6356                 :           2 :         goto error;
    6357                 :          77 :       requires_clauses |= requires_clause;
    6358                 :          77 :     }
    6359                 :             : 
    6360                 :          66 :   if (requires_clauses == 0)
    6361                 :             :     {
    6362                 :           1 :       if (!gfc_error_flag_test ())
    6363                 :           1 :         gfc_error ("Clause expected at %C");
    6364                 :           1 :       goto error;
    6365                 :             :     }
    6366                 :             :   return MATCH_YES;
    6367                 :             : 
    6368                 :           5 : duplicate_clause:
    6369                 :           5 :   gfc_error ("%qs clause at %L specified more than once", clause, &old_loc);
    6370                 :          13 : error:
    6371                 :          13 :   if (!gfc_error_flag_test ())
    6372                 :           1 :     gfc_error ("Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, "
    6373                 :             :                "DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or "
    6374                 :             :                "ATOMIC_DEFAULT_MEM_ORDER clause at %L", &old_loc);
    6375                 :             :   return MATCH_ERROR;
    6376                 :             : }
    6377                 :             : 
    6378                 :             : 
    6379                 :             : match
    6380                 :          47 : gfc_match_omp_scan (void)
    6381                 :             : {
    6382                 :          47 :   bool incl;
    6383                 :          47 :   gfc_omp_clauses *c = gfc_get_omp_clauses ();
    6384                 :          47 :   gfc_gobble_whitespace ();
    6385                 :          47 :   if ((incl = (gfc_match ("inclusive") == MATCH_YES))
    6386                 :          47 :       || gfc_match ("exclusive") == MATCH_YES)
    6387                 :             :     {
    6388                 :          64 :       if (gfc_match_omp_variable_list (" (", &c->lists[incl ? OMP_LIST_SCAN_IN
    6389                 :             :                                                             : OMP_LIST_SCAN_EX],
    6390                 :             :                                        false) != MATCH_YES)
    6391                 :             :         {
    6392                 :           0 :           gfc_free_omp_clauses (c);
    6393                 :           0 :           return MATCH_ERROR;
    6394                 :             :         }
    6395                 :             :     }
    6396                 :             :   else
    6397                 :             :     {
    6398                 :           1 :       gfc_error ("Expected INCLUSIVE or EXCLUSIVE clause at %C");
    6399                 :           1 :       gfc_free_omp_clauses (c);
    6400                 :           1 :       return MATCH_ERROR;
    6401                 :             :     }
    6402                 :          46 :   if (gfc_match_omp_eos () != MATCH_YES)
    6403                 :             :     {
    6404                 :           1 :       gfc_error ("Unexpected junk after !$OMP SCAN at %C");
    6405                 :           1 :       gfc_free_omp_clauses (c);
    6406                 :           1 :       return MATCH_ERROR;
    6407                 :             :     }
    6408                 :             : 
    6409                 :          45 :   new_st.op = EXEC_OMP_SCAN;
    6410                 :          45 :   new_st.ext.omp_clauses = c;
    6411                 :          45 :   return MATCH_YES;
    6412                 :             : }
    6413                 :             : 
    6414                 :             : 
    6415                 :             : match
    6416                 :          57 : gfc_match_omp_scope (void)
    6417                 :             : {
    6418                 :          57 :   return match_omp (EXEC_OMP_SCOPE, OMP_SCOPE_CLAUSES);
    6419                 :             : }
    6420                 :             : 
    6421                 :             : 
    6422                 :             : match
    6423                 :          82 : gfc_match_omp_sections (void)
    6424                 :             : {
    6425                 :          82 :   return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES);
    6426                 :             : }
    6427                 :             : 
    6428                 :             : 
    6429                 :             : match
    6430                 :         754 : gfc_match_omp_simd (void)
    6431                 :             : {
    6432                 :         754 :   return match_omp (EXEC_OMP_SIMD, OMP_SIMD_CLAUSES);
    6433                 :             : }
    6434                 :             : 
    6435                 :             : 
    6436                 :             : match
    6437                 :         575 : gfc_match_omp_single (void)
    6438                 :             : {
    6439                 :         575 :   return match_omp (EXEC_OMP_SINGLE, OMP_SINGLE_CLAUSES);
    6440                 :             : }
    6441                 :             : 
    6442                 :             : 
    6443                 :             : match
    6444                 :        1441 : gfc_match_omp_target (void)
    6445                 :             : {
    6446                 :        1441 :   return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES);
    6447                 :             : }
    6448                 :             : 
    6449                 :             : 
    6450                 :             : match
    6451                 :        1387 : gfc_match_omp_target_data (void)
    6452                 :             : {
    6453                 :        1387 :   return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES);
    6454                 :             : }
    6455                 :             : 
    6456                 :             : 
    6457                 :             : match
    6458                 :         257 : gfc_match_omp_target_enter_data (void)
    6459                 :             : {
    6460                 :         257 :   return match_omp (EXEC_OMP_TARGET_ENTER_DATA, OMP_TARGET_ENTER_DATA_CLAUSES);
    6461                 :             : }
    6462                 :             : 
    6463                 :             : 
    6464                 :             : match
    6465                 :         179 : gfc_match_omp_target_exit_data (void)
    6466                 :             : {
    6467                 :         179 :   return match_omp (EXEC_OMP_TARGET_EXIT_DATA, OMP_TARGET_EXIT_DATA_CLAUSES);
    6468                 :             : }
    6469                 :             : 
    6470                 :             : 
    6471                 :             : match
    6472                 :          23 : gfc_match_omp_target_parallel (void)
    6473                 :             : {
    6474                 :          23 :   return match_omp (EXEC_OMP_TARGET_PARALLEL,
    6475                 :          23 :                     (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES)
    6476                 :          23 :                     & ~(omp_mask (OMP_CLAUSE_COPYIN)));
    6477                 :             : }
    6478                 :             : 
    6479                 :             : 
    6480                 :             : match
    6481                 :          45 : gfc_match_omp_target_parallel_do (void)
    6482                 :             : {
    6483                 :          45 :   return match_omp (EXEC_OMP_TARGET_PARALLEL_DO,
    6484                 :          45 :                     (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES
    6485                 :          45 :                      | OMP_DO_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN)));
    6486                 :             : }
    6487                 :             : 
    6488                 :             : 
    6489                 :             : match
    6490                 :          19 : gfc_match_omp_target_parallel_do_simd (void)
    6491                 :             : {
    6492                 :          19 :   return match_omp (EXEC_OMP_TARGET_PARALLEL_DO_SIMD,
    6493                 :          19 :                     (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES
    6494                 :          19 :                      | OMP_SIMD_CLAUSES) & ~(omp_mask (OMP_CLAUSE_COPYIN)));
    6495                 :             : }
    6496                 :             : 
    6497                 :             : 
    6498                 :             : match
    6499                 :          34 : gfc_match_omp_target_simd (void)
    6500                 :             : {
    6501                 :          34 :   return match_omp (EXEC_OMP_TARGET_SIMD,
    6502                 :          34 :                     OMP_TARGET_CLAUSES | OMP_SIMD_CLAUSES);
    6503                 :             : }
    6504                 :             : 
    6505                 :             : 
    6506                 :             : match
    6507                 :          66 : gfc_match_omp_target_teams (void)
    6508                 :             : {
    6509                 :          66 :   return match_omp (EXEC_OMP_TARGET_TEAMS,
    6510                 :          66 :                     OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES);
    6511                 :             : }
    6512                 :             : 
    6513                 :             : 
    6514                 :             : match
    6515                 :          16 : gfc_match_omp_target_teams_distribute (void)
    6516                 :             : {
    6517                 :          16 :   return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE,
    6518                 :          16 :                     OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
    6519                 :          16 :                     | OMP_DISTRIBUTE_CLAUSES);
    6520                 :             : }
    6521                 :             : 
    6522                 :             : 
    6523                 :             : match
    6524                 :          47 : gfc_match_omp_target_teams_distribute_parallel_do (void)
    6525                 :             : {
    6526                 :          47 :   return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO,
    6527                 :          47 :                     (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
    6528                 :          47 :                      | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
    6529                 :          47 :                      | OMP_DO_CLAUSES)
    6530                 :          47 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED))
    6531                 :          47 :                     & ~(omp_mask (OMP_CLAUSE_LINEAR)));
    6532                 :             : }
    6533                 :             : 
    6534                 :             : 
    6535                 :             : match
    6536                 :          33 : gfc_match_omp_target_teams_distribute_parallel_do_simd (void)
    6537                 :             : {
    6538                 :          33 :   return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
    6539                 :          33 :                     (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
    6540                 :          33 :                      | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES
    6541                 :          33 :                      | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES)
    6542                 :          33 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED)));
    6543                 :             : }
    6544                 :             : 
    6545                 :             : 
    6546                 :             : match
    6547                 :          21 : gfc_match_omp_target_teams_distribute_simd (void)
    6548                 :             : {
    6549                 :          21 :   return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD,
    6550                 :          21 :                     OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES
    6551                 :          21 :                     | OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES);
    6552                 :             : }
    6553                 :             : 
    6554                 :             : 
    6555                 :             : match
    6556                 :        1708 : gfc_match_omp_target_update (void)
    6557                 :             : {
    6558                 :        1708 :   return match_omp (EXEC_OMP_TARGET_UPDATE, OMP_TARGET_UPDATE_CLAUSES);
    6559                 :             : }
    6560                 :             : 
    6561                 :             : 
    6562                 :             : match
    6563                 :        1179 : gfc_match_omp_task (void)
    6564                 :             : {
    6565                 :        1179 :   return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES);
    6566                 :             : }
    6567                 :             : 
    6568                 :             : 
    6569                 :             : match
    6570                 :          87 : gfc_match_omp_taskloop (void)
    6571                 :             : {
    6572                 :          87 :   return match_omp (EXEC_OMP_TASKLOOP, OMP_TASKLOOP_CLAUSES);
    6573                 :             : }
    6574                 :             : 
    6575                 :             : 
    6576                 :             : match
    6577                 :          39 : gfc_match_omp_taskloop_simd (void)
    6578                 :             : {
    6579                 :          39 :   return match_omp (EXEC_OMP_TASKLOOP_SIMD,
    6580                 :          39 :                     OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES);
    6581                 :             : }
    6582                 :             : 
    6583                 :             : 
    6584                 :             : match
    6585                 :         144 : gfc_match_omp_taskwait (void)
    6586                 :             : {
    6587                 :         144 :   if (gfc_match_omp_eos () == MATCH_YES)
    6588                 :             :     {
    6589                 :         132 :       new_st.op = EXEC_OMP_TASKWAIT;
    6590                 :         132 :       new_st.ext.omp_clauses = NULL;
    6591                 :         132 :       return MATCH_YES;
    6592                 :             :     }
    6593                 :          12 :   return match_omp (EXEC_OMP_TASKWAIT,
    6594                 :          12 :                     omp_mask (OMP_CLAUSE_DEPEND) | OMP_CLAUSE_NOWAIT);
    6595                 :             : }
    6596                 :             : 
    6597                 :             : 
    6598                 :             : match
    6599                 :          10 : gfc_match_omp_taskyield (void)
    6600                 :             : {
    6601                 :          10 :   if (gfc_match_omp_eos () != MATCH_YES)
    6602                 :             :     {
    6603                 :           0 :       gfc_error ("Unexpected junk after TASKYIELD clause at %C");
    6604                 :           0 :       return MATCH_ERROR;
    6605                 :             :     }
    6606                 :          10 :   new_st.op = EXEC_OMP_TASKYIELD;
    6607                 :          10 :   new_st.ext.omp_clauses = NULL;
    6608                 :          10 :   return MATCH_YES;
    6609                 :             : }
    6610                 :             : 
    6611                 :             : 
    6612                 :             : match
    6613                 :         147 : gfc_match_omp_teams (void)
    6614                 :             : {
    6615                 :         147 :   return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES);
    6616                 :             : }
    6617                 :             : 
    6618                 :             : 
    6619                 :             : match
    6620                 :          22 : gfc_match_omp_teams_distribute (void)
    6621                 :             : {
    6622                 :          22 :   return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE,
    6623                 :          22 :                     OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES);
    6624                 :             : }
    6625                 :             : 
    6626                 :             : 
    6627                 :             : match
    6628                 :          39 : gfc_match_omp_teams_distribute_parallel_do (void)
    6629                 :             : {
    6630                 :          39 :   return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO,
    6631                 :          39 :                     (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
    6632                 :          39 :                      | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
    6633                 :          39 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED)
    6634                 :          39 :                         | OMP_CLAUSE_LINEAR | OMP_CLAUSE_NOWAIT));
    6635                 :             : }
    6636                 :             : 
    6637                 :             : 
    6638                 :             : match
    6639                 :          62 : gfc_match_omp_teams_distribute_parallel_do_simd (void)
    6640                 :             : {
    6641                 :          62 :   return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
    6642                 :          62 :                     (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
    6643                 :          62 :                      | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES
    6644                 :          62 :                      | OMP_SIMD_CLAUSES)
    6645                 :          62 :                     & ~(omp_mask (OMP_CLAUSE_ORDERED) | OMP_CLAUSE_NOWAIT));
    6646                 :             : }
    6647                 :             : 
    6648                 :             : 
    6649                 :             : match
    6650                 :          44 : gfc_match_omp_teams_distribute_simd (void)
    6651                 :             : {
    6652                 :          44 :   return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_SIMD,
    6653                 :          44 :                     OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES
    6654                 :          44 :                     | OMP_SIMD_CLAUSES);
    6655                 :             : }
    6656                 :             : 
    6657                 :             : 
    6658                 :             : match
    6659                 :          39 : gfc_match_omp_workshare (void)
    6660                 :             : {
    6661                 :          39 :   return match_omp (EXEC_OMP_WORKSHARE, OMP_WORKSHARE_CLAUSES);
    6662                 :             : }
    6663                 :             : 
    6664                 :             : 
    6665                 :             : match
    6666                 :          48 : gfc_match_omp_masked (void)
    6667                 :             : {
    6668                 :          48 :   return match_omp (EXEC_OMP_MASKED, OMP_MASKED_CLAUSES);
    6669                 :             : }
    6670                 :             : 
    6671                 :             : match
    6672                 :          10 : gfc_match_omp_masked_taskloop (void)
    6673                 :             : {
    6674                 :          10 :   return match_omp (EXEC_OMP_MASKED_TASKLOOP,
    6675                 :          10 :                     OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES);
    6676                 :             : }
    6677                 :             : 
    6678                 :             : match
    6679                 :          15 : gfc_match_omp_masked_taskloop_simd (void)
    6680                 :             : {
    6681                 :          15 :   return match_omp (EXEC_OMP_MASKED_TASKLOOP_SIMD,
    6682                 :          15 :                     (OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES
    6683                 :          15 :                      | OMP_SIMD_CLAUSES));
    6684                 :             : }
    6685                 :             : 
    6686                 :             : match
    6687                 :         110 : gfc_match_omp_master (void)
    6688                 :             : {
    6689                 :         110 :   if (gfc_match_omp_eos () != MATCH_YES)
    6690                 :             :     {
    6691                 :           1 :       gfc_error ("Unexpected junk after $OMP MASTER statement at %C");
    6692                 :           1 :       return MATCH_ERROR;
    6693                 :             :     }
    6694                 :         109 :   new_st.op = EXEC_OMP_MASTER;
    6695                 :         109 :   new_st.ext.omp_clauses = NULL;
    6696                 :         109 :   return MATCH_YES;
    6697                 :             : }
    6698                 :             : 
    6699                 :             : match
    6700                 :          16 : gfc_match_omp_master_taskloop (void)
    6701                 :             : {
    6702                 :          16 :   return match_omp (EXEC_OMP_MASTER_TASKLOOP, OMP_TASKLOOP_CLAUSES);
    6703                 :             : }
    6704                 :             : 
    6705                 :             : match
    6706                 :          22 : gfc_match_omp_master_taskloop_simd (void)
    6707                 :             : {
    6708                 :          22 :   return match_omp (EXEC_OMP_MASTER_TASKLOOP_SIMD,
    6709                 :          22 :                     OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES);
    6710                 :             : }
    6711                 :             : 
    6712                 :             : match
    6713                 :         235 : gfc_match_omp_ordered (void)
    6714                 :             : {
    6715                 :         235 :   return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES);
    6716                 :             : }
    6717                 :             : 
    6718                 :             : match
    6719                 :           8 : gfc_match_omp_nothing (void)
    6720                 :             : {
    6721                 :           8 :   if (gfc_match_omp_eos () != MATCH_YES)
    6722                 :             :     {
    6723                 :           1 :       gfc_error ("Unexpected junk after $OMP NOTHING statement at %C");
    6724                 :           1 :       return MATCH_ERROR;
    6725                 :             :     }
    6726                 :             :   /* Will use ST_NONE; therefore, no EXEC_OMP_ is needed.  */
    6727                 :             :   return MATCH_YES;
    6728                 :             : }
    6729                 :             : 
    6730                 :             : match
    6731                 :         315 : gfc_match_omp_ordered_depend (void)
    6732                 :             : {
    6733                 :         315 :   return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DOACROSS));
    6734                 :             : }
    6735                 :             : 
    6736                 :             : 
    6737                 :             : /* omp atomic [clause-list]
    6738                 :             :    - atomic-clause:  read | write | update
    6739                 :             :    - capture
    6740                 :             :    - memory-order-clause: seq_cst | acq_rel | release | acquire | relaxed
    6741                 :             :    - hint(hint-expr)
    6742                 :             :    - OpenMP 5.1: compare | fail (seq_cst | acquire | relaxed ) | weak
    6743                 :             : */
    6744                 :             : 
    6745                 :             : match
    6746                 :        2146 : gfc_match_omp_atomic (void)
    6747                 :             : {
    6748                 :        2146 :   gfc_omp_clauses *c;
    6749                 :        2146 :   locus loc = gfc_current_locus;
    6750                 :             : 
    6751                 :        2146 :   if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
    6752                 :             :     return MATCH_ERROR;
    6753                 :             : 
    6754                 :        2128 :   if (c->atomic_op == GFC_OMP_ATOMIC_UNSET)
    6755                 :        1003 :     c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
    6756                 :             : 
    6757                 :        2128 :   if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
    6758                 :           3 :     gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
    6759                 :             :                "READ or WRITE", &loc, "CAPTURE");
    6760                 :        2128 :   if (c->compare && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
    6761                 :           3 :     gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
    6762                 :             :                "READ or WRITE", &loc, "COMPARE");
    6763                 :        2128 :   if (c->fail != OMP_MEMORDER_UNSET && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
    6764                 :           2 :     gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with "
    6765                 :             :                "READ or WRITE", &loc, "FAIL");
    6766                 :        2128 :   if (c->weak && !c->compare)
    6767                 :             :     {
    6768                 :           5 :       gfc_error ("!$OMP ATOMIC at %L with %s clause requires %s clause", &loc,
    6769                 :             :                  "WEAK", "COMPARE");
    6770                 :           5 :       c->weak = false;
    6771                 :             :     }
    6772                 :             : 
    6773                 :        2128 :   if (c->memorder == OMP_MEMORDER_UNSET)
    6774                 :             :     {
    6775                 :        1946 :       gfc_namespace *prog_unit = gfc_current_ns;
    6776                 :        2496 :       while (prog_unit->parent)
    6777                 :             :         prog_unit = prog_unit->parent;
    6778                 :        1946 :       switch (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
    6779                 :             :         {
    6780                 :        1923 :         case 0:
    6781                 :        1923 :         case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED:
    6782                 :        1923 :           c->memorder = OMP_MEMORDER_RELAXED;
    6783                 :        1923 :           break;
    6784                 :           7 :         case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST:
    6785                 :           7 :           c->memorder = OMP_MEMORDER_SEQ_CST;
    6786                 :           7 :           break;
    6787                 :          16 :         case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
    6788                 :          16 :           if (c->capture)
    6789                 :           5 :             c->memorder = OMP_MEMORDER_ACQ_REL;
    6790                 :          11 :           else if (c->atomic_op == GFC_OMP_ATOMIC_READ)
    6791                 :           3 :             c->memorder = OMP_MEMORDER_ACQUIRE;
    6792                 :             :           else
    6793                 :           8 :             c->memorder = OMP_MEMORDER_RELEASE;
    6794                 :             :           break;
    6795                 :             :         default:
    6796                 :             :           gcc_unreachable ();
    6797                 :             :         }
    6798                 :             :     }
    6799                 :             :   else
    6800                 :         182 :     switch (c->atomic_op)
    6801                 :             :       {
    6802                 :          28 :       case GFC_OMP_ATOMIC_READ:
    6803                 :          28 :         if (c->memorder == OMP_MEMORDER_RELEASE)
    6804                 :             :           {
    6805                 :           1 :             gfc_error ("!$OMP ATOMIC READ at %L incompatible with "
    6806                 :             :                        "RELEASE clause", &loc);
    6807                 :           1 :             c->memorder = OMP_MEMORDER_SEQ_CST;
    6808                 :             :           }
    6809                 :          27 :         else if (c->memorder == OMP_MEMORDER_ACQ_REL)
    6810                 :           1 :           c->memorder = OMP_MEMORDER_ACQUIRE;
    6811                 :             :         break;
    6812                 :          34 :       case GFC_OMP_ATOMIC_WRITE:
    6813                 :          34 :         if (c->memorder == OMP_MEMORDER_ACQUIRE)
    6814                 :             :           {
    6815                 :           1 :             gfc_error ("!$OMP ATOMIC WRITE at %L incompatible with "
    6816                 :             :                        "ACQUIRE clause", &loc);
    6817                 :           1 :             c->memorder = OMP_MEMORDER_SEQ_CST;
    6818                 :             :           }
    6819                 :          33 :         else if (c->memorder == OMP_MEMORDER_ACQ_REL)
    6820                 :           1 :           c->memorder = OMP_MEMORDER_RELEASE;
    6821                 :             :         break;
    6822                 :             :       default:
    6823                 :             :         break;
    6824                 :             :       }
    6825                 :        2128 :   gfc_error_check ();
    6826                 :        2128 :   new_st.ext.omp_clauses = c;
    6827                 :        2128 :   new_st.op = EXEC_OMP_ATOMIC;
    6828                 :        2128 :   return MATCH_YES;
    6829                 :             : }
    6830                 :             : 
    6831                 :             : 
    6832                 :             : /* acc atomic [ read | write | update | capture]  */
    6833                 :             : 
    6834                 :             : match
    6835                 :         552 : gfc_match_oacc_atomic (void)
    6836                 :             : {
    6837                 :         552 :   gfc_omp_clauses *c = gfc_get_omp_clauses ();
    6838                 :         552 :   c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
    6839                 :         552 :   c->memorder = OMP_MEMORDER_RELAXED;
    6840                 :         552 :   gfc_gobble_whitespace ();
    6841                 :         552 :   if (gfc_match ("update") == MATCH_YES)
    6842                 :             :     ;
    6843                 :         373 :   else if (gfc_match ("read") == MATCH_YES)
    6844                 :          17 :     c->atomic_op = GFC_OMP_ATOMIC_READ;
    6845                 :         356 :   else if (gfc_match ("write") == MATCH_YES)
    6846                 :          13 :     c->atomic_op = GFC_OMP_ATOMIC_WRITE;
    6847                 :         343 :   else if (gfc_match ("capture") == MATCH_YES)
    6848                 :         319 :     c->capture = true;
    6849                 :         552 :   gfc_gobble_whitespace ();
    6850                 :         552 :   if (gfc_match_omp_eos () != MATCH_YES)
    6851                 :             :     {
    6852                 :           9 :       gfc_error ("Unexpected junk after !$ACC ATOMIC statement at %C");
    6853                 :           9 :       gfc_free_omp_clauses (c);
    6854                 :           9 :       return MATCH_ERROR;
    6855                 :             :     }
    6856                 :         543 :   new_st.ext.omp_clauses = c;
    6857                 :         543 :   new_st.op = EXEC_OACC_ATOMIC;
    6858                 :         543 :   return MATCH_YES;
    6859                 :             : }
    6860                 :             : 
    6861                 :             : 
    6862                 :             : match
    6863                 :         605 : gfc_match_omp_barrier (void)
    6864                 :             : {
    6865                 :         605 :   if (gfc_match_omp_eos () != MATCH_YES)
    6866                 :             :     {
    6867                 :           0 :       gfc_error ("Unexpected junk after $OMP BARRIER statement at %C");
    6868                 :           0 :       return MATCH_ERROR;
    6869                 :             :     }
    6870                 :         605 :   new_st.op = EXEC_OMP_BARRIER;
    6871                 :         605 :   new_st.ext.omp_clauses = NULL;
    6872                 :         605 :   return MATCH_YES;
    6873                 :             : }
    6874                 :             : 
    6875                 :             : 
    6876                 :             : match
    6877                 :         188 : gfc_match_omp_taskgroup (void)
    6878                 :             : {
    6879                 :         188 :   return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES);
    6880                 :             : }
    6881                 :             : 
    6882                 :             : 
    6883                 :             : static enum gfc_omp_cancel_kind
    6884                 :         494 : gfc_match_omp_cancel_kind (void)
    6885                 :             : {
    6886                 :         494 :   if (gfc_match_space () != MATCH_YES)
    6887                 :             :     return OMP_CANCEL_UNKNOWN;
    6888                 :         492 :   if (gfc_match ("parallel") == MATCH_YES)
    6889                 :             :     return OMP_CANCEL_PARALLEL;
    6890                 :         352 :   if (gfc_match ("sections") == MATCH_YES)
    6891                 :             :     return OMP_CANCEL_SECTIONS;
    6892                 :         253 :   if (gfc_match ("do") == MATCH_YES)
    6893                 :             :     return OMP_CANCEL_DO;
    6894                 :         123 :   if (gfc_match ("taskgroup") == MATCH_YES)
    6895                 :             :     return OMP_CANCEL_TASKGROUP;
    6896                 :             :   return OMP_CANCEL_UNKNOWN;
    6897                 :             : }
    6898                 :             : 
    6899                 :             : 
    6900                 :             : match
    6901                 :         321 : gfc_match_omp_cancel (void)
    6902                 :             : {
    6903                 :         321 :   gfc_omp_clauses *c;
    6904                 :         321 :   enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
    6905                 :         321 :   if (kind == OMP_CANCEL_UNKNOWN)
    6906                 :             :     return MATCH_ERROR;
    6907                 :         319 :   if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_IF), false) != MATCH_YES)
    6908                 :             :     return MATCH_ERROR;
    6909                 :         316 :   c->cancel = kind;
    6910                 :         316 :   new_st.op = EXEC_OMP_CANCEL;
    6911                 :         316 :   new_st.ext.omp_clauses = c;
    6912                 :         316 :   return MATCH_YES;
    6913                 :             : }
    6914                 :             : 
    6915                 :             : 
    6916                 :             : match
    6917                 :         173 : gfc_match_omp_cancellation_point (void)
    6918                 :             : {
    6919                 :         173 :   gfc_omp_clauses *c;
    6920                 :         173 :   enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
    6921                 :         173 :   if (kind == OMP_CANCEL_UNKNOWN)
    6922                 :             :     {
    6923                 :           2 :       gfc_error ("Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP "
    6924                 :             :                  "in $OMP CANCELLATION POINT statement at %C");
    6925                 :           2 :       return MATCH_ERROR;
    6926                 :             :     }
    6927                 :         171 :   if (gfc_match_omp_eos () != MATCH_YES)
    6928                 :             :     {
    6929                 :           0 :       gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement "
    6930                 :             :                  "at %C");
    6931                 :           0 :       return MATCH_ERROR;
    6932                 :             :     }
    6933                 :         171 :   c = gfc_get_omp_clauses ();
    6934                 :         171 :   c->cancel = kind;
    6935                 :         171 :   new_st.op = EXEC_OMP_CANCELLATION_POINT;
    6936                 :         171 :   new_st.ext.omp_clauses = c;
    6937                 :         171 :   return MATCH_YES;
    6938                 :             : }
    6939                 :             : 
    6940                 :             : 
    6941                 :             : match
    6942                 :        1952 : gfc_match_omp_end_nowait (void)
    6943                 :             : {
    6944                 :        1952 :   bool nowait = false;
    6945                 :        1952 :   if (gfc_match ("% nowait") == MATCH_YES)
    6946                 :         255 :     nowait = true;
    6947                 :        1952 :   if (gfc_match_omp_eos () != MATCH_YES)
    6948                 :             :     {
    6949                 :           4 :       if (nowait)
    6950                 :           3 :         gfc_error ("Unexpected junk after NOWAIT clause at %C");
    6951                 :             :       else
    6952                 :           1 :         gfc_error ("Unexpected junk at %C");
    6953                 :           4 :       return MATCH_ERROR;
    6954                 :             :     }
    6955                 :        1948 :   new_st.op = EXEC_OMP_END_NOWAIT;
    6956                 :        1948 :   new_st.ext.omp_bool = nowait;
    6957                 :        1948 :   return MATCH_YES;
    6958                 :             : }
    6959                 :             : 
    6960                 :             : 
    6961                 :             : match
    6962                 :         571 : gfc_match_omp_end_single (void)
    6963                 :             : {
    6964                 :         571 :   gfc_omp_clauses *c;
    6965                 :         571 :   if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_COPYPRIVATE)
    6966                 :             :                                            | OMP_CLAUSE_NOWAIT) != MATCH_YES)
    6967                 :             :     return MATCH_ERROR;
    6968                 :         571 :   new_st.op = EXEC_OMP_END_SINGLE;
    6969                 :         571 :   new_st.ext.omp_clauses = c;
    6970                 :         571 :   return MATCH_YES;
    6971                 :             : }
    6972                 :             : 
    6973                 :             : 
    6974                 :             : static bool
    6975                 :       32924 : oacc_is_loop (gfc_code *code)
    6976                 :             : {
    6977                 :       32924 :   return code->op == EXEC_OACC_PARALLEL_LOOP
    6978                 :             :          || code->op == EXEC_OACC_KERNELS_LOOP
    6979                 :       17814 :          || code->op == EXEC_OACC_SERIAL_LOOP
    6980                 :       11983 :          || code->op == EXEC_OACC_LOOP;
    6981                 :             : }
    6982                 :             : 
    6983                 :             : static void
    6984                 :        5170 : resolve_scalar_int_expr (gfc_expr *expr, const char *clause)
    6985                 :             : {
    6986                 :        5170 :   if (!gfc_resolve_expr (expr)
    6987                 :        5170 :       || expr->ts.type != BT_INTEGER
    6988                 :       10276 :       || expr->rank != 0)
    6989                 :          78 :     gfc_error ("%s clause at %L requires a scalar INTEGER expression",
    6990                 :             :                clause, &expr->where);
    6991                 :        5170 : }
    6992                 :             : 
    6993                 :             : static void
    6994                 :        3907 : resolve_positive_int_expr (gfc_expr *expr, const char *clause)
    6995                 :             : {
    6996                 :        3907 :   resolve_scalar_int_expr (expr, clause);
    6997                 :        3907 :   if (expr->expr_type == EXPR_CONSTANT
    6998                 :        3469 :       && expr->ts.type == BT_INTEGER
    6999                 :        3436 :       && mpz_sgn (expr->value.integer) <= 0)
    7000                 :          41 :     gfc_warning (0, "INTEGER expression of %s clause at %L must be positive",
    7001                 :             :                  clause, &expr->where);
    7002                 :        3907 : }
    7003                 :             : 
    7004                 :             : static void
    7005                 :          76 : resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause)
    7006                 :             : {
    7007                 :          76 :   resolve_scalar_int_expr (expr, clause);
    7008                 :          76 :   if (expr->expr_type == EXPR_CONSTANT
    7009                 :           8 :       && expr->ts.type == BT_INTEGER
    7010                 :           7 :       && mpz_sgn (expr->value.integer) < 0)
    7011                 :           1 :     gfc_warning (0, "INTEGER expression of %s clause at %L must be "
    7012                 :             :                  "non-negative", clause, &expr->where);
    7013                 :          76 : }
    7014                 :             : 
    7015                 :             : /* Emits error when symbol is pointer, cray pointer or cray pointee
    7016                 :             :    of derived of polymorphic type.  */
    7017                 :             : 
    7018                 :             : static void
    7019                 :          98 : check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name)
    7020                 :             : {
    7021                 :          98 :   if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointer)
    7022                 :           0 :     gfc_error ("Cray pointer object %qs of derived type in %s clause at %L",
    7023                 :             :                sym->name, name, &loc);
    7024                 :          98 :   if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointee)
    7025                 :           0 :     gfc_error ("Cray pointee object %qs of derived type in %s clause at %L",
    7026                 :             :                sym->name, name, &loc);
    7027                 :             : 
    7028                 :          98 :   if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer)
    7029                 :          98 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7030                 :           0 :           && CLASS_DATA (sym)->attr.pointer))
    7031                 :           0 :     gfc_error ("POINTER object %qs of polymorphic type in %s clause at %L",
    7032                 :             :                sym->name, name, &loc);
    7033                 :          98 :   if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer)
    7034                 :          98 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7035                 :           0 :           && CLASS_DATA (sym)->attr.cray_pointer))
    7036                 :           0 :     gfc_error ("Cray pointer object %qs of polymorphic type in %s clause at %L",
    7037                 :             :                sym->name, name, &loc);
    7038                 :          98 :   if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee)
    7039                 :          98 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7040                 :           0 :           && CLASS_DATA (sym)->attr.cray_pointee))
    7041                 :           0 :     gfc_error ("Cray pointee object %qs of polymorphic type in %s clause at %L",
    7042                 :             :                sym->name, name, &loc);
    7043                 :          98 : }
    7044                 :             : 
    7045                 :             : /* Emits error when symbol represents assumed size/rank array.  */
    7046                 :             : 
    7047                 :             : static void
    7048                 :       13555 : check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
    7049                 :             : {
    7050                 :       13555 :   if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
    7051                 :          10 :     gfc_error ("Assumed size array %qs in %s clause at %L",
    7052                 :             :                sym->name, name, &loc);
    7053                 :       13555 :   if (sym->as && sym->as->type == AS_ASSUMED_RANK)
    7054                 :           9 :     gfc_error ("Assumed rank array %qs in %s clause at %L",
    7055                 :             :                sym->name, name, &loc);
    7056                 :       13555 : }
    7057                 :             : 
    7058                 :             : static void
    7059                 :        5588 : resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
    7060                 :             : {
    7061                 :           0 :   check_array_not_assumed (sym, loc, name);
    7062                 :           0 : }
    7063                 :             : 
    7064                 :             : static void
    7065                 :          50 : resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
    7066                 :             : {
    7067                 :          50 :   if (sym->attr.pointer
    7068                 :          49 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7069                 :           0 :           && CLASS_DATA (sym)->attr.class_pointer))
    7070                 :           1 :     gfc_error ("POINTER object %qs in %s clause at %L",
    7071                 :             :                sym->name, name, &loc);
    7072                 :          50 :   if (sym->attr.cray_pointer
    7073                 :          48 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7074                 :           0 :           && CLASS_DATA (sym)->attr.cray_pointer))
    7075                 :           2 :     gfc_error ("Cray pointer object %qs in %s clause at %L",
    7076                 :             :                sym->name, name, &loc);
    7077                 :          50 :   if (sym->attr.cray_pointee
    7078                 :          48 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7079                 :           0 :           && CLASS_DATA (sym)->attr.cray_pointee))
    7080                 :           2 :     gfc_error ("Cray pointee object %qs in %s clause at %L",
    7081                 :             :                sym->name, name, &loc);
    7082                 :          50 :   if (sym->attr.allocatable
    7083                 :          49 :       || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
    7084                 :           0 :           && CLASS_DATA (sym)->attr.allocatable))
    7085                 :           1 :     gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
    7086                 :             :                sym->name, name, &loc);
    7087                 :          50 :   if (sym->attr.value)
    7088                 :           1 :     gfc_error ("VALUE object %qs in %s clause at %L",
    7089                 :             :                sym->name, name, &loc);
    7090                 :          50 :   check_array_not_assumed (sym, loc, name);
    7091                 :          50 : }
    7092                 :             : 
    7093                 :             : 
    7094                 :             : struct resolve_omp_udr_callback_data
    7095                 :             : {
    7096                 :             :   gfc_symbol *sym1, *sym2;
    7097                 :             : };
    7098                 :             : 
    7099                 :             : 
    7100                 :             : static int
    7101                 :        1413 : resolve_omp_udr_callback (gfc_expr **e, int *, void *data)
    7102                 :             : {
    7103                 :        1413 :   struct resolve_omp_udr_callback_data *rcd
    7104                 :             :     = (struct resolve_omp_udr_callback_data *) data;
    7105                 :        1413 :   if ((*e)->expr_type == EXPR_VARIABLE
    7106                 :         801 :       && ((*e)->symtree->n.sym == rcd->sym1
    7107                 :         255 :           || (*e)->symtree->n.sym == rcd->sym2))
    7108                 :             :     {
    7109                 :         801 :       gfc_ref *ref = gfc_get_ref ();
    7110                 :         801 :       ref->type = REF_ARRAY;
    7111                 :         801 :       ref->u.ar.where = (*e)->where;
    7112                 :         801 :       ref->u.ar.as = (*e)->symtree->n.sym->as;
    7113                 :         801 :       ref->u.ar.type = AR_FULL;
    7114                 :         801 :       ref->u.ar.dimen = 0;
    7115                 :         801 :       ref->next = (*e)->ref;
    7116                 :         801 :       (*e)->ref = ref;
    7117                 :             :     }
    7118                 :        1413 :   return 0;
    7119                 :             : }
    7120                 :             : 
    7121                 :             : 
    7122                 :             : static int
    7123                 :        2990 : resolve_omp_udr_callback2 (gfc_expr **e, int *, void *)
    7124                 :             : {
    7125                 :        2990 :   if ((*e)->expr_type == EXPR_FUNCTION
    7126                 :         360 :       && (*e)->value.function.isym == NULL)
    7127                 :             :     {
    7128                 :         174 :       gfc_symbol *sym = (*e)->symtree->n.sym;
    7129                 :         174 :       if (!sym->attr.intrinsic
    7130                 :         174 :           && sym->attr.if_source == IFSRC_UNKNOWN)
    7131                 :           4 :         gfc_error ("Implicitly declared function %s used in "
    7132                 :             :                    "!$OMP DECLARE REDUCTION at %L", sym->name, &(*e)->where);
    7133                 :             :     }
    7134                 :        2990 :   return 0;
    7135                 :             : }
    7136                 :             : 
    7137                 :             : 
    7138                 :             : static gfc_code *
    7139                 :         797 : resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
    7140                 :             :                         gfc_symbol *sym1, gfc_symbol *sym2)
    7141                 :             : {
    7142                 :         797 :   gfc_code *copy;
    7143                 :         797 :   gfc_symbol sym1_copy, sym2_copy;
    7144                 :             : 
    7145                 :         797 :   if (ns->code->op == EXEC_ASSIGN)
    7146                 :             :     {
    7147                 :         625 :       copy = gfc_get_code (EXEC_ASSIGN);
    7148                 :         625 :       copy->expr1 = gfc_copy_expr (ns->code->expr1);
    7149                 :         625 :       copy->expr2 = gfc_copy_expr (ns->code->expr2);
    7150                 :             :     }
    7151                 :             :   else
    7152                 :             :     {
    7153                 :         172 :       copy = gfc_get_code (EXEC_CALL);
    7154                 :         172 :       copy->symtree = ns->code->symtree;
    7155                 :         172 :       copy->ext.actual = gfc_copy_actual_arglist (ns->code->ext.actual);
    7156                 :             :     }
    7157                 :         797 :   copy->loc = ns->code->loc;
    7158                 :         797 :   sym1_copy = *sym1;
    7159                 :         797 :   sym2_copy = *sym2;
    7160                 :         797 :   *sym1 = *n->sym;
    7161                 :         797 :   *sym2 = *n->sym;
    7162                 :         797 :   sym1->name = sym1_copy.name;
    7163                 :         797 :   sym2->name = sym2_copy.name;
    7164                 :         797 :   ns->proc_name = ns->parent->proc_name;
    7165                 :         797 :   if (n->sym->attr.dimension)
    7166                 :             :     {
    7167                 :         348 :       struct resolve_omp_udr_callback_data rcd;
    7168                 :         348 :       rcd.sym1 = sym1;
    7169                 :         348 :       rcd.sym2 = sym2;
    7170                 :         348 :       gfc_code_walker (&copy, gfc_dummy_code_callback,
    7171                 :             :                        resolve_omp_udr_callback, &rcd);
    7172                 :             :     }
    7173                 :         797 :   gfc_resolve_code (copy, gfc_current_ns);
    7174                 :         797 :   if (copy->op == EXEC_CALL && copy->resolved_isym == NULL)
    7175                 :             :     {
    7176                 :         172 :       gfc_symbol *sym = copy->resolved_sym;
    7177                 :         172 :       if (sym
    7178                 :         170 :           && !sym->attr.intrinsic
    7179                 :         170 :           && sym->attr.if_source == IFSRC_UNKNOWN)
    7180                 :           4 :         gfc_error ("Implicitly declared subroutine %s used in "
    7181                 :             :                    "!$OMP DECLARE REDUCTION at %L", sym->name,
    7182                 :             :                    &copy->loc);
    7183                 :             :     }
    7184                 :         797 :   gfc_code_walker (&copy, gfc_dummy_code_callback,
    7185                 :             :                    resolve_omp_udr_callback2, NULL);
    7186                 :         797 :   *sym1 = sym1_copy;
    7187                 :         797 :   *sym2 = sym2_copy;
    7188                 :         797 :   return copy;
    7189                 :             : }
    7190                 :             : 
    7191                 :             : /* Assume that a constant expression in the range 1 (omp_default_mem_alloc)
    7192                 :             :    to 8 (omp_thread_mem_alloc) range is fine.  The original symbol name is
    7193                 :             :    already lost during matching via gfc_match_expr.  */
    7194                 :             : bool
    7195                 :          27 : is_predefined_allocator (gfc_expr *expr)
    7196                 :             : {
    7197                 :          27 :   return (gfc_resolve_expr (expr)
    7198                 :          27 :           && expr->rank == 0
    7199                 :          22 :           && expr->ts.type == BT_INTEGER
    7200                 :          17 :           && expr->ts.kind == gfc_c_intptr_kind
    7201                 :          12 :           && expr->expr_type == EXPR_CONSTANT
    7202                 :           7 :           && mpz_sgn (expr->value.integer) > 0
    7203                 :          34 :           && mpz_cmp_si (expr->value.integer, 8) <= 0);
    7204                 :             : }
    7205                 :             : 
    7206                 :             : /* Resolve declarative ALLOCATE statement. Note: Common block vars only appear
    7207                 :             :    as /block/ not individual, which is ensured during parsing.  */
    7208                 :             : 
    7209                 :             : void
    7210                 :          11 : gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
    7211                 :             : {
    7212                 :          71 :   for (gfc_omp_namelist *n = list; n; n = n->next)
    7213                 :          60 :     n->sym->mark = 0;
    7214                 :          67 :   for (gfc_omp_namelist *n = list; n; n = n->next)
    7215                 :             :     {
    7216                 :          56 :       if (n->sym->attr.flavor != FL_VARIABLE)
    7217                 :             :         {
    7218                 :           1 :           gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE "
    7219                 :             :                      "directive must be a variable", n->sym->name,
    7220                 :             :                      &n->where);
    7221                 :          13 :           continue;
    7222                 :             :         }
    7223                 :          55 :       if (ns != n->sym->ns || n->sym->attr.use_assoc
    7224                 :          54 :           || n->sym->attr.host_assoc || n->sym->attr.imported)
    7225                 :             :         {
    7226                 :           2 :           gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE shall be"
    7227                 :             :                      " in the same scope as the variable declaration",
    7228                 :             :                      n->sym->name, &n->where);
    7229                 :           2 :           continue;
    7230                 :             :         }
    7231                 :          53 :       if (n->sym->attr.dummy)
    7232                 :             :         {
    7233                 :           1 :           gfc_error ("Unexpected dummy argument %qs as argument at %L to "
    7234                 :             :                      "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
    7235                 :           1 :           continue;
    7236                 :             :         }
    7237                 :          52 :       if (n->sym->mark)
    7238                 :             :         {
    7239                 :           3 :           if (n->sym->attr.in_common)
    7240                 :             :             {
    7241                 :           1 :               gfc_error ("Duplicated common block %</%s/%> in !$OMP ALLOCATE "
    7242                 :           1 :                          "at %L", n->sym->common_head->name, &n->where);
    7243                 :           3 :               while (n->next && n->next->sym
    7244                 :           4 :                      && n->sym->common_head == n->next->sym->common_head)
    7245                 :             :                 n = n->next;
    7246                 :             :             }
    7247                 :             :           else
    7248                 :           2 :             gfc_error ("Duplicated variable %qs in !$OMP ALLOCATE at %L",
    7249                 :             :                        n->sym->name, &n->where);
    7250                 :           3 :           continue;
    7251                 :             :         }
    7252                 :          49 :       n->sym->mark = 1;
    7253                 :          49 :       if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
    7254                 :           0 :            && CLASS_DATA (n->sym)->attr.allocatable)
    7255                 :          49 :           || (n->sym->ts.type != BT_CLASS && n->sym->attr.allocatable))
    7256                 :           1 :         gfc_error ("Unexpected allocatable variable %qs at %L in declarative "
    7257                 :             :                    "!$OMP ALLOCATE directive", n->sym->name, &n->where);
    7258                 :          48 :       else if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
    7259                 :           0 :                 && CLASS_DATA (n->sym)->attr.class_pointer)
    7260                 :          48 :                || (n->sym->ts.type != BT_CLASS && n->sym->attr.pointer))
    7261                 :           1 :         gfc_error ("Unexpected pointer variable %qs at %L in declarative "
    7262