home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / duplproc.icn < prev    next >
Text File  |  2000-07-29  |  9KB  |  326 lines
  1. ############################################################################
  2. #
  3. #    File:     duplproc.icn
  4. #
  5. #    Subject:  Program to find duplicate declarations
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     December 30, 1991
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.8
  18. #
  19. ############################################################################
  20. #
  21. #  Use this if you plan on posting utility procedures suitable for
  22. #  inclusion in someone's Icon library directories.
  23. #
  24. #  duplproc.icn compiles into a program which will search through
  25. #  every directory in your ILIBS environment variable (and/or in the
  26. #  directories supplied as arguments to the program).  If it finds any
  27. #  duplicate procedure or record identifiers, it will report this on
  28. #  the standard output.
  29. #
  30. #  It is important to try to use unique procedure names in programs
  31. #  you write, especially if you intend to link in some of the routines
  32. #  contained in the IPL.  Checking for duplicate procedure names has
  33. #  been somewhat tedious in the past, and many of us (me included)
  34. #  must be counted as guilty for not checking more thoroughly.  Now,
  35. #  however, checking should be a breeze.
  36. #
  37. #  BUGS:  Duplproc thinks that differently written names for the same
  38. #  directory are in fact different directories.  Use absolute path
  39. #  names, and you'll be fine.
  40. #
  41. ############################################################################
  42. #
  43. #  Requires:  UNIX (MS-DOS will work if all files are in MS-DOS format)
  44. #
  45. ############################################################################
  46.  
  47. record procedure_stats(name, file, lineno)
  48.  
  49. procedure main(a)
  50.  
  51.     local proc_table, fname, elem, lib_file, tmp, too_many_table
  52.  
  53.     #     usage:  duplproc [libdirs]
  54.     #
  55.     # Where libdirs is a series of space-separated directories in
  56.     # which relevant library files are to be found.  To the
  57.     # directories listed in libdirs are added any directories found in
  58.     # the ILIBS environment variable.
  59.  
  60.     proc_table := table()
  61.     too_many_table := table()
  62.  
  63.     # Put all command-line option paths, and ILIBS paths, into one sorted
  64.     # list.  Then get the names of all .icn filenames in those paths.
  65.     every fname := !get_icn_filenames(getlibpaths(a)) do {
  66.     # For each .icn filename, open that file, and find all procedure
  67.     # calls in it.
  68.     if not (lib_file := open(fname, "r")) then
  69.         write(&errout,"Can't open ",fname," for reading.")
  70.     else {
  71.         # Find all procedure calls in lib_file.
  72.         every elem := !get_procedures(lib_file,fname) do {
  73.         /proc_table[elem.name] := set()
  74.         insert(proc_table[elem.name],elem)
  75.         }
  76.         close(lib_file)
  77.     }
  78.     }
  79.  
  80.     every elem := key(proc_table) do {
  81.     if *proc_table[elem] > 1 then {
  82.         write("\"", elem, "\" is defined in ",*proc_table[elem]," places:")
  83.         every tmp := !proc_table[elem] do {
  84.         write("     ",tmp.file, ", line ",tmp.lineno)
  85.         }
  86.     }
  87.     }
  88.  
  89. end
  90.  
  91.  
  92.  
  93. procedure getlibpaths(ipl_paths)
  94.  
  95.     # Unite command-line args and ILIBS environment variable into one
  96.     # path list.
  97.  
  98.     local i, path
  99.  
  100.     # Make sure all paths have a consistent format (one trailing slash).a
  101.     if *\ipl_paths > 0 then {
  102.     every i := 1 to *ipl_paths do {
  103.         ipl_paths[i] := fixup_path(ipl_paths[i])
  104.     }
  105.     ipl_paths := set(ipl_paths)
  106.     }
  107.     else ipl_paths := set()
  108.  
  109.     # If the ILIBS environment variable is set, read it into
  110.     # ipl_paths.  Spaces - NOT COLONS - are used as separators.
  111.     getenv("ILIBS") ? {
  112.     while path := tab(find(" ")) do {
  113.         insert(ipl_paths, fixup_path(path))
  114.         tab(many(' '))
  115.     }
  116.     insert(ipl_paths, fixup_path(tab(0)))
  117.     }
  118.  
  119.     return sort(ipl_paths)
  120.  
  121. end
  122.  
  123.  
  124.  
  125. procedure fixup_path(s)
  126.     # Make sure paths have a consistent format.
  127.     return "/" ~== (trim(s,'/') || "/")
  128. end
  129.  
  130.  
  131.  
  132. procedure get_procedures(intext,fname)
  133.  
  134.     # Extracts the names of all procedures declared in file f.
  135.     # Returns them in a list, each of whose elements have the
  136.     # form record procedure_stats(procedurename, filename, lineno).
  137.  
  138.     local psl, f_pos, line_no, line
  139.     static name_chars
  140.     initial {
  141.     name_chars := &ucase ++ &lcase ++ &digits ++ '_'
  142.     }
  143.  
  144.     # Initialize procedure-name list, line count.
  145.     psl := list()
  146.     line_no := 0
  147.  
  148.     # Find procedure declarations in intext.
  149.     while line := read(intext) & line_no +:= 1 do {
  150.     take_out_comments(line) ? {
  151.         if tab(match("procedure")) then {
  152.         tab(many(' \t')) &
  153.             put(psl, procedure_stats(
  154.                 "main" ~== tab(many(name_chars)), fname, line_no))
  155.         }
  156.     }
  157.     }
  158.  
  159.     return psl   # returns empty list if no procedures found
  160.  
  161. end
  162.  
  163.  
  164.  
  165. procedure take_out_comments(s)
  166.  
  167.     # Commented-out portions of Icon code - strip 'em.  Fails on lines
  168.     # which, either stripped or otherwise, come out as an empty string.
  169.     #
  170.     # BUG:  Does not handle lines which use the _ string-continuation
  171.     # notation.  Typically take_out_comments barfs on the next line.
  172.  
  173.     local i, j, c, c2, s2
  174.  
  175.     s ? {
  176.     tab(many(' \t'))
  177.     pos(0) & fail
  178.         find("#") | (return trim(tab(0),' \t'))
  179.     match("#") & fail
  180.     (s2 <- tab(find("#"))) ? {
  181.         c2 := &null
  182.         while tab(upto('\\"\'')) do {
  183.         case c := move(1) of {
  184.             "\\"   : {
  185.             if match("^")
  186.             then move(2)
  187.             else move(1)
  188.             }
  189.             default: {
  190.             if \c2
  191.             then (c == c2, c2 := &null)
  192.             else c2 := c
  193.             }
  194.         }
  195.         }
  196.         /c2
  197.     }
  198.     return "" ~== trim((\s2 | tab(0)) \ 1, ' \t')
  199.     }
  200.  
  201. end
  202.  
  203.  
  204.  
  205. procedure get_icn_filenames(lib_paths)
  206.  
  207.     # Return the names of all .icn files in all of the paths in the
  208.     # list lib_paths.  The dir routine used depends on which OS we
  209.     # are running under.
  210.  
  211.     local procedure_stat_list
  212.     static get_dir
  213.     initial get_dir := set_getdir_by_os()
  214.  
  215.     procedure_stat_list := list()
  216.     # Run through every possible path in which files might be found,
  217.     # and get a list of procedures contained in those files.
  218.     every procedure_stat_list |||:= get_dir(!lib_paths)
  219.  
  220.     return procedure_stat_list
  221.  
  222. end
  223.  
  224.  
  225.  
  226. procedure set_getdir_by_os()
  227.  
  228.     if find("UNIX", &features)
  229.     then return unix_get_dir
  230.     else if find("MS-DOS", &features)
  231.     then return msdos_get_dir
  232.     else stop("Your operating system is not (yet) supported.")
  233.  
  234. end
  235.  
  236.  
  237.  
  238. procedure msdos_get_dir(dir)
  239.     local temp_name, filename
  240.  
  241.     # Returns a sorted list of all filenames (full paths included) in
  242.     # directory "dir."  The list is sorted.  Fails on invalid or empty
  243.     # directory.  Aborts if temp file cannot be opened.
  244.     #
  245.     # Temp files can be directed to one or another directory either by
  246.     # manually setting the variable temp_dir below, or by setting the
  247.     # value of the environment variable TEMPDIR to an appropriate
  248.     # directory name.
  249.  
  250.     local in_dir, filename_list, line
  251.     static temp_dir
  252.     initial {
  253.         temp_dir := 
  254.             (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
  255.                 ".\\"
  256.     }
  257.  
  258.     # Get name of tempfile to be used.
  259.     temp_name := get_dos_tempname(temp_dir) |
  260.     stop("No more available tempfile names!")
  261.  
  262.     # Make sure we have an unambiguous directory name, with backslashes
  263.     # instead of UNIX-like forward slashes.
  264.     dir := trim(map(dir, "/", "\\"), '\\') || "\\"
  265.  
  266.     # Put dir listing into a temp file.
  267.     system("dir "||dir||" > "||temp_name)
  268.  
  269.     # Put tempfile entries into a list, removing blank- and
  270.     # space-initial lines.  Exclude directories (i.e. return file
  271.     # names only).
  272.     in_dir := open(temp_name,"r") |
  273.     stop("Can't open temp file in directory ",temp_dir,".")
  274.     filename_list := list()
  275.     every filename := ("" ~== !in_dir) do {
  276.         match(" ",filename) | find(" <DIR>", filename) & next
  277.     filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
  278.     if filename ? (tab(find(".ICN")+4), pos(0))
  279.     then put(filename_list, map(dir || filename))
  280.     }
  281.  
  282.     # Clean up.
  283.     close(in_dir) & remove(temp_name)
  284.  
  285.     # Check to be sure we actually managed to read some files.
  286.     if *filename_list = 0 then fail
  287.     else return sort(filename_list)
  288.  
  289. end
  290.  
  291.  
  292.  
  293. procedure get_dos_tempname(dir)
  294.    local temp_name, temp_file
  295.  
  296.     # Don't clobber existing files.  Get a unique temp file name for
  297.     # use as a temporary storage site.
  298.  
  299.     every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
  300.     temp_file := open(temp_name,"r") | break
  301.         close(temp_file)
  302.     }
  303.     return \temp_name
  304.  
  305. end
  306.  
  307.  
  308.  
  309. procedure unix_get_dir(dir)
  310.    local filename_list, in_dir, filename
  311.  
  312.     dir := trim(dir, '/') || "/"
  313.     filename_list := list()
  314.     in_dir := open("/bin/ls -F "||dir, "pr")
  315.     every filename := ("" ~== !in_dir) do {
  316.     match("/",filename,*filename) & next
  317.     if filename ? (not match("s."), tab(find(".icn")+4), pos(0))
  318.     then put(filename_list, trim(dir || filename, '*'))
  319.     }
  320.     close(in_dir)
  321.  
  322.     if *filename_list = 0 then fail
  323.     else return filename_list
  324.  
  325. end
  326.