static void gfc_show_attr (symbol_attribute * attr) { gfc_status ("(%s %s %s %s", gfc_code2string (flavors, attr->flavor), gfc_intent_string (attr->intent), gfc_code2string (access_types, attr->access), gfc_code2string (procedures, attr->proc)); if (attr->allocatable) gfc_status (" ALLOCATABLE"); if (attr->dimension) gfc_status (" DIMENSION"); if (attr->external) gfc_status (" EXTERNAL"); if (attr->intrinsic) gfc_status (" INTRINSIC"); if (attr->optional) gfc_status (" OPTIONAL"); if (attr->pointer) gfc_status (" POINTER"); if (attr->save) gfc_status (" SAVE"); if (attr->target) gfc_status (" TARGET"); if (attr->dummy) gfc_status (" DUMMY"); if (attr->result) gfc_status (" RESULT"); if (attr->entry) gfc_status (" ENTRY"); if (attr->data) gfc_status (" DATA"); if (attr->use_assoc) gfc_status (" USE-ASSOC"); if (attr->in_namelist) gfc_status (" IN-NAMELIST"); if (attr->in_common) gfc_status (" IN-COMMON"); if (attr->function) gfc_status (" FUNCTION"); if (attr->subroutine) gfc_status (" SUBROUTINE"); if (attr->implicit_type) gfc_status (" IMPLICIT-TYPE"); if (attr->sequence) gfc_status (" SEQUENCE"); if (attr->elemental) gfc_status (" ELEMENTAL"); if (attr->pure) gfc_status (" PURE"); if (attr->recursive) gfc_status (" RECURSIVE"); gfc_status (")"); }
static void show_components (gfc_symbol *sym) { gfc_component *c; for (c = sym->components; c; c = c->next) { fprintf (dumpfile, "(%s ", c->name); show_typespec (&c->ts); if (c->attr.allocatable) fputs (" ALLOCATABLE", dumpfile); if (c->attr.pointer) fputs (" POINTER", dumpfile); if (c->attr.proc_pointer) fputs (" PPC", dumpfile); if (c->attr.dimension) fputs (" DIMENSION", dumpfile); fputc (' ', dumpfile); show_array_spec (c->as); if (c->attr.access) fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access)); fputc (')', dumpfile); if (c->next != NULL) fputc (' ', dumpfile); } }
static void show_attr (symbol_attribute *attr, const char * module) { if (attr->flavor != FL_UNKNOWN) fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor)); if (attr->access != ACCESS_UNKNOWN) fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access)); if (attr->proc != PROC_UNKNOWN) fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc)); if (attr->save != SAVE_NONE) fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save)); if (attr->artificial) fputs (" ARTIFICIAL", dumpfile); if (attr->allocatable) fputs (" ALLOCATABLE", dumpfile); if (attr->asynchronous) fputs (" ASYNCHRONOUS", dumpfile); if (attr->codimension) fputs (" CODIMENSION", dumpfile); if (attr->dimension) fputs (" DIMENSION", dumpfile); if (attr->contiguous) fputs (" CONTIGUOUS", dumpfile); if (attr->external) fputs (" EXTERNAL", dumpfile); if (attr->intrinsic) fputs (" INTRINSIC", dumpfile); if (attr->optional) fputs (" OPTIONAL", dumpfile); if (attr->pointer) fputs (" POINTER", dumpfile); if (attr->is_protected) fputs (" PROTECTED", dumpfile); if (attr->value) fputs (" VALUE", dumpfile); if (attr->volatile_) fputs (" VOLATILE", dumpfile); if (attr->threadprivate) fputs (" THREADPRIVATE", dumpfile); if (attr->target) fputs (" TARGET", dumpfile); if (attr->dummy) { fputs (" DUMMY", dumpfile); if (attr->intent != INTENT_UNKNOWN) fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent)); } if (attr->result) fputs (" RESULT", dumpfile); if (attr->entry) fputs (" ENTRY", dumpfile); if (attr->is_bind_c) fputs (" BIND(C)", dumpfile); if (attr->data) fputs (" DATA", dumpfile); if (attr->use_assoc) { fputs (" USE-ASSOC", dumpfile); if (module != NULL) fprintf (dumpfile, "(%s)", module); } if (attr->in_namelist) fputs (" IN-NAMELIST", dumpfile); if (attr->in_common) fputs (" IN-COMMON", dumpfile); if (attr->abstract) fputs (" ABSTRACT", dumpfile); if (attr->function) fputs (" FUNCTION", dumpfile); if (attr->subroutine) fputs (" SUBROUTINE", dumpfile); if (attr->implicit_type) fputs (" IMPLICIT-TYPE", dumpfile); if (attr->sequence) fputs (" SEQUENCE", dumpfile); if (attr->elemental) fputs (" ELEMENTAL", dumpfile); if (attr->pure) fputs (" PURE", dumpfile); if (attr->recursive) fputs (" RECURSIVE", dumpfile); fputc (')', dumpfile); }
/* TODO: move to gfortran.h as define. */ const char * gfc_intent_string (sym_intent i) { return gfc_code2string (intents, i); }