@@ -190,7 +190,7 @@ bool is_native_parameter(Node *n) {
190
190
* \brief Determine whether an enum is being wrapped
191
191
*/
192
192
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" );
194
194
}
195
195
196
196
/* -------------------------------------------------------------------------
@@ -649,10 +649,9 @@ class FORTRAN : public Language {
649
649
void replace_fclassname (SwigType *type, String *tm);
650
650
String *get_fsymname (Node *n, String *symname = NULL );
651
651
String *get_proxyname (SwigType *classnametype);
652
- String * get_fenumname (SwigType *classnametype);
652
+ bool is_wrapped_type (SwigType *classnametype);
653
653
bool is_wrapped_class (Node *n);
654
654
655
-
656
655
// Add lowercase symbol (fortran) to the module's namespace
657
656
int add_fsymbol (String *s, Node *n);
658
657
// Whether the current class is a BIND(C) struct
@@ -2999,21 +2998,6 @@ void FORTRAN::replace_fclassname(SwigType *intype, String *tm) {
2999
2998
}
3000
2999
Delete (repltype);
3001
3000
}
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
- }
3017
3001
3018
3002
Delete (resolvedtype);
3019
3003
Delete (strippedtype);
@@ -3029,85 +3013,83 @@ void FORTRAN::replace_fclassname(SwigType *intype, String *tm) {
3029
3013
*/
3030
3014
String *FORTRAN::get_fsymname (Node *n, String *symname) {
3031
3015
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;
3045
3018
}
3046
3019
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
+ }
3047
3032
return fsymname;
3048
3033
}
3049
3034
3050
3035
/* ------------------------------------------------------------------------- */
3051
3036
3052
3037
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 );
3058
3043
} 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 ;
3078
3066
}
3079
3067
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);
3080
3081
return replacementname;
3081
3082
}
3082
3083
3083
3084
/* ------------------------------------------------------------------------- */
3084
3085
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);
3092
3090
} 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 ;
3108
3092
}
3109
-
3110
- return replacementname;
3111
3093
}
3112
3094
3113
3095
/* ------------------------------------------------------------------------- */
@@ -3137,27 +3119,20 @@ bool FORTRAN::is_wrapped_class(Node *n) {
3137
3119
// Somehow there's no ftype; allow it to be wrapped so the error is handled later
3138
3120
result = true ;
3139
3121
} else if (Strstr (tm, " $fclassname" )) {
3140
- result = ( this ->classLookup (strippedtype) != NULL );
3122
+ result = this ->is_wrapped_type (strippedtype);
3141
3123
} else if (Strstr (tm, " $*fclassname" )) {
3142
3124
SwigType_pop (strippedtype);
3143
- result = Len (strippedtype) > 0 && ( this ->classLookup (strippedtype) != NULL );
3125
+ result = this ->is_wrapped_type (strippedtype);
3144
3126
} else if (Strstr (tm, " $&fclassname" )) {
3145
3127
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);
3154
3129
} else {
3155
3130
// Type doesn't resolve to something that expects a class name
3156
3131
result = true ;
3157
3132
}
3158
3133
3159
3134
// Save in cache
3160
- Setattr (cached_classes, intype, result ? is_wrapped : not_wrapped);
3135
+ Setattr (cached_classes, intype, result ? is_wrapped : not_wrapped);
3161
3136
Delete (resolvedtype);
3162
3137
Delete (strippedtype);
3163
3138
return result;
0 commit comments