 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
   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
      TEST_I_3 is              -2
           
      TEST_I_1 is               1
           
      TEST_L_1 is .true.
           
 Source File Macro Processor Page      2

      TEST_I_2 is               2
           
      TEST_S_1 is type string
       string with embeded blanks and blanks at each end
           
      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 	integer*4 next_label(0:9)/10000,1000,100,10,1,50000,5000,500,50,5/
  302 	common/integer_constants/next_label
  303 
  304 	integer*4 res_error,res_integer,res_logical,res_string
  305 	parameter (res_error=0,res_integer=1,res_logical=2)
  306 	parameter (res_string=3)
  307 *page
 Source File Macro Processor Page     10

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

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

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

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

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

  539 	test of file output directives
  540 	open(append code as open and append use mostof same code)
  541 	append
  542 	close
  543 	redirect
  544 *append(1,'nl:')
  545 *redirect(1)
  546 *close(0)
  547 *append(2,'test.src')
  548 *redirect(2)
  549 code appended to channel 2
  550 *redirect(1)
  551 *close(2)
  552 *append(0,'test.src')
  553 *redirect(0)
  554 code appended to channel 0
  555 *close(1)
  556 *end
