Update to RDoc r56
[rbx.git] / lib / rdoc / parser / f95.rb
blob6312bbaaff6ba9de89f45c13d11186a1452d4a3c
1 require 'rdoc/parser'
3 ##
4 # = Fortran95 RDoc Parser
6 # == Overview
8 # This parser parses Fortran95 files with suffixes "f90", "F90", "f95" and
9 # "F95". Fortran95 files are expected to be conformed to Fortran95 standards.
11 # == Rules
13 # Fundamental rules are same as that of the Ruby parser.  But comment markers
14 # are '!' not '#'.
16 # === Correspondence between RDoc documentation and Fortran95 programs
18 # F95 parses main programs, modules, subroutines, functions, derived-types,
19 # public variables, public constants, defined operators and defined
20 # assignments.  These components are described in items of RDoc documentation,
21 # as follows.
23 # Files :: Files (same as Ruby)
24 # Classes:: Modules
25 # Methods:: Subroutines, functions, variables, constants, derived-types,
26 #           defined operators, defined assignments
27 # Required files:: Files in which imported modules, external subroutines and
28 #                  external functions are defined.
29 # Included Modules:: List of imported modules
30 # Attributes:: List of derived-types, List of imported modules all of whose
31 #              components are published again
33 # Components listed in 'Methods' (subroutines, functions, ...) defined in
34 # modules are described in the item of 'Classes'.  On the other hand,
35 # components defined in main programs or as external procedures are described
36 # in the item of 'Files'.
38 # === Components parsed by default
40 # By default, documentation on public components (subroutines, functions,
41 # variables, constants, derived-types, defined operators, defined assignments)
42 # are generated.
44 # With "--all" option, documentation on all components are generated (almost
45 # same as the Ruby parser).
47 # === Information parsed automatically
49 # The following information is automatically parsed.
51 # * Types of arguments
52 # * Types of variables and constants
53 # * Types of variables in the derived types, and initial values
54 # * NAMELISTs and types of variables in them, and initial values
56 # Aliases by interface statement are described in the item of 'Methods'.
58 # Components which are imported from other modules and published again are
59 # described in the item of 'Methods'.
61 # === Format of comment blocks
63 # Comment blocks should be written as follows.
65 # Comment blocks are considered to be ended when the line without '!' appears.
67 # The indentation is not necessary.
69 #   ! (Top of file)
70 #   !
71 #   ! Comment blocks for the files.
72 #   !
73 #   !--
74 #   ! The comment described in the part enclosed by
75 #   ! "!--" and "!++" is ignored.
76 #   !++
77 #   !
78 #   module hogehoge
79 #     !
80 #     ! Comment blocks for the modules (or the programs).
81 #     !
82 #   
83 #     private
84 #   
85 #     logical            :: a     ! a private variable
86 #     real, public       :: b     ! a public variable
87 #     integer, parameter :: c = 0 ! a public constant
88 #   
89 #     public :: c
90 #     public :: MULTI_ARRAY
91 #     public :: hoge, foo
92 #   
93 #     type MULTI_ARRAY
94 #       !
95 #       ! Comment blocks for the derived-types.
96 #       !
97 #       real, pointer :: var(:) =>null() ! Comments block for the variables.
98 #       integer       :: num = 0
99 #     end type MULTI_ARRAY
100 #   
101 #   contains
102 #   
103 #     subroutine hoge( in,   &   ! Comment blocks between continuation lines are ignored.
104 #         &            out )
105 #       !
106 #       ! Comment blocks for the subroutines or functions
107 #       !
108 #       character(*),intent(in):: in ! Comment blocks for the arguments.
109 #       character(*),intent(out),allocatable,target  :: in
110 #                                    ! Comment blocks can be
111 #                                    ! written under Fortran statements.
112 #   
113 #       character(32) :: file ! This comment parsed as a variable in below NAMELIST.
114 #       integer       :: id
115 #   
116 #       namelist /varinfo_nml/ file, id
117 #               !
118 #               ! Comment blocks for the NAMELISTs.
119 #               ! Information about variables are described above.
120 #               !
121 #   
122 #     ....
123 #   
124 #     end subroutine hoge
125 #   
126 #     integer function foo( in )
127 #       !
128 #       ! This part is considered as comment block.
129 #   
130 #       ! Comment blocks under blank lines are ignored.
131 #       !
132 #       integer, intent(in):: inA ! This part is considered as comment block.
133 #   
134 #                                 ! This part is ignored.
135 #   
136 #     end function foo
137 #   
138 #     subroutine hide( in,   &
139 #       &              out )      !:nodoc:
140 #       !
141 #       ! If "!:nodoc:" is described at end-of-line in subroutine
142 #       ! statement as above, the subroutine is ignored.
143 #       ! This assignment can be used to modules, subroutines,
144 #       ! functions, variables, constants, derived-types,
145 #       ! defined operators, defined assignments,
146 #       ! list of imported modules ("use" statement).
147 #       !
148 #   
149 #     ....
150 #   
151 #     end subroutine hide
152 #   
153 #   end module hogehoge
155 class RDoc::Parser::F95 < RDoc::Parser
157   parse_files_matching(/\.((f|F)9(0|5)|F)$/)
159   class Token
161     NO_TEXT = "??".freeze
163     def initialize(line_no, char_no)
164       @line_no = line_no
165       @char_no = char_no
166       @text    = NO_TEXT
167     end
168     # Because we're used in contexts that expect to return a token,
169     # we set the text string and then return ourselves
170     def set_text(text)
171       @text = text
172       self
173     end
175     attr_reader :line_no, :char_no, :text
177   end
179   @@external_aliases = []
180   @@public_methods   = []
182   ##
183   # "false":: Comments are below source code
184   # "true" :: Comments are upper source code
186   COMMENTS_ARE_UPPER  = false
188   ##
189   # Internal alias message
191   INTERNAL_ALIAS_MES = "Alias for"
193   ##
194   # External alias message
196   EXTERNAL_ALIAS_MES = "The entity is"
198   ##
199   # Define code constructs
201   def scan
202     # remove private comment
203     remaining_code = remove_private_comments(@content)
205     # continuation lines are united to one line
206     remaining_code = united_to_one_line(remaining_code)
208     # semicolons are replaced to line feed
209     remaining_code = semicolon_to_linefeed(remaining_code)
211     # collect comment for file entity
212     whole_comment, remaining_code = collect_first_comment(remaining_code)
213     @top_level.comment = whole_comment
215     # String "remaining_code" is converted to Array "remaining_lines"
216     remaining_lines = remaining_code.split("\n")
218     # "module" or "program" parts are parsed (new)
219     #
220     level_depth = 0
221     block_searching_flag = nil
222     block_searching_lines = []
223     pre_comment = []
224     module_program_trailing = ""
225     module_program_name = ""
226     other_block_level_depth = 0
227     other_block_searching_flag = nil
228     remaining_lines.collect!{|line|
229       if !block_searching_flag && !other_block_searching_flag
230         if line =~ /^\s*?module\s+(\w+)\s*?(!.*?)?$/i
231           block_searching_flag = :module
232           block_searching_lines << line
233           module_program_name = $1
234           module_program_trailing = find_comments($2)
235           next false
236         elsif line =~ /^\s*?program\s+(\w+)\s*?(!.*?)?$/i ||
237                line =~ /^\s*?\w/ && !block_start?(line)
238           block_searching_flag = :program
239           block_searching_lines << line
240           module_program_name = $1 || ""
241           module_program_trailing = find_comments($2)
242           next false
244         elsif block_start?(line)
245           other_block_searching_flag = true
246           next line
248         elsif line =~ /^\s*?!\s?(.*)/
249           pre_comment << line
250           next line
251         else
252           pre_comment = []
253           next line
254         end
255       elsif other_block_searching_flag
256         other_block_level_depth += 1 if block_start?(line)
257         other_block_level_depth -= 1 if block_end?(line)
258         if other_block_level_depth < 0
259           other_block_level_depth = 0
260           other_block_searching_flag = nil
261         end
262         next line
263       end
265       block_searching_lines << line
266       level_depth += 1 if block_start?(line)
267       level_depth -= 1 if block_end?(line)
268       if level_depth >= 0
269         next false
270       end
272       # "module_program_code" is formatted.
273       # ":nodoc:" flag is checked.
274       #
275       module_program_code = block_searching_lines.join("\n")
276       module_program_code = remove_empty_head_lines(module_program_code)
277       if module_program_trailing =~ /^:nodoc:/
278         # next loop to search next block
279         level_depth = 0
280         block_searching_flag = false
281         block_searching_lines = []
282         pre_comment = []
283         next false
284       end
286       # NormalClass is created, and added to @top_level
287       #
288       if block_searching_flag == :module
289         module_name = module_program_name
290         module_code = module_program_code
291         module_trailing = module_program_trailing
292         progress "m"
293         @stats.num_modules += 1
294         f9x_module = @top_level.add_module NormalClass, module_name
295         f9x_module.record_location @top_level
297         f9x_comment = COMMENTS_ARE_UPPER ? 
298           find_comments(pre_comment.join("\n"))  + "\n" + module_trailing :
299             module_trailing + "\n" + find_comments(module_code.sub(/^.*$\n/i, ''))
300         f9x_module.comment = f9x_comment
301         parse_program_or_module(f9x_module, module_code)
303         TopLevel.all_files.each do |name, toplevel|
304           if toplevel.include_includes?(module_name, @options.ignore_case)
305             if !toplevel.include_requires?(@file_name, @options.ignore_case)
306               toplevel.add_require(Require.new(@file_name, ""))
307             end
308           end
309           toplevel.each_classmodule{|m|
310             if m.include_includes?(module_name, @options.ignore_case)
311               if !m.include_requires?(@file_name, @options.ignore_case)
312                 m.add_require(Require.new(@file_name, ""))
313               end
314             end
315           }
316         end
317       elsif block_searching_flag == :program
318         program_name = module_program_name
319         program_code = module_program_code
320         program_trailing = module_program_trailing
321         progress "p"
322         program_comment = COMMENTS_ARE_UPPER ? 
323           find_comments(pre_comment.join("\n")) + "\n" + program_trailing : 
324             program_trailing + "\n" + find_comments(program_code.sub(/^.*$\n/i, ''))
325         program_comment = "\n\n= <i>Program</i> <tt>#{program_name}</tt>\n\n" \
326                           + program_comment
327         @top_level.comment << program_comment
328         parse_program_or_module(@top_level, program_code, :private)
329       end
331       # next loop to search next block
332       level_depth = 0
333       block_searching_flag = false
334       block_searching_lines = []
335       pre_comment = []
336       next false
337     }
339     remaining_lines.delete_if{ |line|
340       line == false
341     }
343     # External subprograms and functions are parsed
344     #
345     parse_program_or_module(@top_level, remaining_lines.join("\n"),
346                             :public, true)
348     @top_level
349   end  # End of scan
351   private
353   def parse_program_or_module(container, code,
354                               visibility=:public, external=nil)
355     return unless container
356     return unless code
357     remaining_lines = code.split("\n")
358     remaining_code = "#{code}"
360     #
361     # Parse variables before "contains" in module
362     #
363     level_depth = 0
364     before_contains_lines = []
365     before_contains_code = nil
366     before_contains_flag = nil
367     remaining_lines.each{ |line|
368       if !before_contains_flag
369         if line =~ /^\s*?module\s+\w+\s*?(!.*?)?$/i
370           before_contains_flag = true
371         end
372       else
373         break if line =~ /^\s*?contains\s*?(!.*?)?$/i
374         level_depth += 1 if block_start?(line)
375         level_depth -= 1 if block_end?(line)
376         break if level_depth < 0
377         before_contains_lines << line
378       end
379     }
380     before_contains_code = before_contains_lines.join("\n")
381     if before_contains_code
382       before_contains_code.gsub!(/^\s*?interface\s+.*?\s+end\s+interface.*?$/im, "")
383       before_contains_code.gsub!(/^\s*?type[\s\,]+.*?\s+end\s+type.*?$/im, "")
384     end
386     #
387     # Parse global "use"
388     #
389     use_check_code = "#{before_contains_code}"
390     cascaded_modules_list = []
391     while use_check_code =~ /^\s*?use\s+(\w+)(.*?)(!.*?)?$/i
392       use_check_code = $~.pre_match
393       use_check_code << $~.post_match
394       used_mod_name = $1.strip.chomp
395       used_list = $2 || ""
396       used_trailing = $3 || ""
397       next if used_trailing =~ /!:nodoc:/
398       if !container.include_includes?(used_mod_name, @options.ignore_case)
399         progress "."
400         container.add_include Include.new(used_mod_name, "")
401       end
402       if ! (used_list =~ /\,\s*?only\s*?:/i )
403         cascaded_modules_list << "\#" + used_mod_name
404       end
405     end
407     #
408     # Parse public and private, and store information.
409     # This information is used when "add_method" and
410     # "set_visibility_for" are called.
411     #
412     visibility_default, visibility_info = 
413               parse_visibility(remaining_lines.join("\n"), visibility, container)
414     @@public_methods.concat visibility_info
415     if visibility_default == :public
416       if !cascaded_modules_list.empty?
417         cascaded_modules = 
418           Attr.new("Cascaded Modules",
419                    "Imported modules all of whose components are published again",
420                    "",
421                    cascaded_modules_list.join(", "))
422         container.add_attribute(cascaded_modules)
423       end
424     end
426     #
427     # Check rename elements
428     #
429     use_check_code = "#{before_contains_code}"
430     while use_check_code =~ /^\s*?use\s+(\w+)\s*?\,(.+)$/i
431       use_check_code = $~.pre_match
432       use_check_code << $~.post_match
433       used_mod_name = $1.strip.chomp
434       used_elements = $2.sub(/\s*?only\s*?:\s*?/i, '')
435       used_elements.split(",").each{ |used|
436         if /\s*?(\w+)\s*?=>\s*?(\w+)\s*?/ =~ used
437           local = $1
438           org = $2
439           @@public_methods.collect!{ |pub_meth|
440             if local == pub_meth["name"] ||
441                 local.upcase == pub_meth["name"].upcase &&
442                 @options.ignore_case
443               pub_meth["name"] = org
444               pub_meth["local_name"] = local
445             end
446             pub_meth
447           }
448         end
449       }
450     end
452     #
453     # Parse private "use"
454     #
455     use_check_code = remaining_lines.join("\n")
456     while use_check_code =~ /^\s*?use\s+(\w+)(.*?)(!.*?)?$/i
457       use_check_code = $~.pre_match
458       use_check_code << $~.post_match
459       used_mod_name = $1.strip.chomp
460       used_trailing = $3 || ""
461       next if used_trailing =~ /!:nodoc:/
462       if !container.include_includes?(used_mod_name, @options.ignore_case)
463         progress "."
464         container.add_include Include.new(used_mod_name, "")
465       end
466     end
468     container.each_includes{ |inc|
469       TopLevel.all_files.each do |name, toplevel|
470         indicated_mod = toplevel.find_symbol(inc.name,
471                                              nil, @options.ignore_case)
472         if indicated_mod
473           indicated_name = indicated_mod.parent.file_relative_name
474           if !container.include_requires?(indicated_name, @options.ignore_case)
475             container.add_require(Require.new(indicated_name, ""))
476           end
477           break
478         end
479       end
480     }
482     #
483     # Parse derived-types definitions
484     #
485     derived_types_comment = ""
486     remaining_code = remaining_lines.join("\n")
487     while remaining_code =~ /^\s*?
488                                   type[\s\,]+(public|private)?\s*?(::)?\s*?
489                                   (\w+)\s*?(!.*?)?$
490                                   (.*?)
491                                   ^\s*?end\s+type.*?$
492                             /imx
493       remaining_code = $~.pre_match
494       remaining_code << $~.post_match
495       typename = $3.chomp.strip
496       type_elements = $5 || ""
497       type_code = remove_empty_head_lines($&)
498       type_trailing = find_comments($4)
499       next if type_trailing =~ /^:nodoc:/
500       type_visibility = $1
501       type_comment = COMMENTS_ARE_UPPER ? 
502         find_comments($~.pre_match) + "\n" + type_trailing :
503           type_trailing + "\n" + find_comments(type_code.sub(/^.*$\n/i, ''))
504       type_element_visibility_public = true
505       type_code.split("\n").each{ |line|
506         if /^\s*?private\s*?$/ =~ line
507           type_element_visibility_public = nil
508           break
509         end
510       } if type_code
512       args_comment = ""
513       type_args_info = nil
515       if @options.show_all
516         args_comment = find_arguments(nil, type_code, true)
517       else
518         type_public_args_list = []
519         type_args_info = definition_info(type_code)
520         type_args_info.each{ |arg|
521           arg_is_public = type_element_visibility_public
522           arg_is_public = true if arg.include_attr?("public")
523           arg_is_public = nil if arg.include_attr?("private")
524           type_public_args_list << arg.varname if arg_is_public
525         }
526         args_comment = find_arguments(type_public_args_list, type_code)
527       end
529       type = AnyMethod.new("type #{typename}", typename)
530       type.singleton = false
531       type.params = ""
532       type.comment = "<b><em> Derived Type </em></b> :: <tt></tt>\n"
533       type.comment << args_comment if args_comment
534       type.comment << type_comment if type_comment
535       progress "t"
536       @stats.num_methods += 1
537       container.add_method type
539       set_visibility(container, typename, visibility_default, @@public_methods)
541       if type_visibility
542         type_visibility.gsub!(/\s/,'')
543         type_visibility.gsub!(/\,/,'')
544         type_visibility.gsub!(/:/,'')
545         type_visibility.downcase!
546         if type_visibility == "public"
547           container.set_visibility_for([typename], :public)
548         elsif type_visibility == "private"
549           container.set_visibility_for([typename], :private)
550         end
551       end
553       check_public_methods(type, container.name)
555       if @options.show_all
556         derived_types_comment << ", " unless derived_types_comment.empty?
557         derived_types_comment << typename
558       else
559         if type.visibility == :public
560         derived_types_comment << ", " unless derived_types_comment.empty?
561         derived_types_comment << typename
562         end
563       end
565     end
567     if !derived_types_comment.empty?
568       derived_types_table = 
569         Attr.new("Derived Types", "Derived_Types", "", 
570                  derived_types_comment)
571       container.add_attribute(derived_types_table)
572     end
574     #
575     # move interface scope
576     #
577     interface_code = ""
578     while remaining_code =~ /^\s*?
579                                  interface(
580                                             \s+\w+                      |
581                                             \s+operator\s*?\(.*?\)       |
582                                             \s+assignment\s*?\(\s*?=\s*?\)
583                                           )?\s*?$
584                                  (.*?)
585                                  ^\s*?end\s+interface.*?$
586                             /imx
587       interface_code << remove_empty_head_lines($&) + "\n"
588       remaining_code = $~.pre_match
589       remaining_code << $~.post_match
590     end
592     #
593     # Parse global constants or variables in modules
594     #
595     const_var_defs = definition_info(before_contains_code)
596     const_var_defs.each{|defitem|
597       next if defitem.nodoc
598       const_or_var_type = "Variable"
599       const_or_var_progress = "v"
600       if defitem.include_attr?("parameter")
601         const_or_var_type = "Constant"
602         const_or_var_progress = "c"
603       end
604       const_or_var = AnyMethod.new(const_or_var_type, defitem.varname)
605       const_or_var.singleton = false
606       const_or_var.params = ""
607       self_comment = find_arguments([defitem.varname], before_contains_code)
608       const_or_var.comment = "<b><em>" + const_or_var_type + "</em></b> :: <tt></tt>\n"
609       const_or_var.comment << self_comment if self_comment
610       progress const_or_var_progress
611       @stats.num_methods += 1
612       container.add_method const_or_var
614       set_visibility(container, defitem.varname, visibility_default, @@public_methods)
616       if defitem.include_attr?("public")
617         container.set_visibility_for([defitem.varname], :public)
618       elsif defitem.include_attr?("private")
619         container.set_visibility_for([defitem.varname], :private)
620       end
622       check_public_methods(const_or_var, container.name)
624     } if const_var_defs
626     remaining_lines = remaining_code.split("\n")
628     # "subroutine" or "function" parts are parsed (new)
629     #
630     level_depth = 0
631     block_searching_flag = nil
632     block_searching_lines = []
633     pre_comment = []
634     procedure_trailing = ""
635     procedure_name = ""
636     procedure_params = ""
637     procedure_prefix = ""
638     procedure_result_arg = ""
639     procedure_type = ""
640     contains_lines = []
641     contains_flag = nil
642     remaining_lines.collect!{|line|
643       if !block_searching_flag
644         # subroutine
645         if line =~ /^\s*?
646                          (recursive|pure|elemental)?\s*?
647                          subroutine\s+(\w+)\s*?(\(.*?\))?\s*?(!.*?)?$
648                    /ix
649           block_searching_flag = :subroutine
650           block_searching_lines << line
652           procedure_name = $2.chomp.strip
653           procedure_params = $3 || ""
654           procedure_prefix = $1 || ""
655           procedure_trailing = $4 || "!"
656           next false
658         # function
659         elsif line =~ /^\s*?
660                        (recursive|pure|elemental)?\s*?
661                        (
662                            character\s*?(\([\w\s\=\(\)\*]+?\))?\s+
663                          | type\s*?\([\w\s]+?\)\s+
664                          | integer\s*?(\([\w\s\=\(\)\*]+?\))?\s+
665                          | real\s*?(\([\w\s\=\(\)\*]+?\))?\s+
666                          | double\s+precision\s+
667                          | logical\s*?(\([\w\s\=\(\)\*]+?\))?\s+
668                          | complex\s*?(\([\w\s\=\(\)\*]+?\))?\s+
669                        )?
670                        function\s+(\w+)\s*?
671                        (\(.*?\))?(\s+result\((.*?)\))?\s*?(!.*?)?$
672                       /ix
673           block_searching_flag = :function
674           block_searching_lines << line
676           procedure_prefix = $1 || ""
677           procedure_type = $2 ? $2.chomp.strip : nil
678           procedure_name = $8.chomp.strip
679           procedure_params = $9 || ""
680           procedure_result_arg = $11 ? $11.chomp.strip : procedure_name
681           procedure_trailing = $12 || "!"
682           next false
683         elsif line =~ /^\s*?!\s?(.*)/
684           pre_comment << line
685           next line
686         else
687           pre_comment = []
688           next line
689         end
690       end
691       contains_flag = true if line =~ /^\s*?contains\s*?(!.*?)?$/
692       block_searching_lines << line
693       contains_lines << line if contains_flag
695       level_depth += 1 if block_start?(line)
696       level_depth -= 1 if block_end?(line)
697       if level_depth >= 0
698         next false
699       end
701       # "procedure_code" is formatted.
702       # ":nodoc:" flag is checked.
703       #
704       procedure_code = block_searching_lines.join("\n")
705       procedure_code = remove_empty_head_lines(procedure_code)
706       if procedure_trailing =~ /^!:nodoc:/
707         # next loop to search next block
708         level_depth = 0
709         block_searching_flag = nil
710         block_searching_lines = []
711         pre_comment = []
712         procedure_trailing = ""
713         procedure_name = ""
714         procedure_params = ""
715         procedure_prefix = ""
716         procedure_result_arg = ""
717         procedure_type = ""
718         contains_lines = []
719         contains_flag = nil
720         next false
721       end
723       # AnyMethod is created, and added to container
724       #
725       subroutine_function = nil
726       if block_searching_flag == :subroutine
727         subroutine_prefix   = procedure_prefix
728         subroutine_name     = procedure_name
729         subroutine_params   = procedure_params
730         subroutine_trailing = procedure_trailing
731         subroutine_code     = procedure_code
733         subroutine_comment = COMMENTS_ARE_UPPER ? 
734           pre_comment.join("\n") + "\n" + subroutine_trailing : 
735             subroutine_trailing + "\n" + subroutine_code.sub(/^.*$\n/i, '')
736         subroutine = AnyMethod.new("subroutine", subroutine_name)
737         parse_subprogram(subroutine, subroutine_params,
738                          subroutine_comment, subroutine_code,
739                          before_contains_code, nil, subroutine_prefix)
740         progress "s"
741         @stats.num_methods += 1
742         container.add_method subroutine
743         subroutine_function = subroutine
745       elsif block_searching_flag == :function
746         function_prefix     = procedure_prefix
747         function_type       = procedure_type
748         function_name       = procedure_name
749         function_params_org = procedure_params
750         function_result_arg = procedure_result_arg
751         function_trailing   = procedure_trailing
752         function_code_org   = procedure_code
754         function_comment = COMMENTS_ARE_UPPER ?
755           pre_comment.join("\n") + "\n" + function_trailing :
756             function_trailing + "\n " + function_code_org.sub(/^.*$\n/i, '')
758         function_code = "#{function_code_org}"
759         if function_type
760           function_code << "\n" + function_type + " :: " + function_result_arg
761         end
763         function_params =
764           function_params_org.sub(/^\(/, "\(#{function_result_arg}, ")
766         function = AnyMethod.new("function", function_name)
767         parse_subprogram(function, function_params,
768                          function_comment, function_code,
769                          before_contains_code, true, function_prefix)
771         # Specific modification due to function
772         function.params.sub!(/\(\s*?#{function_result_arg}\s*?,\s*?/, "\( ")
773         function.params << " result(" + function_result_arg + ")"
774         function.start_collecting_tokens
775         function.add_token Token.new(1,1).set_text(function_code_org)
777         progress "f"
778         @stats.num_methods += 1
779         container.add_method function
780         subroutine_function = function
782       end
784       # The visibility of procedure is specified
785       #
786       set_visibility(container, procedure_name, 
787                      visibility_default, @@public_methods)
789       # The alias for this procedure from external modules
790       #
791       check_external_aliases(procedure_name,
792                              subroutine_function.params,
793                              subroutine_function.comment, subroutine_function) if external
794       check_public_methods(subroutine_function, container.name)
797       # contains_lines are parsed as private procedures
798       if contains_flag
799         parse_program_or_module(container,
800                                 contains_lines.join("\n"), :private)
801       end
803       # next loop to search next block
804       level_depth = 0
805       block_searching_flag = nil
806       block_searching_lines = []
807       pre_comment = []
808       procedure_trailing = ""
809       procedure_name = ""
810       procedure_params = ""
811       procedure_prefix = ""
812       procedure_result_arg = ""
813       contains_lines = []
814       contains_flag = nil
815       next false
816     } # End of remaining_lines.collect!{|line|
818     # Array remains_lines is converted to String remains_code again
819     #
820     remaining_code = remaining_lines.join("\n")
822     #
823     # Parse interface
824     #
825     interface_scope = false
826     generic_name = ""
827     interface_code.split("\n").each{ |line|
828       if /^\s*?
829                interface(
830                           \s+\w+|
831                           \s+operator\s*?\(.*?\)|
832                           \s+assignment\s*?\(\s*?=\s*?\)
833                         )?
834                \s*?(!.*?)?$
835          /ix =~ line
836         generic_name = $1 ? $1.strip.chomp : nil
837         interface_trailing = $2 || "!"
838         interface_scope = true
839         interface_scope = false if interface_trailing =~ /!:nodoc:/
840 #        if generic_name =~ /operator\s*?\((.*?)\)/i
841 #          operator_name = $1
842 #          if operator_name && !operator_name.empty?
843 #            generic_name = "#{operator_name}"
844 #          end
845 #        end
846 #        if generic_name =~ /assignment\s*?\((.*?)\)/i
847 #          assignment_name = $1
848 #          if assignment_name && !assignment_name.empty?
849 #            generic_name = "#{assignment_name}"
850 #          end
851 #        end
852       end
853       if /^\s*?end\s+interface/i =~ line
854         interface_scope = false
855         generic_name = nil
856       end
857       # internal alias
858       if interface_scope && /^\s*?module\s+procedure\s+(.*?)(!.*?)?$/i =~ line
859         procedures = $1.strip.chomp
860         procedures_trailing = $2 || "!"
861         next if procedures_trailing =~ /!:nodoc:/
862         procedures.split(",").each{ |proc|
863           proc.strip!
864           proc.chomp!
865           next if generic_name == proc || !generic_name
866           old_meth = container.find_symbol(proc, nil, @options.ignore_case)
867           next if !old_meth
868           nolink = old_meth.visibility == :private ? true : nil
869           nolink = nil if @options.show_all
870           new_meth = 
871              initialize_external_method(generic_name, proc, 
872                                         old_meth.params, nil, 
873                                         old_meth.comment, 
874                                         old_meth.clone.token_stream[0].text, 
875                                         true, nolink)
876           new_meth.singleton = old_meth.singleton
878           progress "i"
879           @stats.num_methods += 1
880           container.add_method new_meth
882           set_visibility(container, generic_name, visibility_default, @@public_methods)
884           check_public_methods(new_meth, container.name)
886         }
887       end
889       # external aliases
890       if interface_scope
891         # subroutine
892         proc = nil
893         params = nil
894         procedures_trailing = nil
895         if line =~ /^\s*?
896                          (recursive|pure|elemental)?\s*?
897                          subroutine\s+(\w+)\s*?(\(.*?\))?\s*?(!.*?)?$
898                    /ix
899           proc = $2.chomp.strip
900           generic_name = proc unless generic_name
901           params = $3 || ""
902           procedures_trailing = $4 || "!"
904         # function
905         elsif line =~ /^\s*?
906                        (recursive|pure|elemental)?\s*?
907                        (
908                            character\s*?(\([\w\s\=\(\)\*]+?\))?\s+
909                          | type\s*?\([\w\s]+?\)\s+
910                          | integer\s*?(\([\w\s\=\(\)\*]+?\))?\s+
911                          | real\s*?(\([\w\s\=\(\)\*]+?\))?\s+
912                          | double\s+precision\s+
913                          | logical\s*?(\([\w\s\=\(\)\*]+?\))?\s+
914                          | complex\s*?(\([\w\s\=\(\)\*]+?\))?\s+
915                        )?
916                        function\s+(\w+)\s*?
917                        (\(.*?\))?(\s+result\((.*?)\))?\s*?(!.*?)?$
918                       /ix
919           proc = $8.chomp.strip
920           generic_name = proc unless generic_name
921           params = $9 || ""
922           procedures_trailing = $12 || "!"
923         else
924           next
925         end
926         next if procedures_trailing =~ /!:nodoc:/
927         indicated_method = nil
928         indicated_file   = nil
929         TopLevel.all_files.each do |name, toplevel|
930           indicated_method = toplevel.find_local_symbol(proc, @options.ignore_case)
931           indicated_file = name
932           break if indicated_method
933         end
935         if indicated_method
936           external_method = 
937             initialize_external_method(generic_name, proc, 
938                                        indicated_method.params, 
939                                        indicated_file, 
940                                        indicated_method.comment)
942           progress "e"
943           @stats.num_methods += 1
944           container.add_method external_method
945           set_visibility(container, generic_name, visibility_default, @@public_methods)
946           if !container.include_requires?(indicated_file, @options.ignore_case)
947             container.add_require(Require.new(indicated_file, ""))
948           end
949           check_public_methods(external_method, container.name)
951         else
952           @@external_aliases << {
953             "new_name"  => generic_name,
954             "old_name"  => proc,
955             "file_or_module" => container,
956             "visibility" => find_visibility(container, generic_name, @@public_methods) || visibility_default
957           }
958         end
959       end
961     } if interface_code # End of interface_code.split("\n").each ...
963     #
964     # Already imported methods are removed from @@public_methods.
965     # Remainders are assumed to be imported from other modules.
966     #
967     @@public_methods.delete_if{ |method| method["entity_is_discovered"]}
969     @@public_methods.each{ |pub_meth|
970       next unless pub_meth["file_or_module"].name == container.name
971       pub_meth["used_modules"].each{ |used_mod|
972         TopLevel.all_classes_and_modules.each{ |modules|
973           if modules.name == used_mod ||
974               modules.name.upcase == used_mod.upcase &&
975               @options.ignore_case
976             modules.method_list.each{ |meth|
977               if meth.name == pub_meth["name"] ||
978                   meth.name.upcase == pub_meth["name"].upcase &&
979                   @options.ignore_case
980                 new_meth = initialize_public_method(meth,
981                                                     modules.name)
982                 if pub_meth["local_name"]
983                   new_meth.name = pub_meth["local_name"]
984                 end
985                 progress "e"
986                 @stats.num_methods += 1
987                 container.add_method new_meth
988               end
989             }
990           end
991         }
992       }
993     }
995     container
996   end  # End of parse_program_or_module
998   ##
999   # Parse arguments, comment, code of subroutine and function.  Return
1000   # AnyMethod object.
1002   def parse_subprogram(subprogram, params, comment, code, 
1003                        before_contains=nil, function=nil, prefix=nil)
1004     subprogram.singleton = false
1005     prefix = "" if !prefix
1006     arguments = params.sub(/\(/, "").sub(/\)/, "").split(",") if params
1007     args_comment, params_opt = 
1008       find_arguments(arguments, code.sub(/^s*?contains\s*?(!.*?)?$.*/im, ""),
1009                      nil, nil, true)
1010     params_opt = "( " + params_opt + " ) " if params_opt
1011     subprogram.params = params_opt || ""
1012     namelist_comment = find_namelists(code, before_contains)
1014     block_comment = find_comments comment
1015     if function
1016       subprogram.comment = "<b><em> Function </em></b> :: <em>#{prefix}</em>\n"
1017     else
1018       subprogram.comment = "<b><em> Subroutine </em></b> :: <em>#{prefix}</em>\n"
1019     end
1020     subprogram.comment << args_comment if args_comment
1021     subprogram.comment << block_comment if block_comment
1022     subprogram.comment << namelist_comment if namelist_comment
1024     # For output source code
1025     subprogram.start_collecting_tokens
1026     subprogram.add_token Token.new(1,1).set_text(code)
1028     subprogram
1029   end
1031   ##
1032   # Collect comment for file entity
1034   def collect_first_comment(body)
1035     comment = ""
1036     not_comment = ""
1037     comment_start = false
1038     comment_end   = false
1039     body.split("\n").each{ |line|
1040       if comment_end
1041         not_comment << line
1042         not_comment << "\n"
1043       elsif /^\s*?!\s?(.*)$/i =~ line
1044         comment_start = true
1045         comment << $1
1046         comment << "\n"
1047       elsif /^\s*?$/i =~ line
1048         comment_end = true if comment_start && COMMENTS_ARE_UPPER
1049       else
1050         comment_end = true
1051         not_comment << line
1052         not_comment << "\n"
1053       end
1054     }
1055     return comment, not_comment
1056   end
1059   ##
1060   # Return comments of definitions of arguments
1061   #
1062   # If "all" argument is true, information of all arguments are returned.
1063   #
1064   # If "modified_params" is true, list of arguments are decorated, for
1065   # example, optional arguments are parenthetic as "[arg]".
1067   def find_arguments(args, text, all=nil, indent=nil, modified_params=nil)
1068     return unless args || all
1069     indent = "" unless indent
1070     args = ["all"] if all
1071     params = "" if modified_params
1072     comma = ""
1073     return unless text
1074     args_rdocforms = "\n"
1075     remaining_lines = "#{text}"
1076     definitions = definition_info(remaining_lines)
1077     args.each{ |arg|
1078       arg.strip!
1079       arg.chomp!
1080       definitions.each { |defitem|
1081         if arg == defitem.varname.strip.chomp || all
1082           args_rdocforms << <<-"EOF"
1084 #{indent}<tt><b>#{defitem.varname.chomp.strip}#{defitem.arraysuffix}</b> #{defitem.inivalue}</tt> :: 
1085 #{indent}   <tt>#{defitem.types.chomp.strip}</tt>
1087           if !defitem.comment.chomp.strip.empty?
1088             comment = ""
1089             defitem.comment.split("\n").each{ |line|
1090               comment << "       " + line + "\n"
1091             }
1092             args_rdocforms << <<-"EOF"
1094 #{indent}   <tt></tt> :: 
1095 #{indent}       <tt></tt>
1096 #{indent}       #{comment.chomp.strip}
1098           end
1100           if modified_params
1101             if defitem.include_attr?("optional")
1102               params << "#{comma}[#{arg}]"
1103             else
1104               params << "#{comma}#{arg}"
1105             end
1106             comma = ", "
1107           end
1108         end
1109       }
1110     }
1111     if modified_params
1112       return args_rdocforms, params
1113     else
1114       return args_rdocforms
1115     end
1116   end
1118   ##
1119   # Return comments of definitions of namelists
1121   def find_namelists(text, before_contains=nil)
1122     return nil if !text
1123     result = ""
1124     lines = "#{text}"
1125     before_contains = "" if !before_contains
1126     while lines =~ /^\s*?namelist\s+\/\s*?(\w+)\s*?\/([\s\w\,]+)$/i
1127       lines = $~.post_match
1128       nml_comment = COMMENTS_ARE_UPPER ? 
1129           find_comments($~.pre_match) : find_comments($~.post_match)
1130       nml_name = $1
1131       nml_args = $2.split(",")
1132       result << "\n\n=== NAMELIST <tt><b>" + nml_name + "</tt></b>\n\n"
1133       result << nml_comment + "\n" if nml_comment
1134       if lines.split("\n")[0] =~ /^\//i
1135         lines = "namelist " + lines
1136       end
1137       result << find_arguments(nml_args, "#{text}" + "\n" + before_contains)
1138     end
1139     return result
1140   end
1142   ##
1143   # Comments just after module or subprogram, or arguments are returned. If
1144   # "COMMENTS_ARE_UPPER" is true, comments just before modules or subprograms
1145   # are returnd
1147   def find_comments text
1148     return "" unless text
1149     lines = text.split("\n")
1150     lines.reverse! if COMMENTS_ARE_UPPER
1151     comment_block = Array.new
1152     lines.each do |line|
1153       break if line =~ /^\s*?\w/ || line =~ /^\s*?$/
1154       if COMMENTS_ARE_UPPER
1155         comment_block.unshift line.sub(/^\s*?!\s?/,"")
1156       else
1157         comment_block.push line.sub(/^\s*?!\s?/,"")
1158       end
1159     end
1160     nice_lines = comment_block.join("\n").split "\n\s*?\n"
1161     nice_lines[0] ||= ""
1162     nice_lines.shift
1163   end
1165   def progress(char)
1166     unless @options.quiet
1167       @progress.print(char)
1168       @progress.flush
1169     end
1170   end
1172   ##
1173   # Create method for internal alias
1175   def initialize_public_method(method, parent)
1176     return if !method || !parent
1178     new_meth = AnyMethod.new("External Alias for module", method.name)
1179     new_meth.singleton    = method.singleton
1180     new_meth.params       = method.params.clone
1181     new_meth.comment      = remove_trailing_alias(method.comment.clone)
1182     new_meth.comment      << "\n\n#{EXTERNAL_ALIAS_MES} #{parent.strip.chomp}\##{method.name}"
1184     return new_meth
1185   end
1187   ##
1188   # Create method for external alias
1189   #
1190   # If argument "internal" is true, file is ignored.
1192   def initialize_external_method(new, old, params, file, comment, token=nil,
1193                                  internal=nil, nolink=nil)
1194     return nil unless new || old
1196     if internal
1197       external_alias_header = "#{INTERNAL_ALIAS_MES} "
1198       external_alias_text   = external_alias_header + old 
1199     elsif file
1200       external_alias_header = "#{EXTERNAL_ALIAS_MES} "
1201       external_alias_text   = external_alias_header + file + "#" + old
1202     else
1203       return nil
1204     end
1205     external_meth = AnyMethod.new(external_alias_text, new)
1206     external_meth.singleton    = false
1207     external_meth.params       = params
1208     external_comment = remove_trailing_alias(comment) + "\n\n" if comment
1209     external_meth.comment = external_comment || ""
1210     if nolink && token
1211       external_meth.start_collecting_tokens
1212       external_meth.add_token Token.new(1,1).set_text(token)
1213     else
1214       external_meth.comment << external_alias_text
1215     end
1217     return external_meth
1218   end
1220   ##
1221   # Parse visibility
1223   def parse_visibility(code, default, container)
1224     result = []
1225     visibility_default = default || :public
1227     used_modules = []
1228     container.includes.each{|i| used_modules << i.name} if container
1230     remaining_code = code.gsub(/^\s*?type[\s\,]+.*?\s+end\s+type.*?$/im, "")
1231     remaining_code.split("\n").each{ |line|
1232       if /^\s*?private\s*?$/ =~ line
1233         visibility_default = :private
1234         break
1235       end
1236     } if remaining_code
1238     remaining_code.split("\n").each{ |line|
1239       if /^\s*?private\s*?(::)?\s+(.*)\s*?(!.*?)?/i =~ line
1240         methods = $2.sub(/!.*$/, '')
1241         methods.split(",").each{ |meth|
1242           meth.sub!(/!.*$/, '')
1243           meth.gsub!(/:/, '')
1244           result << {
1245             "name" => meth.chomp.strip,
1246             "visibility" => :private,
1247             "used_modules" => used_modules.clone,
1248             "file_or_module" => container,
1249             "entity_is_discovered" => nil,
1250             "local_name" => nil
1251           }
1252         }
1253       elsif /^\s*?public\s*?(::)?\s+(.*)\s*?(!.*?)?/i =~ line
1254         methods = $2.sub(/!.*$/, '')
1255         methods.split(",").each{ |meth|
1256           meth.sub!(/!.*$/, '')
1257           meth.gsub!(/:/, '')
1258           result << {
1259             "name" => meth.chomp.strip,
1260             "visibility" => :public,
1261             "used_modules" => used_modules.clone,
1262             "file_or_module" => container,
1263             "entity_is_discovered" => nil,
1264             "local_name" => nil
1265           }
1266         }
1267       end
1268     } if remaining_code
1270     if container
1271       result.each{ |vis_info|
1272         vis_info["parent"] = container.name
1273       }
1274     end
1276     return visibility_default, result
1277   end
1279   ##
1280   # Set visibility
1281   #
1282   # "subname" element of "visibility_info" is deleted.
1284   def set_visibility(container, subname, visibility_default, visibility_info)
1285     return unless container || subname || visibility_default || visibility_info
1286     not_found = true
1287     visibility_info.collect!{ |info|
1288       if info["name"] == subname ||
1289           @options.ignore_case && info["name"].upcase == subname.upcase
1290         if info["file_or_module"].name == container.name
1291           container.set_visibility_for([subname], info["visibility"])
1292           info["entity_is_discovered"] = true
1293           not_found = false
1294         end
1295       end
1296       info
1297     }
1298     if not_found
1299       return container.set_visibility_for([subname], visibility_default)
1300     else
1301       return container
1302     end
1303   end
1305   ##
1306   # Find visibility
1308   def find_visibility(container, subname, visibility_info)
1309     return nil if !subname || !visibility_info
1310     visibility_info.each{ |info|
1311       if info["name"] == subname ||
1312           @options.ignore_case && info["name"].upcase == subname.upcase
1313         if info["parent"] == container.name
1314           return info["visibility"]
1315         end
1316       end
1317     }
1318     return nil
1319   end
1321   ##
1322   # Check external aliases
1324   def check_external_aliases(subname, params, comment, test=nil)
1325     @@external_aliases.each{ |alias_item|
1326       if subname == alias_item["old_name"] ||
1327                   subname.upcase == alias_item["old_name"].upcase &&
1328                           @options.ignore_case
1330         new_meth = initialize_external_method(alias_item["new_name"], 
1331                                               subname, params, @file_name, 
1332                                               comment)
1333         new_meth.visibility = alias_item["visibility"]
1335         progress "e"
1336         @stats.num_methods += 1
1337         alias_item["file_or_module"].add_method(new_meth)
1339         if !alias_item["file_or_module"].include_requires?(@file_name, @options.ignore_case)
1340           alias_item["file_or_module"].add_require(Require.new(@file_name, ""))
1341         end
1342       end
1343     }
1344   end
1346   ##
1347   # Check public_methods
1349   def check_public_methods(method, parent)
1350     return if !method || !parent
1351     @@public_methods.each{ |alias_item|
1352       parent_is_used_module = nil
1353       alias_item["used_modules"].each{ |used_module|
1354         if used_module == parent ||
1355             used_module.upcase == parent.upcase &&
1356             @options.ignore_case
1357           parent_is_used_module = true
1358         end
1359       }
1360       next if !parent_is_used_module
1362       if method.name == alias_item["name"] ||
1363           method.name.upcase == alias_item["name"].upcase &&
1364           @options.ignore_case
1366         new_meth = initialize_public_method(method, parent)
1367         if alias_item["local_name"]
1368           new_meth.name = alias_item["local_name"]
1369         end
1371         progress "e"
1372         @stats.num_methods += 1
1373         alias_item["file_or_module"].add_method new_meth
1374       end
1375     }
1376   end
1378   ##
1379   # Continuous lines are united.
1380   #
1381   # Comments in continuous lines are removed.
1383   def united_to_one_line(f90src)
1384     return "" unless f90src
1385     lines = f90src.split("\n")
1386     previous_continuing = false
1387     now_continuing = false
1388     body = ""
1389     lines.each{ |line|
1390       words = line.split("")
1391       next if words.empty? && previous_continuing
1392       commentout = false
1393       brank_flag = true ; brank_char = ""
1394       squote = false    ; dquote = false
1395       ignore = false
1396       words.collect! { |char|
1397         if previous_continuing && brank_flag
1398           now_continuing = true
1399           ignore         = true
1400           case char
1401           when "!"                       ; break
1402           when " " ; brank_char << char  ; next ""
1403           when "&"
1404             brank_flag = false
1405             now_continuing = false
1406             next ""
1407           else 
1408             brank_flag     = false
1409             now_continuing = false
1410             ignore         = false
1411             next brank_char + char
1412           end
1413         end
1414         ignore = false
1416         if now_continuing
1417           next ""
1418         elsif !(squote) && !(dquote) && !(commentout)
1419           case char
1420           when "!" ; commentout = true     ; next char
1421           when "\""; dquote = true         ; next char
1422           when "\'"; squote = true         ; next char
1423           when "&" ; now_continuing = true ; next ""
1424           else next char
1425           end
1426         elsif commentout
1427           next char
1428         elsif squote
1429           case char
1430           when "\'"; squote = false ; next char
1431           else next char
1432           end
1433         elsif dquote
1434           case char
1435           when "\""; dquote = false ; next char
1436           else next char
1437           end
1438         end
1439       }
1440       if !ignore && !previous_continuing || !brank_flag
1441         if previous_continuing
1442           body << words.join("")
1443         else
1444           body << "\n" + words.join("")
1445         end
1446       end
1447       previous_continuing = now_continuing ? true : nil
1448       now_continuing = nil
1449     }
1450     return body
1451   end
1454   ##
1455   # Continuous line checker
1457   def continuous_line?(line)
1458     continuous = false
1459     if /&\s*?(!.*)?$/ =~ line
1460       continuous = true
1461       if comment_out?($~.pre_match)
1462         continuous = false
1463       end
1464     end
1465     return continuous
1466   end
1468   ##
1469   # Comment out checker
1471   def comment_out?(line)
1472     return nil unless line
1473     commentout = false
1474     squote = false ; dquote = false
1475     line.split("").each { |char|
1476       if !(squote) && !(dquote)
1477         case char
1478         when "!" ; commentout = true ; break
1479         when "\""; dquote = true
1480         when "\'"; squote = true
1481         else next
1482         end
1483       elsif squote
1484         case char
1485         when "\'"; squote = false
1486         else next
1487         end
1488       elsif dquote
1489         case char
1490         when "\""; dquote = false
1491         else next
1492         end
1493       end
1494     }
1495     return commentout
1496   end
1498   ##
1499   # Semicolons are replaced to line feed.
1501   def semicolon_to_linefeed(text)
1502     return "" unless text
1503     lines = text.split("\n")
1504     lines.collect!{ |line|
1505       words = line.split("")
1506       commentout = false
1507       squote = false ; dquote = false
1508       words.collect! { |char|
1509         if !(squote) && !(dquote) && !(commentout)
1510           case char
1511           when "!" ; commentout = true ; next char
1512           when "\""; dquote = true     ; next char
1513           when "\'"; squote = true     ; next char
1514           when ";" ;                     "\n"
1515           else next char
1516           end
1517         elsif commentout
1518           next char
1519         elsif squote
1520           case char
1521           when "\'"; squote = false ; next char
1522           else next char
1523           end
1524         elsif dquote
1525           case char
1526           when "\""; dquote = false ; next char
1527           else next char
1528           end
1529         end
1530       }
1531       words.join("")
1532     }
1533     return lines.join("\n")
1534   end
1536   ##
1537   # Which "line" is start of block (module, program, block data, subroutine,
1538   # function) statement ?
1540   def block_start?(line)
1541     return nil if !line
1543     if line =~ /^\s*?module\s+(\w+)\s*?(!.*?)?$/i    ||
1544         line =~ /^\s*?program\s+(\w+)\s*?(!.*?)?$/i  ||
1545         line =~ /^\s*?block\s+data(\s+\w+)?\s*?(!.*?)?$/i     ||
1546         line =~ \
1547                 /^\s*?
1548                  (recursive|pure|elemental)?\s*?
1549                  subroutine\s+(\w+)\s*?(\(.*?\))?\s*?(!.*?)?$
1550                 /ix ||
1551         line =~ \
1552                 /^\s*?
1553                  (recursive|pure|elemental)?\s*?
1554                  (
1555                      character\s*?(\([\w\s\=\(\)\*]+?\))?\s+
1556                    | type\s*?\([\w\s]+?\)\s+
1557                    | integer\s*?(\([\w\s\=\(\)\*]+?\))?\s+
1558                    | real\s*?(\([\w\s\=\(\)\*]+?\))?\s+
1559                    | double\s+precision\s+
1560                    | logical\s*?(\([\w\s\=\(\)\*]+?\))?\s+
1561                    | complex\s*?(\([\w\s\=\(\)\*]+?\))?\s+
1562                  )?
1563                  function\s+(\w+)\s*?
1564                  (\(.*?\))?(\s+result\((.*?)\))?\s*?(!.*?)?$
1565                 /ix
1566       return true
1567     end
1569     return nil
1570   end
1572   ##
1573   # Which "line" is end of block (module, program, block data, subroutine,
1574   # function) statement ?
1576   def block_end?(line)
1577     return nil if !line
1579     if line =~ /^\s*?end\s*?(!.*?)?$/i                 ||
1580         line =~ /^\s*?end\s+module(\s+\w+)?\s*?(!.*?)?$/i       ||
1581         line =~ /^\s*?end\s+program(\s+\w+)?\s*?(!.*?)?$/i      ||
1582         line =~ /^\s*?end\s+block\s+data(\s+\w+)?\s*?(!.*?)?$/i  ||
1583         line =~ /^\s*?end\s+subroutine(\s+\w+)?\s*?(!.*?)?$/i   ||
1584         line =~ /^\s*?end\s+function(\s+\w+)?\s*?(!.*?)?$/i
1585       return true
1586     end
1588     return nil
1589   end
1591   ##
1592   # Remove "Alias for" in end of comments
1594   def remove_trailing_alias(text)
1595     return "" if !text
1596     lines = text.split("\n").reverse
1597     comment_block = Array.new
1598     checked = false
1599     lines.each do |line|
1600       if !checked 
1601         if /^\s?#{INTERNAL_ALIAS_MES}/ =~ line ||
1602             /^\s?#{EXTERNAL_ALIAS_MES}/ =~ line
1603           checked = true
1604           next
1605         end
1606       end
1607       comment_block.unshift line
1608     end
1609     nice_lines = comment_block.join("\n")
1610     nice_lines ||= ""
1611     return nice_lines
1612   end
1614   ##
1615   # Empty lines in header are removed
1617   def remove_empty_head_lines(text)
1618     return "" unless text
1619     lines = text.split("\n")
1620     header = true
1621     lines.delete_if{ |line|
1622       header = false if /\S/ =~ line
1623       header && /^\s*?$/ =~ line
1624     }
1625     lines.join("\n")
1626   end
1628   ##
1629   # header marker "=", "==", ... are removed
1631   def remove_header_marker(text)
1632     return text.gsub(/^\s?(=+)/, '<tt></tt>\1')
1633   end
1635   def remove_private_comments(body)
1636     body.gsub!(/^\s*!--\s*?$.*?^\s*!\+\+\s*?$/m, '')
1637     return body
1638   end
1640   ##
1641   # Information of arguments of subroutines and functions in Fortran95
1643   class Fortran95Definition
1645     # Name of variable
1646     #
1647     attr_reader   :varname
1649     # Types of variable
1650     #
1651     attr_reader   :types
1653     # Initial Value
1654     #
1655     attr_reader   :inivalue
1657     # Suffix of array
1658     #
1659     attr_reader   :arraysuffix
1661     # Comments
1662     #
1663     attr_accessor   :comment
1665     # Flag of non documentation
1666     #
1667     attr_accessor   :nodoc
1669     def initialize(varname, types, inivalue, arraysuffix, comment,
1670                    nodoc=false)
1671       @varname = varname
1672       @types = types
1673       @inivalue = inivalue
1674       @arraysuffix = arraysuffix
1675       @comment = comment
1676       @nodoc = nodoc
1677     end
1679     def to_s
1680       return <<-EOF
1681 <Fortran95Definition: 
1682 varname=#{@varname}, types=#{types},
1683 inivalue=#{@inivalue}, arraysuffix=#{@arraysuffix}, nodoc=#{@nodoc}, 
1684 comment=
1685 #{@comment}
1688     end
1690     #
1691     # If attr is included, true is returned
1692     #
1693     def include_attr?(attr)
1694       return if !attr
1695       @types.split(",").each{ |type|
1696         return true if type.strip.chomp.upcase == attr.strip.chomp.upcase
1697       }
1698       return nil
1699     end
1701   end # End of Fortran95Definition
1703   ##
1704   # Parse string argument "text", and Return Array of Fortran95Definition
1705   # object
1707   def definition_info(text)
1708     return nil unless text
1709     lines = "#{text}"
1710     defs = Array.new
1711     comment = ""
1712     trailing_comment = ""
1713     under_comment_valid = false
1714     lines.split("\n").each{ |line|
1715       if /^\s*?!\s?(.*)/ =~ line
1716         if COMMENTS_ARE_UPPER
1717           comment << remove_header_marker($1)
1718           comment << "\n"
1719         elsif defs[-1] && under_comment_valid
1720           defs[-1].comment << "\n"
1721           defs[-1].comment << remove_header_marker($1)
1722         end
1723         next
1724       elsif /^\s*?$/ =~ line
1725         comment = ""
1726         under_comment_valid = false
1727         next
1728       end
1729       type = ""
1730       characters = ""
1731       if line =~ /^\s*?
1732                   (
1733                       character\s*?(\([\w\s\=\(\)\*]+?\))?[\s\,]*
1734                     | type\s*?\([\w\s]+?\)[\s\,]*
1735                     | integer\s*?(\([\w\s\=\(\)\*]+?\))?[\s\,]*
1736                     | real\s*?(\([\w\s\=\(\)\*]+?\))?[\s\,]*
1737                     | double\s+precision[\s\,]*
1738                     | logical\s*?(\([\w\s\=\(\)\*]+?\))?[\s\,]*
1739                     | complex\s*?(\([\w\s\=\(\)\*]+?\))?[\s\,]*
1740                   )
1741                   (.*?::)?
1742                   (.+)$
1743                  /ix
1744         characters = $8
1745         type = $1
1746         type << $7.gsub(/::/, '').gsub(/^\s*?\,/, '') if $7
1747       else
1748         under_comment_valid = false
1749         next
1750       end
1751       squote = false ; dquote = false ; bracket = 0
1752       iniflag = false; commentflag = false
1753       varname = "" ; arraysuffix = "" ; inivalue = ""
1754       start_pos = defs.size
1755       characters.split("").each { |char|
1756         if !(squote) && !(dquote) && bracket <= 0 && !(iniflag) && !(commentflag)
1757           case char
1758           when "!" ; commentflag = true
1759           when "(" ; bracket += 1       ; arraysuffix = char
1760           when "\""; dquote = true
1761           when "\'"; squote = true
1762           when "=" ; iniflag = true     ; inivalue << char
1763           when ","
1764             defs << Fortran95Definition.new(varname, type, inivalue, arraysuffix, comment)
1765             varname = "" ; arraysuffix = "" ; inivalue = ""
1766             under_comment_valid = true
1767           when " " ; next
1768           else     ; varname << char
1769           end
1770         elsif commentflag
1771           comment << remove_header_marker(char)
1772           trailing_comment << remove_header_marker(char)
1773         elsif iniflag
1774           if dquote
1775             case char
1776             when "\"" ; dquote = false ; inivalue << char
1777             else      ; inivalue << char
1778             end
1779           elsif squote
1780             case char
1781             when "\'" ; squote = false ; inivalue << char
1782             else      ; inivalue << char
1783             end
1784           elsif bracket > 0
1785             case char
1786             when "(" ; bracket += 1 ; inivalue << char
1787             when ")" ; bracket -= 1 ; inivalue << char
1788             else     ; inivalue << char
1789             end
1790           else
1791             case char
1792             when ","
1793               defs << Fortran95Definition.new(varname, type, inivalue, arraysuffix, comment)
1794               varname = "" ; arraysuffix = "" ; inivalue = ""
1795               iniflag = false
1796               under_comment_valid = true
1797             when "(" ; bracket += 1 ; inivalue << char
1798             when "\""; dquote = true  ; inivalue << char
1799             when "\'"; squote = true  ; inivalue << char
1800             when "!" ; commentflag = true
1801             else     ; inivalue << char
1802             end
1803           end
1804         elsif !(squote) && !(dquote) && bracket > 0
1805           case char
1806           when "(" ; bracket += 1 ; arraysuffix << char
1807           when ")" ; bracket -= 1 ; arraysuffix << char
1808           else     ; arraysuffix << char
1809           end
1810         elsif squote
1811           case char
1812           when "\'"; squote = false ; inivalue << char
1813           else     ; inivalue << char
1814           end
1815         elsif dquote
1816           case char
1817           when "\""; dquote = false ; inivalue << char
1818           else     ; inivalue << char
1819           end
1820         end
1821       }
1822       defs << Fortran95Definition.new(varname, type, inivalue, arraysuffix, comment)
1823       if trailing_comment =~ /^:nodoc:/
1824         defs[start_pos..-1].collect!{ |defitem|
1825           defitem.nodoc = true
1826         }
1827       end
1828       varname = "" ; arraysuffix = "" ; inivalue = ""
1829       comment = ""
1830       under_comment_valid = true
1831       trailing_comment = ""
1832     }
1833     return defs
1834   end