+
+/* This is a specialist version of decode_statement that is used
+ for the specification statements in a function, whose
+ characteristics are deferred into the specification statements.
+ eg.: INTEGER (king = mykind) foo ()
+ USE mymodule, ONLY mykind.....
+ The KIND parameter needs a return after USE or IMPORT, whereas
+ derived type declarations can occur anywhere, up the executable
+ block. ST_GET_FCN_CHARACTERISTICS is returned when we have run
+ out of the correct kind of specification statements. */
+static gfc_statement
+decode_specification_statement (void)
+{
+ gfc_statement st;
+ locus old_locus;
+ char c;
+
+ if (gfc_match_eos () == MATCH_YES)
+ return ST_NONE;
+
+ old_locus = gfc_current_locus;
+
+ match ("import", gfc_match_import, ST_IMPORT);
+ match ("use", gfc_match_use, ST_USE);
+
+ if (gfc_current_block ()->ts.type != BT_DERIVED)
+ goto end_of_block;
+
+ match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);
+ match (NULL, gfc_match_data_decl, ST_DATA_DECL);
+ match (NULL, gfc_match_enumerator_def, ST_ENUMERATOR);
+
+ /* General statement matching: Instead of testing every possible
+ statement, we eliminate most possibilities by peeking at the
+ first character. */
+
+ c = gfc_peek_ascii_char ();
+
+ switch (c)
+ {
+ case 'a':
+ match ("abstract% interface", gfc_match_abstract_interface,
+ ST_INTERFACE);
+ break;
+
+ case 'b':
+ match (NULL, gfc_match_bind_c_stmt, ST_ATTR_DECL);
+ break;
+
+ case 'c':
+ break;
+
+ case 'd':
+ match ("data", gfc_match_data, ST_DATA);
+ match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
+ break;
+
+ case 'e':
+ match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
+ match ("entry% ", gfc_match_entry, ST_ENTRY);
+ match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
+ match ("external", gfc_match_external, ST_ATTR_DECL);
+ break;
+
+ case 'f':
+ match ("format", gfc_match_format, ST_FORMAT);
+ break;
+
+ case 'g':
+ break;
+
+ case 'i':
+ match ("implicit", gfc_match_implicit, ST_IMPLICIT);
+ match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
+ match ("interface", gfc_match_interface, ST_INTERFACE);
+ match ("intent", gfc_match_intent, ST_ATTR_DECL);
+ match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
+ break;
+
+ case 'm':
+ break;
+
+ case 'n':
+ match ("namelist", gfc_match_namelist, ST_NAMELIST);
+ break;
+
+ case 'o':
+ match ("optional", gfc_match_optional, ST_ATTR_DECL);
+ break;
+
+ case 'p':
+ match ("parameter", gfc_match_parameter, ST_PARAMETER);
+ match ("pointer", gfc_match_pointer, ST_ATTR_DECL);
+ if (gfc_match_private (&st) == MATCH_YES)
+ return st;
+ match ("procedure", gfc_match_procedure, ST_PROCEDURE);
+ if (gfc_match_public (&st) == MATCH_YES)
+ return st;
+ match ("protected", gfc_match_protected, ST_ATTR_DECL);
+ break;
+
+ case 'r':
+ break;
+
+ case 's':
+ match ("save", gfc_match_save, ST_ATTR_DECL);
+ break;
+
+ case 't':
+ match ("target", gfc_match_target, ST_ATTR_DECL);
+ match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
+ break;
+
+ case 'u':
+ break;
+
+ case 'v':
+ match ("value", gfc_match_value, ST_ATTR_DECL);
+ match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
+ break;
+
+ case 'w':
+ break;
+ }
+
+ /* This is not a specification statement. See if any of the matchers
+ has stored an error message of some sort. */
+
+end_of_block:
+ gfc_clear_error ();
+ gfc_buffer_error (0);
+ gfc_current_locus = old_locus;
+
+ return ST_GET_FCN_CHARACTERISTICS;
+}
+
+
+/* This is the primary 'decode_statement'. */
OSDN Git Service
