| 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 |
| 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.6 $ |
| 25 |
> |
# Last changed : $Date: 2004-10-11 21:54:35 $ |
| 26 |
|
# Description : Main program |
| 27 |
|
# Licence : GNU copyleft |
| 28 |
|
# |
| 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 = ( |
| 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 = (); |
| 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 |
|
############################################################################## |
| 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 |
| 2233 |
|
sub Write |
| 2234 |
|
{ |
| 2235 |
|
my $string = shift; |
| 2236 |
< |
#print(OUTPUT $string); |
| 2236 |
> |
|
| 2237 |
> |
if(!$dependency){ |
| 2238 |
> |
print(OUTPUT $string); |
| 2239 |
> |
} |
| 2240 |
|
} |
| 2241 |
|
|
| 2242 |
|
|
| 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; |
| 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 |
|
############################################################################## |
| 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 |
|
|
| 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 |
|
|
| 2534 |
|
|
| 2535 |
|
} |
| 2536 |
|
|
| 2537 |
< |
|
| 2537 |
> |
############################################################################## |
| 2538 |
> |
# Generate rules for fortran 90 module |
| 2539 |
> |
############################################################################## |
| 2540 |
|
sub printModule { |
| 2541 |
|
my $modname; |
| 2542 |
|
my $objname; |
| 2543 |
|
print "\n"; |
| 2544 |
|
foreach $modname (keys %parsedModList) { |
| 2545 |
< |
$objname = GetObjFile($parsedModList{$modname}); |
| 2545 |
> |
$objname = GetObjFile($modname); |
| 2546 |
|
print $objDir . $modname . " : " . $objDir . $objname . "\n"; |
| 2547 |
|
} |
| 2548 |
|
} |
| 2549 |
|
|
| 2550 |
+ |
############################################################################## |
| 2551 |
+ |
# Get the object file name |
| 2552 |
+ |
############################################################################## |
| 2553 |
|
sub GetObjFile { |
| 2554 |
|
use File::Basename; |
| 2555 |
|
my $fullname = shift; |
| 2556 |
|
my $filename; |
| 2557 |
|
my $dir; |
| 2558 |
|
my $suffix; |
| 2559 |
+ |
|
| 2560 |
|
($filename, $dir, $suffix) = fileparse($fullname, '\.[^.]*'); |
| 2561 |
|
return $filename . $objExt; |
| 2562 |
|
} |
| 2563 |
+ |
|
| 2564 |
|
############################################################################## |
| 2565 |
+ |
# Get the base name of fortran 90 module |
| 2566 |
+ |
############################################################################## |
| 2567 |
+ |
sub GetModBasename { |
| 2568 |
+ |
my $modname = shift; |
| 2569 |
+ |
|
| 2570 |
+ |
if ($modBasenameCase eq "lower") { |
| 2571 |
+ |
$modname = lc($modname); |
| 2572 |
+ |
|
| 2573 |
+ |
} elsif ($modBasenameCase eq "upper") { |
| 2574 |
+ |
$modname = uc($modname); |
| 2575 |
+ |
} elsif ($modBasenameCase eq "mixed") { |
| 2576 |
+ |
$modname = ucfirst(lc($modname)); |
| 2577 |
+ |
} |
| 2578 |
+ |
|
| 2579 |
+ |
return $modname; |
| 2580 |
+ |
} |
| 2581 |
+ |
|
| 2582 |
+ |
sub RestoreCommandLineDefine { |
| 2583 |
+ |
my $macro; |
| 2584 |
+ |
|
| 2585 |
+ |
foreach $macro(@savedDefine) { |
| 2586 |
+ |
Define($macro); |
| 2587 |
+ |
} |
| 2588 |
+ |
} |
| 2589 |
+ |
|
| 2590 |
+ |
sub SaveCommandLineDefine { |
| 2591 |
+ |
my $macro = shift; |
| 2592 |
+ |
push @savedDefine, $macro; |
| 2593 |
+ |
} |
| 2594 |
+ |
############################################################################## |
| 2595 |
|
# Main routine |
| 2596 |
|
############################################################################## |
| 2597 |
|
|
| 2635 |
|
} |
| 2636 |
|
# add macro and defn to hash table |
| 2637 |
|
Define($macro." ".$defn); |
| 2638 |
+ |
|
| 2639 |
+ |
#save define macro from command line |
| 2640 |
+ |
#it will be restored when next source file is processed |
| 2641 |
+ |
SaveCommandLineDefine($macro." ".$defn); |
| 2642 |
|
} |
| 2643 |
|
|
| 2644 |
|
# Debugging turned on: -d |
| 2769 |
|
} |
| 2770 |
|
|
| 2771 |
|
# Module paths: -Minclude or -M include |
| 2772 |
< |
elsif(substr($ARGV[$i], 0, 2) eq "-M") { |
| 2773 |
< |
# -M include format |
| 2774 |
< |
if(length($ARGV[$i]) == 2) { |
| 2775 |
< |
if($i+1 >= $argc) { |
| 2776 |
< |
Error("Argument to `-M' is missing"); |
| 2777 |
< |
} |
| 2778 |
< |
AddModulePath($ARGV[++$i]); |
| 2779 |
< |
} |
| 2780 |
< |
# -Minclude format |
| 2781 |
< |
else { |
| 2782 |
< |
AddModulePath(substr($ARGV[$i], 2)); |
| 2783 |
< |
} |
| 2784 |
< |
} |
| 2785 |
< |
|
| 2786 |
< |
# use module |
| 2787 |
< |
elsif($ARGV[$i] eq "-m") { |
| 2788 |
< |
if($i+1 >= $argc) { |
| 2789 |
< |
Error("Argument to `-m' is missing"); |
| 2790 |
< |
} |
| 2791 |
< |
UseModule($ARGV[++$i]); |
| 2772 |
> |
#elsif(substr($ARGV[$i], 0, 2) eq "-M") { |
| 2773 |
> |
# # -M include format |
| 2774 |
> |
# if(length($ARGV[$i]) == 2) { |
| 2775 |
> |
# if($i+1 >= $argc) { |
| 2776 |
> |
# Error("Argument to `-M' is missing"); |
| 2777 |
> |
# } |
| 2778 |
> |
# AddModulePath($ARGV[++$i]); |
| 2779 |
> |
# } |
| 2780 |
> |
# # -Minclude format |
| 2781 |
> |
# else { |
| 2782 |
> |
# AddModulePath(substr($ARGV[$i], 2)); |
| 2783 |
> |
# } |
| 2784 |
> |
#} |
| 2785 |
> |
|
| 2786 |
> |
# use module |
| 2787 |
> |
#elsif($ARGV[$i] eq "-m") { |
| 2788 |
> |
# if($i+1 >= $argc) { |
| 2789 |
> |
# Error("Argument to `-m' is missing"); |
| 2790 |
> |
# } |
| 2791 |
> |
# UseModule($ARGV[++$i]); |
| 2792 |
> |
#} |
| 2793 |
> |
|
| 2794 |
> |
# make dependency |
| 2795 |
> |
elsif($ARGV[$i] eq "-M") { |
| 2796 |
> |
$dependency = 1; |
| 2797 |
|
} |
| 2798 |
|
|
| 2799 |
+ |
# make dependency (skip system header files) |
| 2800 |
+ |
elsif($ARGV[$i] eq "-MM") { |
| 2801 |
+ |
$dependency = 1; |
| 2802 |
+ |
$skipSysInclude = 1; |
| 2803 |
+ |
} |
| 2804 |
+ |
|
| 2805 |
+ |
#case of basename of fortran module |
| 2806 |
+ |
elsif($ARGV[$i] eq "-mc") { |
| 2807 |
+ |
my $tempVar = lc($ARGV[++$i]); |
| 2808 |
+ |
if ($modBasenameCase ne 'lower' && $modBasenameCase ne 'upper' |
| 2809 |
+ |
&& $modBasenameCase ne 'mixed'){ |
| 2810 |
+ |
Error("Valid argument for `-om' are lower, upper or mixed"); |
| 2811 |
+ |
} |
| 2812 |
+ |
$modBasenameCase = $tempVar; |
| 2813 |
+ |
} |
| 2814 |
+ |
|
| 2815 |
+ |
#the suffix of fortran module |
| 2816 |
+ |
elsif($ARGV[$i] eq "-ms") { |
| 2817 |
+ |
$modSuffix = $ARGV[++$i]; |
| 2818 |
+ |
} |
| 2819 |
+ |
|
| 2820 |
|
# set macro prefix |
| 2821 |
|
elsif($ARGV[$i] eq "-mp") { |
| 2822 |
|
if($i+1 >= $argc) { |
| 2834 |
|
# module files will be built in a separate directory from the sources. |
| 2835 |
|
elsif($ARGV[$i] eq "-od") { |
| 2836 |
|
$objDir = $ARGV[++$i]; |
| 2837 |
< |
} |
| 2837 |
> |
} |
| 2838 |
> |
|
| 2839 |
|
# turn on overwrite mode |
| 2840 |
|
elsif($ARGV[$i] eq "-ov") { |
| 2841 |
|
$overwrite = 1; |
| 2946 |
|
|
| 2947 |
|
#clean visitedTable |
| 2948 |
|
%visitedTable = (); |
| 2949 |
+ |
|
| 2950 |
+ |
#clear all define |
| 2951 |
+ |
UndefAll(); |
| 2952 |
+ |
|
| 2953 |
+ |
#restore command line define |
| 2954 |
+ |
RestoreCommandLineDefine(); |
| 2955 |
+ |
|
| 2956 |
+ |
#print dependency rule |
| 2957 |
|
print "\n"; |
| 2958 |
< |
print $objDir . GetObjFile($base_file) . " : "; |
| 2958 |
> |
print $objDir . GetObjFile($base_file) . " : " . $base_file . " \\"; |
| 2959 |
> |
print "\n"; |
| 2960 |
> |
|
| 2961 |
|
Parse($base_file); |
| 2962 |
|
# close output file if in overwrite mode |
| 2963 |
|
if($overwrite) { CloseOutputFile(); } |