ftnchek.c

这是一个Linux下的集成开发环境

/*

Copyright (c) 2000, Red Hat, Inc.

This file is part of Source-Navigator.

Source-Navigator is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.

Source-Navigator is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with Source-Navigator; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.



*/

/*  ftnchek.c:

	Main program for Fortran Syntax Checker.

    Copyright (C) 1993 by Robert K. Moniot.
    This program is free software.  Permission is granted to
    modify it and/or redistribute it, retaining this notice.
    No guarantees accompany this software.


	Top-level input/output is done here: opening and closing files,
	and printing error, warning, and informational messages.

	Shared functions defined:
		print_a_line()	Prints source code line.
		yyerror()	Error messages from yyparse and elsewhere.
		syntax_error()	Error messages with line and column num.
		warning()	Warning messages.
		nonportable()	Portability warnings.
		wrapup()	Look at cross references, etc.
*/

#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
#include <stdlib.h>
#include <sys/types.h>

#ifdef HAVE_SYS_PARAM_H
#include <sys/param.h>
#endif

#if defined(__MSVC__)
#define	MAXPATHLEN _MAX_PATH
#endif /* __MSVC__ */

#define MAIN
#include "ftnchek.h"
#include <tcl.h>

#ifndef MAXPATHLEN
#define MAXPATHLEN 1024
#endif

PRIVATE void
error_summary(),get_env_options(),
make_env_name(), src_file_in();
#if 0
PRIVATE void
	lintstyle_error_message(),oldstyle_error_message(),
	error_message(),print_version_number(),set_option(),
	list_options(),open_outfile(),resource_summary(),wrapup();
#endif
#ifdef ALLOW_INCLUDE
PRIVATE void append_include_path();
#endif

PRIVATE int read_setting();

#define full_output	(do_list || do_symtab)

unsigned long intrins_clashes;	/* count of intrinsic hashtable clashes */
#ifdef COUNT_REHASHES
extern unsigned long rehash_count; /* count of calls to rehash() */
#endif

	/* Here we define the commandline options.  Most options are boolean
	   switchopts, with "no" prefix to unset them.  Others (called
	   settings) are numeric quantities, defined using "=num".
	   A third category (strsettings) are string quantities, eg filenames.
	   The argument "?" will cause list of options to be printed out.
	   For VMS, options can be prefixed with either "-" or "/",
	   but messages will use the canonical form. */

#ifdef OPTION_PREFIX_SLASH
#define OPT_PREFIX '/'	/* Canonical VMS prefix for commandline options */
#else
#define OPT_PREFIX '-'	/* Canonical Unix prefix for commandline options */
#endif

#define OPT_MATCH_LEN 3	/* Options are matched only in 1st 3 chars */
#define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
#define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
#define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))

/*	Option definitions:
	   New options can be added to lists by inserting definition
	   here using same syntax as others, and declaring the variable
	   with OPT(type,name,default); in ftnchek.h.  No other changes
	   needed.
*/


		/* List of switches is defined first.  Each entry gives the
		   name and the corresponding flag variable to be set
		   or cleared.  See set_option() for processing of switches.

		   N.B. list_options() will suppress printing of any options
		   whose explanation starts with "debug" unless the -debug
		   switch was previously given.
		 */
struct {
    char *name;
    int *switchflag;
    char *explanation;
} switchopt[]={
	{"calltree",	&print_call_tree,"print subprogram call tree"},
	{"crossref",	&print_xref_list,"print call cross-reference list"},
	{"declare",	&decls_required,"list undeclared variables"},
	{"division",	&div_check,	"catch possible div by 0"},
	{"extern",	&ext_def_check,	"check if externals defined"},
	{"f77",		&f77_standard,	"warn of nonstandard constructs"},
	{"help",	&help_screen,	"print help screen"},
	{"hollerith",	&hollerith_check,"warn about holleriths under -port"},
	{"library",	&library_mode,	"treat next files as library"},
#ifdef EOLSKIP
	{"linebreak",	&eol_is_space,	"treat linebreaks as space"},
#endif
	{"list",	&do_list,	"print program listing"},
	{"novice",	&novice_help,	"extra help for novices"},
	{"portability",	&port_check,	"check for portability problems"},
	{"pretty",	&pretty_flag,	"warn of deceiving appearances"},
	{"project",	&make_project_file,	"create project file"},
	{"pure",	&pure_functions,"functions have no side effects"},
	{"reference",	&print_ref_list,"print who-calls-who reference list"},
	{"sixchar",	&sixclash,	"catch nonunique names"},
	{"sort",	&print_topo_sort,"prerequisite-order sort of modules"},
	{"symtab",	&do_symtab,	"print symbol table info"},
	{"truncation",	&trunc_check,	"check for truncation pitfalls"},
	{"verbose",	&verbose,	"verbose output"},
	{"volatile",	&volatile_flag,	"assume volatile common blocks"},

	{"debug",	&debug_latest,	"debug latest code"},
	{"global",	&debug_glob_symtab,	"debug global symtab info"},
	{"grammar",	&debug_parser,	"debug printout in parser"},
	{"hashtable",	&debug_hashtab,	"debug printout of hashtable"},
	{"local",	&debug_loc_symtab,	"debug local symtab info"},
	{"resources",	&show_resources,"debug info on resources"},
	{"tokens",	&debug_lexer,	"debug printout in lexer"},
#if YYDEBUG
	{"yydebug",	&yydebug,	"debug via yydebug"},
#endif
};


		/* List of settings is defined here. Each entry gives
		   the name, the corresponding variable, the range
		   of permitted values, the value for turning it off,
		   followed by brief explanation.
		   See set_option() for processing. */
struct {
    char *name;
    int *setvalue;
    int minlimit,maxlimit,turnoff;
    char *explanation;
} setting[]={
  {"arguments",	&argcheck_strictness, 0, 3, 0,
			"check args: 0=none 1=number 2=type 3=all"},
  {"array",	&array_arg_check, 0, 3, 0,
			"check array args: 0=none 1=dims 2=size 3=all"},
/*   {"columns",	&max_stmt_col,  72, MAXLINE, 72, */
/* 			"max line length processed"}, */
  {"columns",	&max_stmt_col,  MAXLINE, MAXLINE, MAXLINE,
			"max line length processed"},
  {"common",	&comcheck_strictness,  0, 3, 0,
			"common check: 0=none 3=most strict"},
  {"usage",	&usage_check,	0, 3, 0,
			"0=no check, 1=used-not-set 2=unused 3=all"},
  {"wordsize",	&given_wordsize, 0, 16, 0,
			"standard wordsize in bytes (0=no default)"},
  {"wrap",	&wrap_column, 0, 999, 0,
			"width of page to wrap error messages"},
};


		/* List of strsettings is defined here. Each entry gives
		   the name the corresponding string variable, and brief
		   explanation.  See set_option() for processing. */
struct {
    char *name;
    char **strvalue;
    char *explanation;
} strsetting[]={
#ifdef ALLOW_INCLUDE
  {"include",	&include_path,	"include-file directory"},
#endif
  {"output",	&out_fname,	"output file name"},
};

int must_open_outfile=FALSE;	/* Flag set to TRUE when out=name given */

FILE    *hig_fp;
FILE    *out_fp;
int      highlight;

#define	MAIN_MODULE

#include <tcl.h>
#include "sn.h"
#include "parser.h"

/* Tcl encoding to translate from. The default (when equal to NULL) is
   to do no translation. */
Tcl_Encoding encoding = NULL;

char * group = "fortran";

extern int report_local_vars;
extern int max_line_width;

static	int
log_symbol_filename(FILE *fp, char *fname)
{
  char	*outfile = NULL;

  if (fname == NULL) {
    fprintf(stderr, "log_symbol_filename called with NULL filename\n");
    exit(1);
  }

  if (yyin) {
    fclose(yyin);
  }
  yyin = fopen(fname,"r");
  if (!yyin) {
    fprintf(stderr, "Error: unable to open file \"%s\",errno: %d\n",fname,errno);
    return 1;
  }

  if (highlight)
    {
      if (hig_fp)
        {
          fclose(hig_fp);
	  hig_fp = NULL;
	}
	
	outfile = Paf_tempnam(NULL,"hf");
	if (fp)
	{
	  fprintf(fp,"%s\n",outfile);
	}
	  
	hig_fp = fopen(outfile,"w+");
    }
  put_status_parsing_file(fname); 
  
#ifndef NO_DATABASE
  put_file(fname,group,outfile);
#endif
  
  return 0;
}

extern int sum_line;
#ifdef NO_DATABASE
FILE	*cross_ref_fp;
int	comment_database;
#else
extern FILE	*cross_ref_fp;
extern	int	comment_database;
#endif

int
main(int argc, char *argv[])
{
	extern	char	*optarg;
	extern	int	optind;
	int iarg;
	int filecount=0,actioncount=0;
	char *infile;
   	FILE    *list_fp = NULL;
   	FILE    *include_fp = NULL;
	char	*cross_ref_file = NULL;
	char	tmp[500];
	char	dirname[MAXPATHLEN];
	char	*incl_to_pipe = NULL;

	dirname[0] = '\0';

#ifdef VMS			/* VMS version: expand wildcards, etc. */
	shell_mung(&argc,&argv,1,NULL);
#endif

	list_fd = stdout;
	project_fd = (FILE *) NULL;
	error_count = 0;
	warning_count = 0;

	get_env_options();
#ifdef ALLOW_INCLUDE
	include_path_list = (IncludePathNode*) NULL;
	if(include_path != (char *)NULL) {
	  append_include_path(include_path);
	  include_path = (char *)NULL; /* clear it for the next one */
	}
#endif
	init_tables();		/* Initialize tables */
	init_keyhashtab();
	intrins_clashes = init_intrins_hashtab();
	init_globals();
	init_symtab();

	/* Character set encoding (as defined by Tcl). */
	Tcl_FindExecutable(argv[0]);

	while ((iarg = getopt(argc,argv,"e:s:n:hy:I:g:i:ltx:Cr:O:w:"))
	       != EOF)
	  {
	    switch (iarg)
	      {
	      case 's':
		if ((out_fp = fopen(optarg,"a")) == NULL)
		  {
		    fprintf(stderr,"Error: couldn't create \"%s\"\n",optarg);
		    exit(1);
		  }
		break;
		
	      case 'n':
		/* FIXME: Remove db prefix option later */
		break;
		
	      case 'e':
		if ((encoding = Tcl_GetEncoding(NULL, optarg)) == NULL)
		  {
		    fprintf(stderr, "Unable to locate `%s' encoding\n", optarg);
		    return 1;
		  }
		break;
		
	      case 'h':
		highlight = -1;
		break;
		
	      case 'y':
		list_fp = fopen(optarg,"r");
		if (!list_fp) {
		    fprintf(stderr, "Could not open: \"%s\", %s\n",
		            optarg, strerror(errno));
		    exit(2);
		}
		break;
		
	      case 'I':
		include_fp = fopen(optarg,"r");
		break;
		
	      case 'g':
		group = optarg;
		break;
		
	      case 'i':
		incl_to_pipe = optarg;
		break;
		
	      case 'x':
		cross_ref_file = optarg;
		break;
		
	      case 'r':
		/* Remark (comment) support. */
		comment_database = TRUE;
		break;
		
	      case 'l':
		report_local_vars = 1;
		break;
		
	      case 'C':
		/* Parse *.h *.c as C++. Fall through. */
	      case 't':
		/* Drop /usr files. */
		break;
	      case 'w':
		max_line_width = atoi(optarg);
		break;
	      }
	  }

	if (include_fp)
	{
		while (fgets(tmp,sizeof(tmp) -1,include_fp))
		{
			char *pc = strchr( tmp, '\n' );

			if (pc)
				*pc = 0;
			append_include_path(SN_StrDup(tmp));
		}
		fclose(include_fp);
	}

	if (optind < argc || list_fp)
	{
		Paf_Pipe_Create(incl_to_pipe);

		if (cross_ref_file)
		{
			if (!(cross_ref_fp = fopen(cross_ref_file,"a")))
			{
				fprintf(stderr, "Error: (open) \"%s, errno: %d\"\n",cross_ref_file,errno);
				exit(1);
			}
		}

		if (list_fp)
		{
			while (fgets(tmp,sizeof(tmp) -1,list_fp))
			{
				++actioncount;  /* Cause exit w/o reading stdin below */

				++filecount;

				if ((infile = strchr(tmp,'\n')))
				{
					*infile = '\0';
				}
				if (!log_symbol_filename(out_fp,tmp))
				{
					src_file_in(tmp);
				}
			}
			fclose(list_fp);
		}
		else
		{
			if (optind == (argc - 1) && highlight != -1)
				highlight = 1;

			if (!log_symbol_filename(out_fp,argv[optind]))
				src_file_in(argv[optind]);
		}
		empty_comments();
	}
	else	{
		fprintf(stderr, "-y or file name required\n");
		exit(1);
	}

	if (cross_ref_fp)
		fclose(cross_ref_fp);

	if (yyin)
		fclose(yyin);

	if (out_fp)
		fclose(out_fp);