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