<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"> Source File Macro Processor Page      1

    1 *comment
    2 	This is a demostration and test of the macro preprocessor
    3 	in action. This text will only be seen in the generated
    4 	list `file.
    5 *endcomment
    6 	test set 1
    7 		expression analysis
    8 		set command
    9 		comment command
   10 		replace command
   11 		delete command
   12 		page command
   13 		substitutions
   14 		dump_command
   15 		error command
   16 		default command
   17 		remove command
   18 *error ('This is a test of the error directive-you should not see any others')
      This is a test of the error directive-you should not see any others
          18 HSC000$DUA1:[LEVINE.SYS.MACRO_F]TEST.MCR;74 
       
   19 *set(test_l_1=.true.)
   20 *set(test_l_2=.false.)
   21 *set(test_i_1=1)
   22 *set(test_i_2=+2)
   23 *set(test_i_3=-2)
   24 *set(test_s_1=' string with embeded blanks and blanks at each end ')
   25 *if(test_l_1.ne..true.)
   26 	*error ('Test 1.1 failed')
   27 *endif
   28 *if($test_l_2$.ne..false.)
   29 	*error('Test 1.2 failed')
   30 *endif
   31 *if(.false.)
   32 	*error('Test 1.3 failed')
   33 *elseif(test_i_1.ne.1)
   34 	*error( 'Test 1.4 failed')
   35 *endif
   36 *if(test_i_2.ne.2)
   37 	*error( 'Test 1.5 failed')
   38 *endif
   39 *if(test_i_3.eq.-2)
   40 *else
   41 	*error('Test 1.6 failed')
   42 *endif
   43 *if(test_s_1.eq.' string with embeded blanks and blanks at each end ')
   44 *else
   45 	*error(' Test 1.7 failed')
   46 *endif	
   47 *comment
   48 	dump command in list `file only
   49 *endcomment
   50 *dump
      DATE is type string
       5-SEP-91
           
      TEST_I_3 is              -2
 Source File Macro Processor Page      2

           
      TEST_I_1 is               1
           
      TEST_L_1 is .true.
           
      VAX is type string
      VAX
           
      VMS is type string
      VMS
           
      FILE is type string
      HSC000$DUA1:[LEVINE.SYS.MACRO_F]TEST.MCR;74
           
      TEST_I_2 is               2
           
      TIME is type string
      13:36:42
           
      TEST_S_1 is type string
       string with embeded blanks and blanks at each end
           
      LANGUAGE is type string
      NONE
           
      TEST_L_2 is .false.
           
   51 *replace(test_i_2=test_i_2+1)
   52 *if(test_i_2.ne.3)
   53 	*error('Test 1.8 failed')
   54 *endif
   55 *delete(test_l_1)
   56 *delete(test_l_2)
   57 *delete(test_i_1)
   58 *delete(test_i_2)
   59 *delete(test_i_3)
   60 *delete(test_s_1)
   61 *set(a=1)
   62 *default(a=.true.)
   63 *default(b=.false.)
   64 *if(type(a).ne.'INTEGER')
   65 	*error('Test 1.9 failed')
   66 *endif
   67 *if(b.ne..false.)
   68 	*error('Test 1.10 failed')
   69 *endif
   70 *remove(a)
   71 *remove(b)
   72 *remove(c)
   73 *comment
   74 	deleted all  symbols
   75 *endcomment
   76 *page
 Source File Macro Processor Page      3

   77 *comment
   78 	start of new page
   79 *endcomment
   80 	test 2 
   81 	list command
   82 	reset command
   83 	substitutions
   84 *list(list_test)
   85 line 1
   86 	line 2
   87 		line 3
   88 			line 4
   89 				line 5
   90 					line 6
   91 						line 7
   92 							line 8
   93 *endlist
   94 *set(l_1='$list_test$')
   95 *set(l_2='$list_test$')
   96 *set(l_3='$list_test$')
   97 *set(l_4='$list_test$')
   98 *set(l_5='$list_test$')
   99 *set(l_6='$list_test$')
  100 *set(l_7='$list_test$')
  101 *set(l_8='$list_test$')
  102 *set(l_9='$list_test$')
  103 *set(l_10='$list_test$')
  104 *reset(list_test)
  105 *set(l_11='$list_test$')
  106 *reset(list_test)
  107 *if(l_1.ne.list_test)
  108 	*error('Test 2.1 failed')
  109 *elseif(l_2.ne.list_test)
  110 	*error('Test 2.2 failed')
  111 *elseif(l_3.ne.list_test)
  112 	*error('Test 2.3 failed')
  113 *elseif(l_4.ne.list_test)
  114 	*error('Test 2.4 failed')
  115 *elseif(l_5.ne.list_test)
  116 	*error('Test 2.5 failed')
  117 *elseif(l_6.ne.list_test)
  118 	*error('Test 2.6 failed')
  119 *elseif(l_7.ne.list_test)
  120 	*error('Test 2.7 failed')
  121 *elseif(l_8.ne.list_test)
  122 	*error('Test 2.8 failed')
  123 *elseif(l_9.ne.list_test)
  124 	*error('Test 2.9 failed')
  125 *elseif(l_10.ne.list_test)
  126 	*error('Test 2.10 failed')
  127 *else
  128 	*reset(list_test)
  129 *endif
  130 *if(l_11.eq.list_test)
  131 *else
  132 	*error('Test 2.11 failed')
  133 *endif
 Source File Macro Processor Page      4

  134 *delete(list_test)
  135 *delete(l_1)
  136 *delete(l_2)
  137 *delete(l_3)
  138 *delete(l_4)
  139 *delete(l_5)
  140 *delete(l_6)
  141 *delete(l_7)
  142 *delete(l_8)
  143 *delete(l_9)
  144 *delete(l_10)
  145 *delete(l_11)
  146 *mlist(a,b,c,d)
  147 '123'	'4567' '891'	'defg'	'hij'
  148 '`'aa'	'11111'
  149 'defg'
  150 ''	''	'123'
  151 *endmlist
  152 a	b	c	D
  153 a	b	c	D
  154 a	b	c	D
  155 a	b	c	D
  156 a	b	c	D
  157 *delete(a)
  158 *delete(b)
  159 *delete(c)
  160 *delete(d)
  161 *page
 Source File Macro Processor Page      5

  162 	test 3
  163 	macro facility
  164 
  165 *macro(test_macro)
  166 	line 1
  167 		line 2 test_sub
  168 			line 3
  169 *endmacro
  170 *set(test_sub=.TRUE.)
  171 *domacro(test_macro)
  172 *delete(test_sub)
  173 *domacro(test_macro)(test_sub='addendum')
  174 *delete(test_macro)
  175 *macro(test)
  176 *default(a=.true.)
  177 *default(b=.false.)
  178 *if(type(a)$.ne.'STRING')
  179 	*error('macro a')
  180 *endif
  181 *if($type(b).ne.'LOGICAL')
  182 	*error('macro b')
  183 *endif
  184 *endmacro
  185 *domacro(test)(a='string')
  186 *remove(test)
  187 *page
 Source File Macro Processor Page      6

  188 	test 4
  189 	if simple and complex
  190 	evaluation of simple expressions
  191 *set(test_true=.true.)
  192 *set(test_false=.false.)
  193 *if(.true.)
  194 	this line should print out-simple if ok
  195 *else
  196 	*error('Test 4.1 failed')
  197 *endif
  198 *if(.false.)
  199 	*error ('Test 4.2 failed')
  200 *else
  201 	else test ok
  202 *endif
  203 *if(test_false)
  204 	*error('Test 4.3 failed')
  205 *elseif(test_true)
  206 	elseif test ok
  207 *else
  208 	*error( 'Test 4.3 failed at else')
  209 *endif
  210 *if(test_false)
  211 	*error('Test 4.4 failed at if')
  212 *elseif(.false.)
  213 	*error('Test 4.4 failed at first elseif')
  214 *elseif(test_true)
  215 	second if-elseif test ok
  216 *else
  217 	*error('Test 4.4 failed at else')
  218 *endif
  219 *if(.true.)
  220 	level-1 nested if-ok
  221 	*if(.true.)
  222 		level-2 nested if-ok
  223 	*elseif(.true.)
  224 		*error('Test 4.5 failed at level 2 elseif')
  225 	*else
  226 		*error('Test 4.5 failed at level 2 else')
  227 	*endif
  228 	back to level 1
  229 *elseif(.true.)
  230 	*error('Test 4.5 failed at level 1 elseif')
  231 *endif
  232 *if(test_false)
  233 	*error('Test 4.6 failed at if')
  234 *elseif(test_true)
  235 	passed substitution in if test
  236 *else
  237 	*error('Test 4.6 failed at else')
  238 *endif
  239 *set(test_1=1)
  240 *set(test_2=test_1+1)
  241 *set(test_3='abC')
  242 *if(test_1.eq.1)
  243 	if with numeric compare passed ok
  244 *else
 Source File Macro Processor Page      7

  245 	*error('Test 4.7 failed')
  246 *endif
  247 *if(test_false.eq..false.)
  248 	passed logical compare
  249 *else
  250 	*error('Test 4.8 failed')
  251 *endif
  252 *if(test_3.eq.'abc')
  253 	*ERROR('Test 4.9 failed at if')
  254 *elseif(test_3.eq.'abC')
  255 	passed string compare
  256 *else
  257 	*error('Test 4.9 failed at else')
  258 *endif
  259 *if(test_2.ne.2)
  260 	*error('Test 4.10 failed')
  261 *else
  262 	complex set ok
  263 *endif
  264 
  265 *delete(test_1)
  266 *delete(test_2)
  267 *delete(test_3)
  268 *delete(test_true)
  269 *delete(test_false)
  270 *page
 Source File Macro Processor Page      8

  271 	set up do loop tests
  272 *set(limit1=-1)
  273 *set(limit2=+1)
  274 *set(limit3=0)
  275 *do (i=limit1,limit2)
  276 	x($i$)=y(i$+5)
  277 	*do (j=limit2,limit1)
  278 		z($i,j)=i+j
  279 	*enddo
  280 *enddo
  281 *do (i=-5,5,3)
  282 	x(i)=i
  283 *enddo
  284 *do (i=limit1-1,limit2+1,limit3+1)
  285 	i
  286 *enddo
  287 *delete(limit1)
  288 *delete(limit2)
  289 *delete(limit3)
  290 *page
 Source File Macro Processor Page      9

  291 	include one of the macro programs include `files here for a test
  292 *include(parameters.inc)
  293 	integer*4 max_line_length,max_argument
  294 	parameter (max_line_length=132)	! max i/o line length
  295 	parameter (max_argument=10)	! max macro arguments
  296 
  297 	character*1 quote_char,directive_char
  298 	character*1 sub_char,esc_char
  299 	common/character_constants/quote_char,directive_char,sub_char,
  300 	1	esc_char
  301 	save /character_constants/
  302 	integer*4 next_label(0:9)
  303 	common/integer_constants/next_label
  304 	logical l_case_sensitive
  305 	common/logical_constants/l_case_sensitive
  306 	save /logical_constants/
  307 	integer*4 res_error,res_integer,res_logical,res_string
  308 	parameter (res_error=0,res_integer=1,res_logical=2)
  309 	parameter (res_string=3)
  310 *page
 Source File Macro Processor Page     10

  311 	option command
  312 	label_command
  313 	error command
  314 *option(quote_char=+)
  315 *set(temp_1=+message useing alternate quote char+)
  316 temp_1
  317 *option(quote_char=')
  318 *set(temp_2='message useing default quote char')
  319 temp_2
  320 *option(directive_char=+)
  321 +set(temp_3='message useing alternate directive character')
  322 temp_3
  323 +option(directive_char=*)
  324 *option(sub_char=+)
  325 *set(test_sub='abc-def')
  326 	useing alternate sustitution char-&gt;+test_sub+&lt;-
  327 *option(sub_char=$)
  328 *option(l_output=.false.)
  329 	this line should not appear in the output (.SRC.) `file
  330 *option(l_output=.true.)
  331 *option(l_list=.false.)
  332 *option(l_sub=.false.)
  333 	subs disabled -&gt;test_sub
  334 *option(l_sub=.true.)
  335 	subs enabled  -&gt;test_sub
  336 *option(l_show=.true.)
  337 *do (i=1,2)
  338 	j=i
  339 	*do( k=-1,-2)
  340 		l=k
  341 	*enddo
  342 *enddo
      	j=1
      		l=-1
      		l=-2
      	j=2
      		l=-1
      		l=-2
  343 *option(l_show=.false.)
  344 	test of automatic unique label_generation and starting value set
  345 label
  346 label0
  347 label1
  348 label2
  349 label3
  350 label4
  351 label5
  352 label6
  353 label7
  354 label8
  355 label9
  356 label
  357 label0
  358 label1
  359 label2
  360 label3
  361 label4
 Source File Macro Processor Page     11

  362 label5
  363 label6
  364 label7
  365 label8
  366 label9
  367 *option(next_label=1)
  368 label
  369 label
  370 label0
  371 label0
  372 *option(next_label0=10)
  373 label
  374 label
  375 label0
  376 label0
  377 *option(next_label1=15)
  378 label1
  379 label1
  380 *option(next_label2=15)
  381 label2
  382 label2
  383 *option(next_label3=15)
  384 label3
  385 label3
  386 *option(next_label4=15)
  387 label4
  388 label4
  389 *option(next_label5=15)
  390 label5
  391 label5
  392 *option(next_label6=15)
  393 label6
  394 label6
  395 *option(next_label7=15)
  396 label7
  397 label7
  398 *option(next_label8=15)
  399 label8
  400 label8
  401 *option(next_label9=15)
  402 label9
  403 label9
  404 	test of escape char and option to change
  405 ``
  406 `label:
  407 *option(escape_char=\)
  408 \\
  409 \label:
  410 *option(escape_char=`)
  411 *delete(temp_1)
  412 *delete(temp_2)
  413 *delete(temp_3)
  414 *page
 Source File Macro Processor Page     12

  415 	test of def and type functions
  416 *if($def(test_sub)$)
  417 *else
  418 	*error('Test 7.1 failed')
  419 *endif
  420 *if($def(sub_test)$)
  421 	*error('Test 7.2 failed')
  422 *endif
  423 *set(t_1=.true.)
  424 *set(t_2=123)
  425 *set(t_3='a string')
  426 *set(s_1=$type(t_1)$)
  427 *set(s_2=$type(t_2)$)
  428 *set(s_3=$type(t_3)$)
  429 *set(s_4=$type(t_4)$)
  430 *if(s_1.ne.'LOGICAL')
  431 	*error('Test 7.3 failed')
  432 *endif
  433 *if(s_2.ne.'INTEGER')
  434 	*error('Test 7.4 failed')
  435 *endif
  436 *if(s_3.ne.'STRING')
  437 	*error('Test 7.5 failed')
  438 *endif
  439 *if(s_4.ne.'UNKNOWN')
  440 	*error('Test 7.6 failed')
  441 *endif
  442 *set(a='abc')
  443 *if($length(a)$.ne.3)
  444 	*error('Test 7.7 failed')
  445 *endif
  446 *replace(a=.true.)
  447 *if($length(a)$.ne.6)
  448 	*error('Test 7.8 failed')
  449 *endif
  450 *replace(a=1234)
  451 *if($length(a)$.ne.4)
  452 	*error('Test 7.9 failed')
  453 *endif
  454 *delete (a)
  455 *list(a)
  456 1
  457 2
  458 3
  459 4
  460 5
  461 6
  462 7
  463 8
  464 9
  465 *endlist
  466 *if(length(a).ne.9)
  467 	*error('Test 7.10 failed')
  468 *endif
  469 *delete(a)
  470 *macro(a)
  471 	a
 Source File Macro Processor Page     13

  472 	b
  473 	c
  474 	d
  475 *endmacro
  476 *if($length(a)$.ne.4)
  477 	*error('Test 7.11 failed')
  478 *endif
  479 *delete(a)
  480 *delete(test_sub)
  481 *delete(t_1)
  482 *delete(t_2)
  483 *delete(t_3)
  484 *delete(s_1)
  485 *delete(s_2)
  486 *delete(s_3)
  487 *delete(s_4)
  488 *page
 Source File Macro Processor Page     14

  489 	test of detabbing functions and coresponding options
  490 	Line	handled	with	no	detabbing,	Tabbed	between	words
  491 *option(L_DETAB=.true.)
  492 	Line	handled	with		detabbing,	Tabbed	between	words
  493 *option(L_DETAB=.false.)
  494 	Line	handled	with	no	detabbing,	Tabbed	between	words
  495 *option(l_detab=.true.)
  496 *option(tab=-1)
  497 *option(tab=-9)
  498 *option(tab=-17)
  499 *option(tab=-25)
  500 *option(tab=-33)
  501 *option(tab=-41)
  502 *option(tab=-49)
  503 *option(tab=-57)
  504 *option(tab=-65)
  505 *option(tab=-73)
  506 *option(tab=-81)
  507 *option(tab=5)
  508 *option(tab=10)
  509 *option(tab=15)
  510 *option(tab=20)
  511 *option(tab=25)
  512 *option(tab=30)
  513 *option(tab=35)
  514 *option(tab=40)
  515 *option(tab=45)
  516 *option(tab=50)
  517 *option(tab=55)
  518 *option(tab=60)
  519 *option(tab=65)
  520 *option(tab=70)
  521 *option(tab=75)
  522 *option(tab=80)
  523 *option(tab=85)
  524 *option(tab=90)
  525 tabed line should line up as shown
  526     v    v    v    v    v    v    v    v    v    v    v    v    v    v    v    v
  527 	^	^	^	^	^	^	^	^	^	^	^	^	^	^	^	^
  528 FORTRAN tab convention test
  529 *option(l_fortran=.true.)
  530 *option(l_detab=.false.)
  531 	First	line	with	no	detab
  532 	1 second	line 	with	no	detab
  533 *option(l_detab=.true.)
  534 	First	line	with	detab
  535 	1 second	line	with	detab
  536 test the tab reset option-tabed line show line up as shown
  537 *option(tab=0)
  538 *option(l_fortran=.false.)
  539         v       v       v       v       v       v       v       v
  540 	^	^	^	^	^	^	^	^
  541 *page
 Source File Macro Processor Page     15

  542 	test of `file output directives
  543 	open(append code as open and append use mostof same code)
  544 	append
  545 	close
  546 	redirect
  547 *append(1,'nl:')
  548 *redirect(1)
  549 *close(0)
  550 *append(2,'test.src')
  551 *redirect(2)
  552 code appended to channel 2
  553 *redirect(1)
  554 *close(2)
  555 *append(0,'test.src')
  556 *redirect(0)
  557 code appended to channel 0
  558 *close(1)
  559 *end
</pre></body></html>