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);
}
