home *** CD-ROM | disk | FTP | other *** search
/ The Best of Select: Windows 95 Special 1 / WINDOWS95_1.ISO / utils / w32-rex / regina / srccode / trip / limits.rex < prev    next >
OS/2 REXX Batch file  |  1993-08-25  |  7KB  |  211 lines
  1. /*
  2.  *  The Regina Rexx Interpreter
  3.  *  Copyright (C) 1992  Anders Christensen <anders@solan.unit.no>
  4.  *
  5.  *  This program is free software; you can redistribute it and/or modify
  6.  *  it under the terms of the GNU General Public License as published by
  7.  *  the Free Software Foundation; either version 2 of the License, or
  8.  *  (at your option) any later version. 
  9.  *
  10.  *  This program is distributed in the hope that it will be useful,
  11.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13.  *  GNU General Public License for more details.
  14.  *
  15.  *  You should have received a copy of the GNU General Public License
  16.  *  along with this program; if not, write to the Free Software
  17.  *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  */
  19.  
  20.  
  21. written = 0 
  22.  
  23. call notify 'args'
  24. /*----- At least 10 arguments to functions and procedures -------------*/
  25.    call ch echoargs( 1,2,3,4,5,6,7,8,9,0 ), '1 2 3 4 5 6 7 8 9 0'
  26.  
  27.  
  28. call notify 'levels'
  29. /*
  30.  * Note: the limit 100 refers to the nesting of control structures, 
  31.  * which _includes_ function calls. Consequently, other things, like 
  32.  * loops and SELECTs may also count. Thus, make sure this is outside
  33.  * any such loops. Maybe even external functions count (sigh!)
  34.  */
  35. tag = 1
  36. call nesting
  37. signal after_nesting
  38.  
  39. nesting:
  40.    if tag = 100 then 
  41.       return
  42.  
  43.    tag = tag + 1
  44.    call nesting
  45.    return
  46.  
  47. after_nesting:
  48.  
  49.  
  50. call notify 'comments'
  51. /*----- At least 10 levels of nesting in comments ---------------------*/
  52. /*1 /*2 /*3 /*4 /*5 /*6 /*7 /*8 /*9 /*  10  */ */ */ */ */ */ */ */ */ */
  53.  
  54.  
  55. call notify 'strings'
  56. /*----- At least 100 in source code -----------------------------------*/
  57. string = '.........1.........2.........3.........4.........5.........6.........7.........8.........9.........!'
  58.  
  59. if length(string)^=100 then
  60.    call complain 'String seems to have been truncated in src code'
  61.  
  62. d = '.........'
  63. s = d'1'd'2'd'3'd'4'd'5'd'6'd'7'd'8'd'9'd'!'
  64. if s^==string then
  65.    call complain 'Something is wrong with large strings in src code'
  66.  
  67.  
  68. call notify 'hexstrings'
  69. /*----- At least 100 chars in resulting string ------------------------*/
  70. istring = 'hstring = "00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f',
  71.                      '10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f',
  72.                      '20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f',
  73.                      '30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f',
  74.                      '40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f',
  75.                      '50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f',
  76.                      '60 61 62 63"X'
  77.  
  78. signal on syntax name syntax_hex_1
  79.  
  80. interpret istring
  81.  
  82. syntax_hex_1:
  83. if hstring^==xrange('00'x, '63'x) then
  84.    call complain 'Hexstring seems to mismatch real value'
  85.  
  86. if length(hstring)^=100 then
  87.    call complain 'Hexstring seems to have been truncated' 
  88.  
  89.  
  90. istring = 'bstring = "00000000 00000001 00000010 00000011',
  91.                      '00000100 00000101 00000110 00000111',
  92.                      '00001000 00001001 00001010 00001011',
  93.                      '00001100 00001101 00001110 00001111',
  94.                      '00010000 00010001 00010010 00010011',
  95.                      '00010100 00010101 00010110 00010111',
  96.                      '00011000 00011001 00011010 00011011',
  97.                      '00011100 00011101 00011110 00011111',
  98.                      '00100000 00100001 00100010 00100011',
  99.                      '00100100 00100101 00100110 00100111',
  100.                      '00101000 00101001 00101010 00101011',
  101.                      '00101100 00101101 00101110 00101111',
  102.                      '00110000 00110001"b'
  103. signal on syntax name syntax_bin_1
  104. interpret istring
  105.  
  106. syntax_bin_1:
  107. if bstring^==xrange('00'x, '31'x) then
  108.    call complain 'Binstring seems to mismatch read value'
  109.  
  110. if length(bstring)^==50 then
  111.    call complain 'Binstring seems to have been truncated'
  112.  
  113.  
  114.  
  115. /*--------------------------------------------------------------------*/
  116. /* Let's check some of the inplementation minimums                    */
  117. /*--------------------------------------------------------------------*/
  118. call notify 'symbols'
  119.  
  120. /*----- The Standard requires 50 significant chars in variablenames --*/
  121. FiftyCharactersInVariableNamesAreAnAbsoluteMinimum = 'foo'
  122. FiftyCharactersInVariableNamesAreAnAbsoluteMinimun = 'bar'
  123. if FiftyCharactersInVariableNamesAreAnAbsoluteMinimum = ,
  124.    FiftyCharactersInVariableNamesAreAnAbsoluteMinimun then
  125.    call complain 'Less than 50 significant chars in symbolnames'
  126.  
  127. /*----- And in compound symbols too ----------------------------------*/
  128. drop characters in variable names is a minimum ! ?
  129. Fifty.Characters.In.Variable.Names.Is.A.Minimum.?! = 'foo'
  130. Fifty.Characters.In.Variable.Names.Is.A.Minimum.?? = 'bar'
  131. if Fifty.Characters.In.Variable.Names.Is.A.Minimum.?? = ,
  132.    Fifty.Characters.In.Variable.Names.Is.A.Minimum.?! then
  133.       call complain 'Less than 50 significant chars in compound symbols'
  134. /*----- And also in numbers ------------------------------------------*/
  135. if 0000000000000000000000000123.4560000000000000E789 ^= 123.456E789 then
  136.    call complain 'Leading and trailing zeros not stripped correctly'
  137.  
  138. if 123.45600000000000000000000000000000000000003E789 ^= 123.456E789 then
  139.    call complain 'Numbers of length 50 not correctly interpreted'
  140.  
  141. signal afterargs
  142.  
  143. echoargs:
  144.    do i=1 to arg()
  145.       if i=1 then
  146.          result = arg(1)
  147.       else
  148.          result = result arg(i)
  149.       end
  150.    return result 
  151.  
  152.  
  153. afterargs:
  154.  
  155.  
  156. /*----- substituted tail should take at least 50000 -------------------*/
  157.  
  158. drop foo. 
  159. foo.bar = ''
  160. junk = copies( 'x', 49998 ) ;
  161. do i=1 to 2
  162.   idx = junk'.'i
  163.  
  164.   if (foo.idx \== 'FOO.'idx) then
  165.      complain 'Didn''t take long tail in compound variables'
  166.  
  167.   foo.idx = i 
  168.   end
  169.  
  170. if (1+foo.junk.1 \== foo.junk.2) then
  171.    call complain 'Didn''t differ between long tail compound variables'
  172.  
  173. drop foo. junk idx
  174.  
  175.    say ' '
  176. exit 0
  177.  
  178.  
  179. ch: procedure expose sigl 
  180.    parse arg first, second
  181.    if first ^== second then do
  182.       say
  183.       say 'first  = /'first'/'
  184.       say 'second = /'second'/'
  185.       say "FuncTrip: error in " sigl":" sourceline(sigl) ; end
  186.    return
  187.  
  188.  
  189. notify:
  190.    parse arg word .
  191.    written = written + length(word) + 2
  192.    if written>75 then do
  193.       written = length(word)
  194.       say ' '
  195.    end
  196.    call charout , word || ', '
  197.    return
  198.  
  199.  
  200. error:
  201.    say 'Error discovered in function insert()'
  202.    return
  203.  
  204. complain:
  205.    say ' ...'
  206.    say 'Tripped in line' sigl':' 'ARG'(1)'.'
  207.    length = charout(,'   (')
  208. return
  209.  
  210.  
  211.