# | Line 1 | Line 1 | |
---|---|---|
1 | #!/usr/bin/perl -w | |
2 | – | |
3 | – | package FileEntry; |
4 | – | |
5 | – | sub new { |
6 | – | my $type = shift; |
7 | – | my $filename = shift; |
8 | – | my $path = shift; |
9 | – | my $self = {}; |
10 | – | $self->{'source_file'} = $filename; |
11 | – | $self->{'filepath'} = $path; |
12 | – | $self->{'includes'} = {}; |
13 | – | $self->{'uses'} = {}; |
14 | – | $self->{'modules'} = {}; |
15 | – | bless $self; |
16 | – | } |
17 | – | |
2 | ######################################################################## | |
3 | # | |
4 | # filepp is free software; you can redistribute it and/or modify | |
# | Line 37 | Line 21 | sub new { | |
21 | # Filename : $RCSfile: filepp,v $ | |
22 | # Author : $Author: tim $ | |
23 | # Maintainer : Darren Miller: darren@cabaret.demon.co.uk | |
24 | < | # File version : $Revision: 1.1 $ |
25 | < | # Last changed : $Date: 2004-10-01 21:11:29 $ |
24 | > | # File version : $Revision: 1.5 $ |
25 | > | # Last changed : $Date: 2004-10-11 21:10:28 $ |
26 | # Description : Main program | |
27 | # Licence : GNU copyleft | |
28 | # | |
# | Line 48 | Line 32 | use strict "subs"; | |
32 | ||
33 | use strict "vars"; | |
34 | use strict "subs"; | |
51 | – | #use Graph; |
35 | # Used to all filepp to work with any char, not just ascii, | |
36 | # feel free to remove this if it causes you problems | |
37 | < | use bytes; |
37 | > | #use bytes; |
38 | ||
39 | # version number of program | |
40 | my $VERSION = '1.7.1'; | |
41 | ||
42 | # list of paths to search for modules, normal Perl list + module dir | |
43 | < | push(@INC, "/home/maul/gezelter/tim/code/OOPSE-2.0/scripts/filepp-1.7.1/modules/f90dpend/"); |
43 | > | #push(@INC, "/home/maul/gezelter/tim/code/OOPSE-2.0/scripts/filepp-1.7.1/modules/f90dpend/"); |
44 | ||
45 | # index of keywords supported and functions to deal with them | |
46 | my %Keywords = ( | |
# | Line 297 | Line 280 | options: | |
280 | all other arguments are assumed to be input files | |
281 | "; | |
282 | ||
300 | – | # graph for dependency files |
301 | – | my $dependencyGraph; |
283 | ||
284 | # visited table | |
285 | my %visitedTable = (); | |
# | Line 312 | Line 293 | my %f90ModList = (); | |
293 | # | |
294 | my %f90ModList = (); | |
295 | ||
296 | < | # |
296 | > | # suffix of fortran object file |
297 | my $objExt = '.o'; | |
298 | + | |
299 | + | # suffix of fortran 90 module |
300 | + | my $modSuffix = "mod"; |
301 | + | |
302 | + | # case of basename of fortran 90 module |
303 | + | my $modBasenameCase = "lower"; |
304 | + | |
305 | + | #flag for generating dependency, by default, it is off |
306 | + | my $dependency = 0; |
307 | + | |
308 | + | #skip system header file |
309 | + | my $skipSysInclude = 0; |
310 | + | |
311 | + | #saved command line define macro |
312 | + | my @savedDefine; |
313 | + | |
314 | ############################################################################## | |
315 | # SetDebug - controls debugging level | |
316 | ############################################################################## | |
# | Line 1948 | Line 1945 | sub Include | |
1945 | } | |
1946 | # else assume filename given without "" or <>, naughty but allowed | |
1947 | ||
1948 | + | #if skipSysInclude option is turned on, skip current file |
1949 | + | if ($skipSysInclude && $sysinclude) { |
1950 | + | return; |
1951 | + | } |
1952 | + | |
1953 | # check for file in current directory | |
1954 | if($sysinclude == 0) { | |
1955 | # get name of directory base file is in | |
# | Line 2231 | Line 2233 | sub Write | |
2233 | sub Write | |
2234 | { | |
2235 | my $string = shift; | |
2236 | < | #print(OUTPUT $string); |
2236 | > | |
2237 | > | if(!$dependency){ |
2238 | > | print(OUTPUT $string); |
2239 | > | } |
2240 | } | |
2241 | ||
2242 | ||
# | Line 2453 | Line 2458 | sub Module{ | |
2458 | my $file; | |
2459 | if ($modulename !~ /^procedure/){ | |
2460 | ||
2461 | < | $parsedModList{uc($modulename) . ".mod"} = Filepp::GetDefine('__FILE__'); |
2461 | > | $modulename =~ s/\s+$//; |
2462 | > | $parsedModList{GetModBasename($modulename) . "." . $modSuffix} |
2463 | > | = Filepp::GetDefine('__FILE__'); |
2464 | ||
2465 | #$modulefile = Filepp::GetDefine('__BASE_FILE__'); | |
2466 | #print $modulefile; | |
# | Line 2474 | Line 2481 | sub Use{ | |
2481 | my $line = shift; | |
2482 | $line =~ /^(\w+).*/; | |
2483 | my $f90module = $1; | |
2484 | + | $f90module =~ s/\s+$//; |
2485 | $f90module = uc($f90module); | |
2486 | ||
2487 | < | print " " . $objDir . $f90module . '.mod \\', "\n"; |
2480 | < | #addModule($f90module); |
2487 | > | print " " . $objDir . GetModBasename($f90module) . "." . $modSuffix . " \\\n"; |
2488 | } | |
2489 | ||
2490 | ############################################################################## | |
# | Line 2491 | Line 2498 | Filepp::AddKeyword("include", "Filepp::Include"); | |
2498 | Filepp::AddKeyword("include", "Filepp::Include"); | |
2499 | ||
2500 | ############################################################################## | |
2501 | < | # add RecordFileInfo info Filepp. Every time a file is opened, an entry |
2495 | < | # of this file is created |
2501 | > | # test whether a file is visited or not |
2502 | ############################################################################## | |
2497 | – | |
2498 | – | sub RecordFileInfo{ |
2499 | – | my $file = Filepp::GetDefine('__FILE__'); |
2500 | – | # dependenyGraph->add_vertex(new ); |
2501 | – | |
2502 | – | #if it is not base file, we need to add an edge |
2503 | – | if ($include_level > 0) { |
2504 | – | |
2505 | – | } |
2506 | – | |
2507 | – | } |
2508 | – | |
2509 | – | Filepp::AddOpenInputFunc("Filepp::RecordFileInfo"); |
2510 | – | |
2503 | sub IsVisited { | |
2504 | my $fullfile = shift; | |
2505 | ||
# | Line 2519 | Line 2511 | sub IsVisited { | |
2511 | } | |
2512 | } | |
2513 | ||
2514 | + | ############################################################################## |
2515 | + | # Clean Visited Table |
2516 | + | ############################################################################## |
2517 | + | sub cleanVisited { |
2518 | + | my $visitedFile; |
2519 | + | foreach $visitedFile (keys %visitedTable) { |
2520 | + | delete $visitedTable{$visitedFile}; |
2521 | + | } |
2522 | + | |
2523 | + | } |
2524 | + | |
2525 | sub AddModule { | |
2526 | my $modulename = shift; | |
2527 | ||
# | Line 2531 | Line 2534 | sub AddModule { | |
2534 | ||
2535 | } | |
2536 | ||
2537 | < | |
2537 | > | ############################################################################## |
2538 | > | # Generate rules for fortran 90 module |
2539 | > | ############################################################################## |
2540 | sub printModule { | |
2541 | my $modname; | |
2542 | my $objname; | |
# | Line 2542 | Line 2547 | sub printModule { | |
2547 | } | |
2548 | } | |
2549 | ||
2550 | + | ############################################################################## |
2551 | + | # Get the object file name |
2552 | + | ############################################################################## |
2553 | sub GetObjFile { | |
2554 | use File::Basename; | |
2555 | my $fullname = shift; | |
# | Line 2550 | Line 2558 | sub GetObjFile { | |
2558 | my $suffix; | |
2559 | ($filename, $dir, $suffix) = fileparse($fullname, '\.[^.]*'); | |
2560 | return $filename . $objExt; | |
2561 | + | } |
2562 | + | |
2563 | + | ############################################################################## |
2564 | + | # Get the base name of fortran 90 module |
2565 | + | ############################################################################## |
2566 | + | sub GetModBasename { |
2567 | + | my $modname = shift; |
2568 | + | |
2569 | + | if ($modBasenameCase eq "lower") { |
2570 | + | $modname = lc($modname); |
2571 | + | |
2572 | + | } elsif ($modBasenameCase eq "upper") { |
2573 | + | $modname = uc($modname); |
2574 | + | } elsif ($modBasenameCase eq "mixed") { |
2575 | + | $modname = ucfirst(lc($modname)); |
2576 | + | } |
2577 | + | |
2578 | + | return $modname; |
2579 | } | |
2580 | + | |
2581 | + | sub RestoreCommandLineDefine { |
2582 | + | my $macro; |
2583 | + | |
2584 | + | foreach $macro(@savedDefine) { |
2585 | + | Define($macro); |
2586 | + | } |
2587 | + | } |
2588 | + | |
2589 | + | sub SaveCommandLineDefine { |
2590 | + | my $macro = shift; |
2591 | + | push @savedDefine, $macro; |
2592 | + | } |
2593 | ############################################################################## | |
2594 | # Main routine | |
2595 | ############################################################################## | |
# | Line 2595 | Line 2634 | while($ARGV[$i]) { | |
2634 | } | |
2635 | # add macro and defn to hash table | |
2636 | Define($macro." ".$defn); | |
2637 | + | |
2638 | + | #save define macro from command line |
2639 | + | #it will be restored when next source file is processed |
2640 | + | SaveCommandLineDefine($macro." ".$defn); |
2641 | } | |
2642 | ||
2643 | # Debugging turned on: -d | |
# | Line 2725 | Line 2768 | while($ARGV[$i]) { | |
2768 | } | |
2769 | ||
2770 | # Module paths: -Minclude or -M include | |
2771 | < | elsif(substr($ARGV[$i], 0, 2) eq "-M") { |
2772 | < | # -M include format |
2773 | < | if(length($ARGV[$i]) == 2) { |
2774 | < | if($i+1 >= $argc) { |
2775 | < | Error("Argument to `-M' is missing"); |
2776 | < | } |
2777 | < | AddModulePath($ARGV[++$i]); |
2778 | < | } |
2779 | < | # -Minclude format |
2780 | < | else { |
2781 | < | AddModulePath(substr($ARGV[$i], 2)); |
2782 | < | } |
2783 | < | } |
2771 | > | #elsif(substr($ARGV[$i], 0, 2) eq "-M") { |
2772 | > | # # -M include format |
2773 | > | # if(length($ARGV[$i]) == 2) { |
2774 | > | # if($i+1 >= $argc) { |
2775 | > | # Error("Argument to `-M' is missing"); |
2776 | > | # } |
2777 | > | # AddModulePath($ARGV[++$i]); |
2778 | > | # } |
2779 | > | # # -Minclude format |
2780 | > | # else { |
2781 | > | # AddModulePath(substr($ARGV[$i], 2)); |
2782 | > | # } |
2783 | > | #} |
2784 | ||
2785 | # use module | |
2786 | < | elsif($ARGV[$i] eq "-m") { |
2787 | < | if($i+1 >= $argc) { |
2788 | < | Error("Argument to `-m' is missing"); |
2789 | < | } |
2790 | < | UseModule($ARGV[++$i]); |
2786 | > | #elsif($ARGV[$i] eq "-m") { |
2787 | > | # if($i+1 >= $argc) { |
2788 | > | # Error("Argument to `-m' is missing"); |
2789 | > | # } |
2790 | > | # UseModule($ARGV[++$i]); |
2791 | > | #} |
2792 | > | |
2793 | > | # make dependency |
2794 | > | elsif($ARGV[$i] eq "-M") { |
2795 | > | $dependency = 1; |
2796 | } | |
2797 | ||
2798 | + | # make dependency (skip system header files) |
2799 | + | elsif($ARGV[$i] eq "-MM") { |
2800 | + | $dependency = 1; |
2801 | + | $skipSysInclude = 1; |
2802 | + | } |
2803 | + | |
2804 | + | #case of basename of fortran module |
2805 | + | elsif($ARGV[$i] eq "-mc") { |
2806 | + | my $tempVar = lc($ARGV[++$i]); |
2807 | + | if ($modBasenameCase ne 'lower' && $modBasenameCase ne 'upper' |
2808 | + | && $modBasenameCase ne 'mixed'){ |
2809 | + | Error("Valid argument for `-om' are lower, upper or mixed"); |
2810 | + | } |
2811 | + | $modBasenameCase = $tempVar; |
2812 | + | } |
2813 | + | |
2814 | + | #the suffix of fortran module |
2815 | + | elsif($ARGV[$i] eq "-ms") { |
2816 | + | $modSuffix = $ARGV[++$i]; |
2817 | + | } |
2818 | + | |
2819 | # set macro prefix | |
2820 | elsif($ARGV[$i] eq "-mp") { | |
2821 | if($i+1 >= $argc) { | |
# | Line 2764 | Line 2833 | while($ARGV[$i]) { | |
2833 | # module files will be built in a separate directory from the sources. | |
2834 | elsif($ARGV[$i] eq "-od") { | |
2835 | $objDir = $ARGV[++$i]; | |
2836 | < | } |
2836 | > | } |
2837 | > | |
2838 | # turn on overwrite mode | |
2839 | elsif($ARGV[$i] eq "-ov") { | |
2840 | $overwrite = 1; | |
# | Line 2874 | Line 2944 | foreach $base_file (@Inputfiles) { | |
2944 | } | |
2945 | ||
2946 | #clean visitedTable | |
2947 | < | %visitedTable = (); |
2947 | > | cleanVisited(); |
2948 | > | |
2949 | > | #clear all define |
2950 | > | UndefAll(); |
2951 | > | |
2952 | > | #restore command line define |
2953 | > | RestoreCommandLineDefine(); |
2954 | > | |
2955 | > | #print dependency rule |
2956 | print "\n"; | |
2957 | < | print $objDir . GetObjFile($base_file) . " : "; |
2957 | > | print $objDir . GetObjFile($base_file) . " : " . $base_file . " \\"; |
2958 | > | print "\n"; |
2959 | > | |
2960 | Parse($base_file); | |
2961 | # close output file if in overwrite mode | |
2962 | if($overwrite) { CloseOutputFile(); } |
– | Removed lines |
+ | Added lines |
< | Changed lines |
> | Changed lines |