home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol079 / ptest.pli < prev    next >
Text File  |  1984-04-29  |  1KB  |  58 lines
  1. ptest: proc options(main);    /* parse procedures tester */
  2.     %replace
  3.        TRUE by '1'b,
  4.        FALSE by '0'b;
  5.  
  6.     dcl fcbptr ptr;
  7.         
  8.     dcl bufptr ptr;
  9.         
  10.  
  11.     dcl 1 fcb based(fcbptr),
  12.           2 drive fixed(7),
  13.           2 name char(8),
  14.           2 type char(3),
  15.           2 ext(4) fixed(7);
  16.  
  17.  
  18.     dcl cmdtail char(127) based(bufptr);
  19.  
  20.     dcl
  21.         parse entry(ptr,ptr,fixed(7)),
  22.         fparse entry(ptr,ptr,fixed(7));
  23.  
  24.  
  25.     dcl
  26.         UPPERCASE      char(26) static init('ABCDEFGHIJKLMNOPQRSTUVWXYZ'),
  27.         LOWERCASE      char(26) static init('abcdefghijklmnopqrstuvwxyz'),
  28.         module         fixed(7) static init(0),
  29.         retcode        fixed(7) static init(0);
  30.  
  31.     /* base fcb at default fcb (5CH), cmdtail at default buffer (80H) */
  32.     unspec(fcbptr) = '005C'b4;
  33.     unspec(bufptr) = '0081'b4;
  34.     
  35.         do while(module < 1 | module > 2);
  36.         put skip list('Test: (1) PARSE, (2) FPARSE ? ');
  37.         get list (module);
  38.         end;
  39.  
  40.     if fcb.name = '' then do;
  41.             put skip list ('Enter Files: ');
  42.         get edit (cmdtail) (a);
  43.         cmdtail = translate(cmdtail,UPPERCASE,LOWERCASE);
  44.         end;
  45.  
  46.         do while(retcode = 0);
  47.         if module = 1 then
  48.             call parse(bufptr,fcbptr,retcode);
  49.         else
  50.             call fparse(bufptr,fcbptr,retcode);
  51.         if retcode > 1 then
  52.             put skip(2) list('Invalid Filename');
  53.         else
  54.             put skip list('File:',drive,name,type,ext(1));
  55.         end;
  56.  
  57.     end ptest;
  58.