Skip to content

Commit 4d78a17

Browse files
committed
Combine fenumname and fclassname
1 parent ff77691 commit 4d78a17

File tree

2 files changed

+69
-94
lines changed

2 files changed

+69
-94
lines changed

Lib/fortran/enums.swg

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,17 +11,17 @@
1111
// integer pointers)
1212
%fortran_unsigned(int, enum SWIGTYPE)
1313

14-
%typemap(ftype, in="integer($fenumname), intent(in)") enum SWIGTYPE
15-
"integer($fenumname)"
14+
%typemap(ftype, in="integer($fclassname), intent(in)") enum SWIGTYPE
15+
"integer($fclassname)"
1616
%typemap(out, noblock=1) enum SWIGTYPE {
1717
$result = (int)($1);
1818
}
1919
%typemap(out, noblock=1) const enum SWIGTYPE& {
2020
$result = (int)(*$1);
2121
}
2222

23-
%typemap(ftype, in="integer($*fenumname), intent(in)") const enum SWIGTYPE&
24-
"integer($*fenumname)"
23+
%typemap(ftype, in="integer($*fclassname), intent(in)") const enum SWIGTYPE&
24+
"integer($*fclassname)"
2525
%typemap(imtype) const enum SWIGTYPE& = enum SWIGTYPE;
2626
%typemap(fin) const enum SWIGTYPE& = enum SWIGTYPE;
2727
%typemap(fout) const enum SWIGTYPE& = enum SWIGTYPE;

Source/Modules/fortran.cxx

Lines changed: 65 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -190,7 +190,7 @@ bool is_native_parameter(Node *n) {
190190
* \brief Determine whether an enum is being wrapped
191191
*/
192192
bool is_wrapped_enum(Node *n) {
193-
return n && !GetFlag(n, "enumMissing") && GetFlag(n, "fortran:declared");
193+
return !GetFlag(n, "enumMissing") && GetFlag(n, "fortran:declared");
194194
}
195195

196196
/* -------------------------------------------------------------------------
@@ -649,10 +649,9 @@ class FORTRAN : public Language {
649649
void replace_fclassname(SwigType *type, String *tm);
650650
String *get_fsymname(Node *n, String *symname = NULL);
651651
String *get_proxyname(SwigType *classnametype);
652-
String *get_fenumname(SwigType *classnametype);
652+
bool is_wrapped_type(SwigType *classnametype);
653653
bool is_wrapped_class(Node *n);
654654

655-
656655
// Add lowercase symbol (fortran) to the module's namespace
657656
int add_fsymbol(String *s, Node *n);
658657
// Whether the current class is a BIND(C) struct
@@ -2999,21 +2998,6 @@ void FORTRAN::replace_fclassname(SwigType *intype, String *tm) {
29992998
}
30002999
Delete(repltype);
30013000
}
3002-
if (Strstr(tm, "$fenumname")) {
3003-
if (String *repl = this->get_fenumname(strippedtype)) {
3004-
Replaceall(tm, "$fenumname", repl);
3005-
}
3006-
}
3007-
if (Strstr(tm, "$*fenumname")) {
3008-
String *repltype = Copy(strippedtype);
3009-
Delete(SwigType_pop(repltype));
3010-
if (Len(repltype) > 0) {
3011-
if (String *repl = this->get_fenumname(repltype)) {
3012-
Replaceall(tm, "$*fenumname", repl);
3013-
}
3014-
}
3015-
Delete(repltype);
3016-
}
30173001

30183002
Delete(resolvedtype);
30193003
Delete(strippedtype);
@@ -3029,85 +3013,83 @@ void FORTRAN::replace_fclassname(SwigType *intype, String *tm) {
30293013
*/
30303014
String *FORTRAN::get_fsymname(Node *n, String *symname) {
30313015
String *fsymname = Getattr(n, "fortran:name");
3032-
if (!fsymname) {
3033-
// Create fortran identifier from symname
3034-
if (!symname) {
3035-
symname = Getattr(n, "sym:name");
3036-
}
3037-
ASSERT_OR_PRINT_NODE(symname, n);
3038-
fsymname = make_fname(symname);
3039-
3040-
if (this->add_fsymbol(fsymname, n) == SWIG_ERROR) {
3041-
fsymname = NULL;
3042-
} else {
3043-
Setattr(n, "fortran:name", fsymname);
3044-
}
3016+
if (fsymname) {
3017+
return fsymname;
30453018
}
30463019

3020+
// Create fortran identifier from symname
3021+
if (!symname) {
3022+
symname = Getattr(n, "sym:name");
3023+
}
3024+
ASSERT_OR_PRINT_NODE(symname, n);
3025+
fsymname = make_fname(symname);
3026+
3027+
if (this->add_fsymbol(fsymname, n) == SWIG_ERROR) {
3028+
fsymname = NULL;
3029+
} else {
3030+
Setattr(n, "fortran:name", fsymname);
3031+
}
30473032
return fsymname;
30483033
}
30493034

30503035
/* ------------------------------------------------------------------------- */
30513036

30523037
String *FORTRAN::get_proxyname(SwigType *classnametype) {
3053-
String *replacementname = NULL;
3054-
Node *n = this->classLookup(classnametype);
3055-
3056-
if (n) {
3057-
replacementname = this->get_fsymname(n);
3038+
Node *n = NULL;
3039+
3040+
bool is_enum = SwigType_isenum(classnametype);
3041+
if (is_enum) {
3042+
n = this->enumLookup(classnametype);
30583043
} else {
3059-
replacementname = create_mangled_fname(classnametype);
3060-
3061-
if (!Getattr(d_emitted_mangled, replacementname)) {
3062-
// First time encountering this particular mangled type
3063-
// Create a node so we can insert into the fortran symbol table
3064-
n = NewHash();
3065-
set_nodeType(n, "classforward");
3066-
Setattr(n, "name", classnametype);
3067-
3068-
if (this->add_fsymbol(replacementname, n) != SWIG_NOWRAP) {
3069-
emit_fragment("SwigClassWrapper_f");
3070-
Printv(f_fdecl,
3071-
" type, public :: ", replacementname, "\n",
3072-
" type(SwigClassWrapper), public :: swigdata\n",
3073-
" end type\n",
3074-
NULL);
3075-
Setattr(d_emitted_mangled, replacementname, n);
3076-
}
3077-
}
3044+
n = this->classLookup(classnametype);
3045+
}
3046+
3047+
if (n && (!is_enum || is_wrapped_enum(n))) {
3048+
// Class node or enum with already-generated wrapper
3049+
return this->get_fsymname(n);
3050+
}
3051+
3052+
String *replacementname = create_mangled_fname(classnametype);
3053+
if (Getattr(d_emitted_mangled, replacementname)) {
3054+
// Mangled type has already been emitted
3055+
return replacementname;
3056+
}
3057+
3058+
// First time encountering this particular mangled type
3059+
// Create a node so we can insert into the fortran symbol table
3060+
n = NewHash();
3061+
set_nodeType(n, (is_enum ? "enumforward" : "classforward"));
3062+
Setattr(n, "name", classnametype);
3063+
if (this->add_fsymbol(replacementname, n) == SWIG_NOWRAP) {
3064+
ASSERT_OR_PRINT_NODE(false, n);
3065+
return NULL;
30783066
}
30793067

3068+
if (is_enum) {
3069+
Replace(replacementname, "enum ", "", DOH_REPLACE_ANY);
3070+
Printv(f_fdecl, "integer, parameter, public :: ", replacementname, " = C_INT\n", NULL);
3071+
} else {
3072+
emit_fragment("SwigClassWrapper_f");
3073+
Printv(f_fdecl,
3074+
" type, public :: ", replacementname, "\n",
3075+
" type(SwigClassWrapper), public :: swigdata\n",
3076+
" end type\n",
3077+
NULL);
3078+
3079+
}
3080+
Setattr(d_emitted_mangled, replacementname, n);
30803081
return replacementname;
30813082
}
30823083

30833084
/* ------------------------------------------------------------------------- */
30843085

3085-
String *FORTRAN::get_fenumname(SwigType *classnametype) {
3086-
String *replacementname = NULL;
3087-
Node *n = this->enumLookup(classnametype);
3088-
3089-
// The enum name is only available if the 'missing' flag isn't set and we've marked the enum as 'declared'
3090-
if (is_wrapped_enum(n)) {
3091-
replacementname = this->get_fsymname(n);
3086+
bool FORTRAN::is_wrapped_type(SwigType *classnametype) {
3087+
if (SwigType_isenum(classnametype)) {
3088+
Node *n = this->enumLookup(classnametype);
3089+
return n && is_wrapped_enum(n);
30923090
} else {
3093-
replacementname = create_mangled_fname(classnametype);
3094-
3095-
if (!Getattr(d_emitted_mangled, replacementname)) {
3096-
// First time encountering this particular mangled type
3097-
// Create a node so we can insert into the fortran symbol table
3098-
n = NewHash();
3099-
set_nodeType(n, "enumforward");
3100-
Setattr(n, "name", classnametype);
3101-
3102-
if (this->add_fsymbol(replacementname, n) != SWIG_NOWRAP) {
3103-
Replace(replacementname, "enum ", "", DOH_REPLACE_ANY);
3104-
Printv(f_fdecl, "integer, parameter, public :: ", replacementname, " = C_INT\n", NULL);
3105-
Setattr(d_emitted_mangled, replacementname, n);
3106-
}
3107-
}
3091+
return this->classLookup(classnametype) != NULL;
31083092
}
3109-
3110-
return replacementname;
31113093
}
31123094

31133095
/* ------------------------------------------------------------------------- */
@@ -3137,27 +3119,20 @@ bool FORTRAN::is_wrapped_class(Node *n) {
31373119
// Somehow there's no ftype; allow it to be wrapped so the error is handled later
31383120
result = true;
31393121
} else if (Strstr(tm, "$fclassname")) {
3140-
result = (this->classLookup(strippedtype) != NULL);
3122+
result = this->is_wrapped_type(strippedtype);
31413123
} else if (Strstr(tm, "$*fclassname")) {
31423124
SwigType_pop(strippedtype);
3143-
result = Len(strippedtype) > 0 && (this->classLookup(strippedtype) != NULL);
3125+
result = this->is_wrapped_type(strippedtype);
31443126
} else if (Strstr(tm, "$&fclassname")) {
31453127
SwigType_add_pointer(strippedtype);
3146-
result = (this->classLookup(strippedtype) != NULL);
3147-
} else if (Strstr(tm, "$fenumname")) {
3148-
// True if the enum is declared
3149-
result = is_wrapped_enum(this->enumLookup(strippedtype));
3150-
} else if (Strstr(tm, "$*fenumname")) {
3151-
// True if the enum is declared
3152-
SwigType_pop(strippedtype);
3153-
result = Len(strippedtype) > 0 && is_wrapped_enum(this->enumLookup(strippedtype));
3128+
result = this->is_wrapped_type(strippedtype);
31543129
} else {
31553130
// Type doesn't resolve to something that expects a class name
31563131
result = true;
31573132
}
31583133

31593134
// Save in cache
3160-
Setattr(cached_classes, intype, result ? is_wrapped : not_wrapped);
3135+
Setattr(cached_classes, intype, result ? is_wrapped : not_wrapped);
31613136
Delete(resolvedtype);
31623137
Delete(strippedtype);
31633138
return result;

0 commit comments

Comments
 (0)