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->+test_sub+<- 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 ->test_sub 334 *option(l_sub=.true.) 335 subs enabled ->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