Release-1.7.2-20101224

1 files changed, 139 insertions, 60 deletions

diff --git a/src/fortranscanner.l b/src/fortranscanner.l
index 3156eb1..03f75d4 100644
--- a/src/fortranscanner.l
+++ b/src/fortranscanner.l
@@ -66,6 +66,7 @@
 #define YY_NEVER_INTERACTIVE 1
 
 enum ScanVar { V_IGNORE, V_VARIABLE, V_PARAMETER};
+enum InterfaceType { IF_NONE, IF_SPECIFIC, IF_GENERIC, IF_ABSTRACT };
 
 // {{{ ----- Helper structs -----
 //! Holds modifiers (ie attributes) for one symbol (variable, function, etc)
@@ -86,11 +87,15 @@ struct SymbolModifiers {
   bool pointer;
   bool target;
   bool save;
+  bool nopass;
+  bool pass;
+  QCString passVar;
 
   SymbolModifiers() : type(), returnName(), protection(NONE_P), direction(NONE_D),
     optional(FALSE), dimension(), allocatable(FALSE),
     external(FALSE), intrinsic(FALSE), parameter(FALSE),
-    pointer(FALSE), target(FALSE), save(FALSE) {}
+    pointer(FALSE), target(FALSE), save(FALSE),
+    nopass(FALSE), pass(FALSE), passVar() {}
 
   SymbolModifiers& operator|=(const SymbolModifiers &mdfs);
   SymbolModifiers& operator|=(QCString mdfrString);
@@ -158,6 +163,7 @@ static int               initializerArrayScope;  // number if nested array scope
 static int               initializerScope;  // number if nested function calls in initializer
 static QCString          useModuleName;  // name of module in the use statement
 static Protection        defaultProtection;
+static InterfaceType     ifType = IF_NONE;
 
 static char              stringStartSymbol; // single or double quote
 
@@ -174,7 +180,7 @@ static void handleCommentBlock(const QCString &doc,bool brief);
 static void addCurrentEntry();
 static void addModule(const char *name, bool isModule=FALSE);
 static void addSubprogram(const char *text);
-static void addInterface(QCString name);
+static void addInterface(QCString name, InterfaceType type);
 static Argument *addFortranParameter(const QCString &type,const QCString &name, const QCString docs);
 static void scanner_abort();
 
@@ -205,7 +211,7 @@ SEPARATE  [:, \t]
 ID        [a-z_A-Z%]+{IDSYM}*
 PP_ID     {ID}
 LABELID   [a-z_A-Z]+[a-z_A-Z0-9\-]*
-SUBPROG   (subroutine|function|block)
+SUBPROG   (subroutine|function)
 B         [ \t]
 BS        [ \t]*
 BS_       [ \t]+
@@ -220,11 +226,12 @@ NOARGS    {BS}"\n"
 NUM_TYPE  (complex|integer|logical|real)
 KIND      {ARGS}
 CHAR      (CHARACTER{ARGS}?|CHARACTER{BS}"*"({BS}[0-9]+|{ARGS}))
-TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS_}PRECISION|{CHAR}|TYPE{ARGS})
+TYPE_SPEC (({NUM_TYPE}({BS}"*"{BS}[0-9]+)?)|({NUM_TYPE}{KIND})|DOUBLE{BS_}PRECISION|{CHAR}|TYPE{ARGS}|PROCEDURE{ARGS})
 
 INTENT_SPEC intent{BS}"("{BS}(in|out|in{BS}out){BS}")"
-ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)
+ATTR_SPEC (ALLOCATABLE|DIMENSION{ARGS}|EXTERNAL|{INTENT_SPEC}|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET|NOPASS|PASS{ARGS})
 ACCESS_SPEC (PRIVATE|PUBLIC)
+LANGUAGE_BIND_SPEC BIND{BS}"("{BS}C{BS}(,{BS}NAME{BS}"="{BS}"\""(.*)"\""{BS})?")"
 /* Assume that attribute statements are almost the same as attributes. */
 ATTR_STMT {ATTR_SPEC}|DIMENSION|{ACCESS_SPEC}
 
@@ -403,38 +410,52 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
                                           yy_pop_state();
                                         }
 
- /*------ ignore special fortran statements */
-<Start,ModuleBody,SubprogBody>^[ \t]*interface({BS_}{ID}({ARGS}?)?)?/{BS}(!|\n) { // handle interface block
-                                          if(YY_START == Start)
-                                          {
-                                            addModule(NULL); 
-                                            yy_push_state(ModuleBody); //anon program
-                                          }
+ /* INTERFACE definitions */
+<Start,ModuleBody,SubprogBody>{
+^{BS}interface                          { ifType = IF_SPECIFIC;
+                                          yy_push_state(InterfaceBody);
+                                          // do not start a scope here, every
+                                          // interface body is a scope of its own
+                                        }
 
-					  QCString name = yytext;
-					  int index = name.find("interface", 0, FALSE);
-					  index = name.find(QRegExp("[^ \\t]"), index+9);
-					  //printf(stderr,"%s,%d\n",name.data(),index);
-					  if (index!=-1)
-					    name = name.right(name.length()-index);
-					  else // interface without name, must be inside subprog
-					    name = "interface"; 
-					  addInterface(name);
-					  yy_push_state(InterfaceBody);
- 					  startScope(last_entry);
+^{BS}abstract{BS_}interface             { ifType = IF_ABSTRACT;
+                                          yy_push_state(InterfaceBody);
+                                          // do not start a scope here, every
+                                          // interface body is a scope of its own
                                         }
-<InterfaceBody>^{BS}"end"({BS}"interface"({BS_}{ID}{ARGS}?)?)?{BS}/(\n|!) {
-					  if (!endScope(current_root))
-					    yyterminate();
-					  yy_pop_state();
+
+^{BS}interface{BS_}{ID}                 { ifType = IF_GENERIC;
+                                          yy_push_state(InterfaceBody);
+
+                                          // extract generic name
+                                          QCString name = QCString(yytext).stripWhiteSpace();
+                                          name = name.right(name.length() - 9).stripWhiteSpace();
+                                          addInterface(name, ifType);
+
+                                          startScope(last_entry);
+                                        }
+}
+
+<InterfaceBody>^{BS}end{BS}interface({BS_}{ID})? {
+                                          // end scope only if GENERIC interface
+                                          if (ifType == IF_GENERIC && !endScope(current_root))
+                                            yyterminate();
+
+                                          ifType = IF_NONE;
+                                          yy_pop_state();
                                         }
 <InterfaceBody>module{BS}procedure      { yy_push_state(YY_START);
                                           BEGIN(ModuleProcedure);
                                         }
-<ModuleProcedure>{ID}                   {                       			
+<ModuleProcedure>{ID}                   { if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
+                                          {
+                                            addInterface(yytext, ifType);
+                                            startScope(last_entry);
+                                          }
+
                                           current->section = Entry::FUNCTION_SEC ;
                                           current->name = yytext; 
- 	                                  moduleProcedures.append(current);
+                                          moduleProcedures.append(current);
                                           addCurrentEntry();
                                         }
 <ModuleProcedure>"\n"                   { unput(*yytext); 
@@ -485,7 +506,7 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
 
  /*------- type definition  -------------------------------------------------------------------------------*/
 
-<Start,ModuleBody>"type"({BS_}|({COMMA}{ACCESS_SPEC})) { /* type definition found : TYPE , access-spec::type-name |*/
+<Start,ModuleBody>"type"({BS_}|({COMMA}{ACCESS_SPEC}|{COMMA}{LANGUAGE_BIND_SPEC})) {
                                           if(YY_START == Start)
                                           {
                                             addModule(NULL); 
@@ -498,6 +519,9 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
 <Typedef>{ACCESS_SPEC}          	{ 	
                                             QCString type= yytext;				    
                                         }
+<Typedef>{LANGUAGE_BIND_SPEC}           {
+                                            /* ignored for now */
+                                        }
 <Typedef>{ID}                        	{ /* type name found */
                                             //cout << "=========> got typedef " << yytext << ": " << yyLineNr << endl; 
                                             current->section = Entry::CLASS_SEC; // was Entry::STRUCT_SEC;
@@ -528,12 +552,14 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
  /*------- module/global/typedef variable ---------------------------------------------------*/
 
 <SubprogBody,SubprogBodyContains>^{BS}[0-9]*{BS}"end"({BS}{SUBPROG}({BS_}{ID})?)?{BS}/(\n|!) {  
-                                           //fprintf(stderr,"1e=========> got end subprog: %s\n", yytext);
+                                           //
+                                           // ABSTRACT and specific interfaces are stored
+                                           // in a scope of their own, even if multiple
+                                           // are group in one INTERFACE/END INTERFACE block.
+                                           //
+                                           if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
+                                             endScope(current_root);
 
-                                           /* args is used for parameters in list of functions, argList for 
-                                             parameters in detailed function descripttion */
-                                           //current->args = argListToString(current->argList); 
-					   //current->endBodyLine  = yyLineNr; // ??? what ist endBodyLine for
 					   if (!endScope(current_root))
 					     yyterminate();
 					   yy_pop_state() ;
@@ -692,15 +718,18 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
  /*------ fortran subroutine/function handling ------------------------------------------------------------*/
  /*       Start is initial condition                                                                       */
  
-<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}/{SUBPROG}{BS_} {   
-		                           // TYPE_SPEC is for old function style function result
-                                           result= yytext;
-                                           result= result.stripWhiteSpace();
-                                           //extractPrefix(result);
-                                           //fprintf(stderr, "===%s\n", (const char*)result);
-  					   current->type = result;
-                                           yy_push_state(SubprogPrefix);
-                                       }          
+<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{TYPE_SPEC}{BS}/{SUBPROG}{BS_} {
+                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
+                                         {
+                                           addInterface(yytext, ifType);
+                                           startScope(last_entry);
+                                         }
+
+                                         // TYPE_SPEC is for old function style function result
+                                         result = QCString(yytext).stripWhiteSpace();
+                                         current->type = result;
+                                         yy_push_state(SubprogPrefix);
+                                       }
 
 <SubprogPrefix>{BS}{SUBPROG}{BS_}     {
                                          // Fortran subroutine or function found
@@ -710,20 +739,30 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
 
 <Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} {
                                          // Fortran subroutine or function found
-                                         result= yytext;
-                                         result= result.stripWhiteSpace();
-                                         //extractPrefix(result);
+                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
+                                         {
+                                           addInterface("$interface$", ifType);
+                                           startScope(last_entry);
+                                         }
+
+                                         result = QCString(yytext).stripWhiteSpace();
                                          addSubprogram(result);
                                          yy_push_state(Subprog);
                                        }
 
 <Subprog>{BS}                          {   /* ignore white space */   }
-<Subprog>{ID}                          {   current->name = yytext;
-					   //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;
-					   modifiers[current_root][current->name.lower()].returnName = current->name;
-					   BEGIN(Parameterlist);
-                                       } 
-<Parameterlist>{ARGS}                  {   
+<Subprog>{ID}                          { current->name = yytext;
+                                         //cout << "1a==========> got " << current->type << " " << yytext << " " << yyLineNr << endl;
+                                         modifiers[current_root][current->name.lower()].returnName = current->name;
+
+                                         if (ifType == IF_ABSTRACT || ifType == IF_SPECIFIC)
+                                         {
+                                           current_root->name.replace(QRegExp("\\$interface\\$"), yytext);
+                                         }
+
+                                         BEGIN(Parameterlist);
+                                       }
+<Parameterlist>{ARGS}                  {
 				           //current->type not yet available
                                            QCString arglist= yytext;
 					   //cout << "3=========> got parameterlist " << yytext << endl;
@@ -735,6 +774,7 @@ PREFIX    (RECURSIVE{BS_}|PURE{BS_}|ELEMENTAL{BS_}){0,2}(RECURSIVE|PURE|ELEMENTA
 					   current->args = removeRedundantWhiteSpace(current->args);
 					   stringToArgumentList(current->args, current->argList);
                                            addCurrentEntry();
+
 					   startScope(last_entry);
 					   BEGIN(SubprogBody);
  				       } 
@@ -1168,6 +1208,9 @@ SymbolModifiers& SymbolModifiers::operator|=(const SymbolModifiers &mdfs)
   pointer |= mdfs.pointer;
   target |= mdfs.target;
   save |= mdfs.save;
+  nopass |= mdfs.nopass;
+  pass |= mdfs.pass;
+  passVar = mdfs.passVar;
   return *this;
 }
 
@@ -1230,6 +1273,15 @@ SymbolModifiers& SymbolModifiers::operator|=(QCString mdfString)
   {
     newMdf.save = TRUE;
   }
+  else if (mdfString=="nopass")
+  {
+    newMdf.nopass = TRUE;
+  }
+  else if (mdfString.contains("pass"))
+  {
+    newMdf.pass = TRUE;
+    newMdf.passVar = extractFromParens(mdfString);
+  }
 
   (*this) |= newMdf;
   return *this;
@@ -1336,6 +1388,16 @@ static QCString applyModifiers(QCString typeName, SymbolModifiers& mdfs)
     typeName += ",";
     typeName += "save";
   }
+  if (mdfs.nopass) 
+  {
+    typeName += ",";
+    typeName += "nopass";
+  }
+  if (mdfs.pass) 
+  {
+    typeName += ",";
+    typeName += "pass(" + mdfs.passVar + ")";
+  }
   if (mdfs.protection == SymbolModifiers::PUBLIC)
   {
     typeName += ",";
@@ -1570,23 +1632,40 @@ static void addSubprogram(const char *text)
  * \note Code was brought to this procedure from the parser,
  * because there was/is idea to use it in several parts of the parser.
  */ 
-static void addInterface(QCString name) 
+static void addInterface(QCString name, InterfaceType type)
 {
+  if (YY_START == Start)
+  {
+    addModule(NULL);
+    yy_push_state(ModuleBody); //anon program
+  }
+
   current->section = Entry::CLASS_SEC; // was Entry::INTERFACE_SEC;
   current->spec = Entry::Interface;
   current->name = name;
 
+  switch (type)
+  {
+    case IF_ABSTRACT:
+      current->type = "abstract";
+      break;
+
+    case IF_GENERIC:
+      current->type = "generic";
+      break;
+
+    case IF_SPECIFIC:
+    case IF_NONE:
+    default:
+      current->type = "";
+  }
+
   /* if type is part of a module, mod name is necessary for output */
   if ((current_root) && 
       (current_root->section ==  Entry::CLASS_SEC ||
        current_root->section ==  Entry::NAMESPACE_SEC)) 
   {
-    current->name= current_root->name+"::"+current->name;
-  }
-  if ((current_root) &&
-      (current_root->section ==  Entry::FUNCTION_SEC)) 
-  {
-    current->name = getFullName(current_root) + "__" + QCString(current->name);
+    current->name= current_root->name + "::" + current->name;
   }
 
   current->fileName = yyFileName;