I am looking to nest two loops together. I want to find the largest integer that is divisible from 1 to 20 evenly. My code for the program is as follows:
IDENTIFICATION DIVISION.
PROGRAM-ID. EULER3.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 startNum PIC 9(10) VALUE 380.
01 counter PIC 9(2).
01 check PIC 9(1) VALUE 0.
01 finalVal PIC 9(10)
PROCEDURE DIVISION.
MAIN-PROCEDURE.
PERFORM whileLoop UNTIL check = 1.
DISPLAY "Largest number divisible by 19 thru 20 " startNum.
STOP RUN.
whileLoop.
SET counter TO 11.
DISPLAY counter.
PERFORM forLoop UNTIL counter = 20
forLoop.
IF FUNCTION MOD(startNum, counter) = 0
IF counter = 19
SET finalVal TO startNum.
ADD 1 TO check.
ELSE
ADD 20 TO startNum
ADD 1 TO counter.
END-IF.
And the Console is:
jdoodle.cobc:30: warning: line not terminated by a newline
jdoodle.cobc:9: error: syntax error, unexpected PROCEDURE, expecting EXTERNAL or EXTERNAL-FORM or GLOBAL or IDENTIFIED
jdoodle.cobc:10: error: PROCEDURE DIVISION header missing
jdoodle.cobc:10: error: syntax error, unexpected Identifier
jdoodle.cobc: in paragraph 'whileLoop':
jdoodle.cobc:21: error: 'forLoop' is not defined
jdoodle.cobc:19: error: invalid expression
jdoodle.cobc:26: error: syntax error, unexpected ELSE
jdoodle.cobc:30: error: syntax error, unexpected END-IF
jdoodle.cobc:19: error: 'forLoop' is not defined
I am not sure why it is saying I don't have a procedure division. I have written my program in Python and used this method, hence why I have named my areas forLoop and whileLoop.
I may have missed some other syntax errors.
01 finalVal PIC 9(10) add a final period.
SET finalVal TO startNum. remove the period.
ADD 1 TO check. remove the period.
ADD 20 TO startNum add an END-IF
ADD 1 TO counter. remove the period.
Related
I have a program which reads a GDG file and moves data to working storage. I am interested to know if it can be made to repeat this process for multiple generations of the GDG using a reference to the file definition. Perhaps there is a way to use subscripts on the file definition? My thought is there must be a method to move different file definitions into a reference variable from which to access the files.
Code Sample based on suggested, setenv solution
FILE-CONTROL.
SELECT DATAIN ASSIGN TO UT-S-DATAIN.
DATA DIVISION.
FILE-SECTION.
FD DATAIN
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 133 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS DATA-REC.
01 DATA-REC PIC X(133).
WORKING-STORAGE SECTION.
01 ENV-VARS.
02 ENV-NAME PIC X(9).
02 ENV-VALUE PIC X(100).
02 ENV-OVERWRITE PIC S9(8) COMPUTATIONAL VALUE 1.
PROCEDURE DIVISION.
MOVE Z"DATAIN" TO ENV-NAME
MOVE Z"DSN(PROGRAMMER.TEST.GDGFILE(-1)),SHR" TO ENV-VALUE
MOVE 1 TO ENV-OVERWRITE
CALL "setenv" USING ENV-NAME ENV-VALUE ENV-OVERWRITE.
Notes
Pay special attention when moving DSN value to ENV-VALUE. On my first swing I left out the closing parentheses, most likely because of JCL muscle memory.
Be sure to empty out your DD statement in JCL/Step.
In mainframe COBOL, the FD refers to a SELECT which refers to a DD statement attached to the EXEC PGM statement for your program in the invoking JCL. The DD statement may refer to one or many GDGs. This is determined at compile time.
What I think you are asking for is dynamic allocation of a file at runtime. There are a couple of ways to accomplish that, one is BPXWDYN.
Identification Division.
Program-ID. SOMETEST.
Environment Division.
Input-Output Section.
File-Control.
Select MY-FILE Assign SYSUT1A.
Data Division.
File Section.
FD MY-FILE
Record 80
Block 0
Recording F.
01 MY-FILE-REC PIC X(080).
Working-Storage Section.
01 CONSTANTS.
05 BPXWDYN-PGM PIC X(008) VALUE 'BPXWDYN '.
05 ALCT-LIT-PROC PIC X(035)
VALUE 'ALLOC FI(SYSUT1A) SHR MSG(WTP) DSN('.
05 FREE-LIT-PROC PIC X(016)
VALUE 'FREE FI(SYSUT1A)'.
05 A-QUOTE PIC X(001) VALUE "'".
01 WORK-AREAS.
05 WS-DSN PIC X(044) VALUE 'MY.GDG.BASE'.
05 WS-GDG-NB PIC 999 VALUE ZEROS.
05 BPXWDYN-PARM.
10 PIC S9(004) COMP-5 VALUE +100.
10 BPXWDYN-PARM-TXT PIC X(100).
Procedure Division.
* Construct the allocation string for BPXWDYN.
MOVE SPACES TO BPXWDYN-PARM-TXT
STRING
ALCT-LIT-PROC
DELIMITED SIZE
WS-DSN
DELIMITED SPACE
'(-'
DELIMITED SIZE
WS-GDG-NB
DELIMITED SIZE
')'
DELIMITED SIZE
INTO
BPXWDYN-PARM-TXT
END-STRING
CALL BPXWDYN-PGM USING
BPXWDYN-PARM
END-CALL
IF RETURN-CODE = 0
CONTINUE
ELSE
[error handling]
END-IF
[file I/O with MY-FILE]
MOVE SPACES TO BPXWDYN-PARM-TXT
MOVE FREE-LIT-PROC TO BPXWDYN-PARM-TXT
CALL BPXWDYN-PGM USING
BPXWDYN-PARM
END-CALL
IF RETURN-CODE = 0
CONTINUE
ELSE
[error handling]
END-IF
GOBACK.
This is just freehand, so there may be a syntax error, but I hope I've made the idea clear.
There is another technique, using the C RTL function setenv, documented by IBM here. It looks like it might be simpler but I've never done it that way.
We have to find more than one way to get the ascii value of a character.
On top of that we also need to get the sum of all the characters's ascii values.
I currently have the below and works alright for the first section where you need individual values
.
I just need to know if there is an easier way or a function to do this in Cobol?
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-COUNTERS.
03 WS-COUNTER PIC 9(05).
03 WS-INPUT PIC X(01).
03 WS-DISPLAY PIC 9(03).
01 W1-ARRAY.
03 ALPHABETIC-CHARS OCCURS 26 TIMES PIC X.
01 W3-ARRAY.
03 NUMERIC-CHARS OCCURS 26 TIMES PIC X.
PROCEDURE DIVISION.
A000-MAIN SECTION.
BEGIN.
PERFORM B000-INITIALIZE.
PERFORM C000-PROCESS UNTIL WS-COUNTER > 26.
PERFORM D000-END.
A099-EXIT.
STOP RUN.
B000-INITIALIZE SECTION.
ACCEPT WS-INPUT.
MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO W1-ARRAY.
MOVE "01234567890000000000000000" TO W3-ARRAY.
MOVE 1 TO WS-COUNTER.
MOVE 0 TO WS-DISPLAY.
B099-EXIT.
EXIT.
C000-PROCESS SECTION.
C001-BEGIN.
IF WS-INPUT IS NUMERIC
IF NUMERIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 48 - 1
END-IF
ELSE
IF ALPHABETIC-CHARS(WS-COUNTER) = WS-INPUT
COMPUTE WS-DISPLAY = WS-COUNTER + 65 - 1
END-IF
END-IF.
ADD 1 TO WS-COUNTER.
C099-EXIT.
EXIT.
Have a look at FUNCTION ORD and keep in mind that you will get the ordinal number in the program's collating sequence (which may be EBCDIC or not the full ASCII).
As this function was introduced in the COBOL85 standard it should be available in most compilers (your question misses the compiler/machine you use).
With Microsoft COBOL Compiler version 2.2 and I have this code that completely worked fine.
IDENTIFICATION DIVISION.
PROGRAM-ID. COCENTRY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT COC-FILE
ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS COCNO
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD COC-FILE LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "COC.DAT".
01 COC-RECORD.
03 COCNO PIC 9(5).
03 COCDESC PIC X(40).
WORKING-STORAGE SECTION.
01 FILE-STATUS PIC XX.
01 ESC-CODE PIC 99 VALUE 0.
88 ESC-KEY VALUE 1.
88 F2 VALUE 3.
88 F10 VALUE 11.
01 ERRMSG PIC X(70) VALUE SPACES.
01 ERR PIC 9 VALUE 0.
SCREEN SECTION.
01 FORM1.
03 BLANK SCREEN BACKGROUND-COLOR 1.
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
03 LINE 25 COLUMN 1 PIC X(70) FROM ERRMSG HIGHLIGHT.
01 FORM2.
03 LINE 1 COLUMN 14 PIC 9(5)
USING COCNO REVERSE-VIDEO.
03 LINE 2 COLUMN 14 PIC X(40)
USING COCDESC REVERSE-VIDEO.
03 LINE 24 COLUMN 1 PIC 99
USING ESC-CODE.
PROCEDURE DIVISION.
MAIN.
OPEN I-O COC-FILE.
IF FILE-STATUS NOT = '00'
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE.
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
CLOSE COC-FILE.
STOP RUN.
ENTRY1.
MOVE SPACES TO COC-RECORD.
MOVE ZEROES TO COCNO.
ENTRY2.
DISPLAY FORM1 FORM2.
ACCEPT FORM2.
ACCEPT ESC-CODE FROM ESCAPE KEY.
IF F10
MOVE 'Entries canceled...' TO ERRMSG
GO ENTRY1
ELSE IF F2
GO ENTRY3
ELSE IF ESC-KEY
GO ENTRYX
ELSE
GO ENTRY2.
ENTRY3.
MOVE 0 TO ERR.
WRITE COC-RECORD INVALID KEY MOVE 1 TO ERR.
IF ERR = 1
MOVE 'Duplicate key not allowed...' TO ERRMSG
GO ENTRY2
ELSE
MOVE 'Entries recorded...' TO ERRMSG
GO ENTRY1.
ENTRYX.
EXIT.
Now I am using OpenCobol IDE 4.3.0 having GNUCobol version 1.1.0 and I am being prompted with this lines of
syntax error, unexpected "Literal", expecting LEADING or TRAILING
03 LINE 1 COLUMN 1 'COCNO'.
03 LINE 2 COLUMN 1 'COCDESC'.
03 LINE 24 COLUMN 1 "Esc=Exit F2=Save F10=Cancel".
So I fix them by adding VALUE keyword:
03 LINE 1 COLUMN 1 VALUE 'COCNO'.
03 LINE 2 COLUMN 1 VALUE 'COCDESC'.
03 LINE 24 COLUMN 1 VALUE "Esc=Exit F2=Save F10=Cancel".
but as soon as I do this I get a another prompt of
'ACCEPT .. FROM ESCAPE KEY' not implemented
on this line
ACCEPT ESC-CODE FROM ESCAPE KEY.
What could be the possible cause of this? And what could be the fix for this?
Your actual answer is here, https://sourceforge.net/p/open-cobol/discussion/help/thread/26a01c5f/, on the GnuCOBOL part of SourceForge. With minor changes your code will "completely work" with the change you've already made to include the VALUE clause, and if you use release 2.0 or higher of the GnuCOBOL compiler.
Your code may "completely work" but it is spaghetti code.
The term comes from the old days, and relates to the use of many branches in programs, a common practice at that time, but which made trying to follow the logic a process like trying to follow one strand of cooked spaghetti which is part of a pile of cooked spaghetti.
If you change this:
PERFORM ENTRY1 THRU ENTRYX UNTIL ESC-KEY.
To this:
PERFORM ENTRY1 THRU ENTRYX.
Your program will still work. Confused? Yes, because you have spaghetti. Your program flow will only ever get to ENTRYX once. The value when it arrives at ENTRYX is ESC-KEY, but that is superfluous, because it can only ever get there once, when it is ESC-KEY. Clear? No? Because you have spaghetti.
Here is your logic, re-written:
PROCEDURE DIVISION.
OPEN I-O COC-FILE
IF FILE-STATUS NOT = '00'
[the following code is a horror. Deal with this outside the
program. Crash for an unexpected FILE STATUS on OPEN]
OPEN OUTPUT COC-FILE
CLOSE COC-FILE
OPEN I-O COC-FILE
END-IF
PERFORM PROCESS-USER-INPUT
UNTIL ESC-KEY
CLOSE COC-FILE
IF FILE-STATUS NOT = '00'
[something bad has happened, so don't go quietly]
END-IF
GOBACK
.
PROCESS-USER-INPUT.
PERFORM BLANK-OUTPUT-RECORD
PERFORM PROCESS-COC
UNTIL ESC-KEY
.
PROCESS-COC.
DISPLAY FORM1 FORM2
ACCEPT FORM2
ACCEPT ESC-CODE FROM ESCAPE KEY
EVALUATE TRUE
WHEN F10
MOVE 'Entries canceled...' TO ERRMSG
WHEN F2
PERFORM CREATE-OUTPUT
END-EVALUATE
.
CREATE-OUTPUT.
WRITE COC-RECORD
IF ATTEMPT-TO-WRITE-DUPLICATE [22 on the FILE STATUS field]
MOVE 'Duplicate key not allowed...' TO ERRMSG
ELSE
MOVE 'Entries recorded...' TO ERRMSG
PERFORM BLANK-OUTPUT-RECORD
END-IF
.
BLANK-OUTPUT-RECORD.
MOVE SPACES TO COC-RECORD
MOVE ZEROES TO COCNO
.
Does that make your program look simpler? Easier to follow, change, understand what it does when someone else looks at it (or when you do in two weeks time)?
There are other things, like why set COC-RECORD to space, and then COCNO to zero? Move the spaces to COCDESC.
Make your data/procedure names good and descriptive. FILE STATUS having a good name (don't call it FILE-STATUS) and one per file when you have more than one file. Use full-stops/periods only where you have to, and use scope-delimiters for all conditional constructs that you use. Use FILE STATUS checking for all IO, and don't use the tortuous AT on IO.
If you look now the first code in your program is quite long, executes only once, and is (should be) irrelevant to the business function of your program. So stick all that in a paragraph, and PERFORM that. Same for the close. Then you can have as much code as you need when starting up and closing down, without making your program more difficult to follow.
The screen and keyboard I/O was a MicroSoft Cobol specific flavor. You will likely need to tweak that a bit to make it work with OpenCobol.
PROCEDURE DIVISION.
SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'.
SET ENVIRONMENT 'COB_SCREEN_ESC' TO 'Y'.
Escape: IF cob-crt-status = 2005......
Enter: IF cob-crt-status = 0........
F1: IF cob-crt-status = 1001......
F2: IF cob-crt-status = 1002......
I am trying to make the program below to pull out records that have customer names beginning with letter the "M" and write the records to a temporary file. The program runs but it won't write records to the output file. I debugged the code, and it seems like the code line "WRITE MAST2-RECORD" never runs. It skips this line of code.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS M-ACCT-NUM.
SELECT MAST2-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE2.IND.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD MAST-FILE
LABEL RECORDS ARE STANDARD.
01 MAST-RECORD.
05 M-ACCT-NUM PIC X(4).
05 M-CUSTOMER-NAME PIC X(15).
05 M-DAYS-OVERDUE PIC 99.
05 M-BALANCE-DUE PIC 999V99.
FD MAST2-FILE
LABEL RECORDS ARE STANDARD.
01 MAST2-RECORD PIC X(50).
WORKING-STORAGE SECTION.
01 COUNTER PIC 9.
01 PROGRAM-DATA-ITEMS.
05 WRITE-OK PIC X VALUE 'Y'.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN OUTPUT MAST-FILE
OUTPUT MAST2-FILE
PERFORM 20-LOAD-MAST-FILE
CLOSE MAST-FILE
MAST2-FILE
STOP RUN.
20-LOAD-MAST-FILE.
PERFORM 30-INPUT-INDEX
PERFORM UNTIL M-ACCT-NUM = 0 OR WRITE-OK = 'N'
PERFORM 40-WRITE-FILE
PERFORM 50-FIND-CUSTOMER-START-WITH-M
PERFORM 30-INPUT-INDEX
END-PERFORM.
30-INPUT-INDEX.
DISPLAY 'ENTER ACCOUNT NUMBER (0 TO QUIT): ' WITH NO ADVANCING
ACCEPT M-ACCT-NUM.
40-WRITE-FILE.
DISPLAY ' ENTER CUSTOMER NAME: ' WITH NO ADVANCING
ACCEPT M-CUSTOMER-NAME
DISPLAY ' ENTER DAYS OVERDUE: ' WITH NO ADVANCING
ACCEPT M-DAYS-OVERDUE
DISPLAY ' ENTER BALANCE DUE: ' WITH NO ADVANCING
ACCEPT M-BALANCE-DUE
WRITE MAST-RECORD
INVALID KEY
MOVE 'N' TO WRITE-OK
DISPLAY 'ERROR ' MAST-RECORD
END-WRITE.
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
end program Program1.
You are looking for blank-M-blank, across the entire record.
What you say you want to do is fine customer-names which begin with M.
05 M-CUSTOMER-NAME.
10 M-CUSTOMER-NAME-FIST-CHARACTER PIC X.
88 M-CUSTOMER-NAME-START-M VALUE "M".
If you use that definition in place of what you have, and use the 88 in the test for your write, you should get what you want.
Eg replace:
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
By:
50-FIND-CUSTOMER-START-WITH-M.
IF M-CUSTOMER-NAME-START-M
WRITE MAST2-RECORD
END-IF
.
Simpler, easier to understand, so easier to maintain.
You should consider the possible "validity" of your names. In a good system, there will be no leading blanks. In a poor system there may be.
To deal with that, test the first byte of the customer-name for being space as well, if so, test the customer-name for entirely space. If not entirely space, loop until you find the first non-blank. Test that first non-blank for M. So in this case you have two tests.
You can assess the quality of your data separately by copying and cutting-down this program and reporting/outputting where the first byte of the customer-name is blank.
Once you know that, you go to the analyst (tutor) and ask if you need to deal with possible leading blanks. If you don't, keep the test for blank in your actual program, and crash in that case :-)
I'm just learning COBOL; I'm writing a program that simply echos back user input. I have defined a variable as:
User-Input PIC X(30).
Later when I ACCEPT User-Input, then DISPLAY User-Input " plus some extra text", it has a bunch of spaces to fill the 30 characters. Is there a standard way (like Ruby's str.strip!) to remove the extra spaces?
One would hope for a more elegant way of simply trimming text strings
but this is pretty much the standard solution... The trimming part
is done in the SHOW-TEXT paragraph.
*************************************
* TRIM A STRING... THE HARD WAY...
*************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTX.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 USER-INPUT PIC X(30).
01 I PIC S9(4) BINARY.
PROCEDURE DIVISION.
MOVE SPACES TO USER-INPUT
PERFORM SHOW-TEXT
MOVE ' A B C' TO USER-INPUT
PERFORM SHOW-TEXT
MOVE 'USE ALL 30 CHARACTERS -------X' TO USER-INPUT
PERFORM SHOW-TEXT
GOBACK
.
SHOW-TEXT.
PERFORM VARYING I FROM LENGTH OF USER-INPUT BY -1
UNTIL I LESS THAN 1 OR USER-INPUT(I:1) NOT = ' '
END-PERFORM
IF I > ZERO
DISPLAY USER-INPUT(1:I) '# OTHER STUFF'
ELSE
DISPLAY '# OTHER STUFF'
END-IF
.
Produces the following output:
# OTHER STUFF
A B C# OTHER STUFF
USE ALL 30 CHARACTERS -------X# OTHER STUFF
Note that the PERFORM VARYING statement relies on the left to
right evaluation of the UNTIL clause to avoid out-of-bounds
subscripting on USER-INPUT in the case where it contains only
blank spaces.
Use OpenCOBOL 1.1 or greater.
Identification division.
Program-id. 'trimtest'.
*> Compile:
*> cobc -x -free -ffunctions-all TrimTest.cbl
*>
Data division.
Working-Storage Section.
1 myBigStr Pic X(32768) Value Spaces.
Procedure Division.
Display "Enter Something? " With no advancing.
Accept myBigStr.
Display "[" Trim(myBigStr) "]".
Goback.
The trim function also has the options; Leading or Trailing.
cobc -h formore info.
Here's a solution if you work on OpenVMS:
01 WS-STRING-LENGTH PIC S9(04) COMP.
CALL "STR$TRIM" USING BY DESCRIPTOR user_output,
user_input,
BY REFERENCE WS-STRING-LENGTH.
a more general solution:
01 length pic 99.
perform varying length from 1 by 1
until length > 30 or user-input[length] = space
end-perform.
if length > 30
display user-input 'plus some extra text'
else
display user-input[1:length] 'plus some extra text'
end-if.
untested, I don't have a compiler at hand at the moment
There are three ways you can do this.
Use the COBOL functions to determine the string's "length". This is a mix of a couple functions. This is my preferred method, but requires declaring extra variables.
Write your own function to get the "length".
Use knowledge of a "terminating" string. You have to know what key characters indicates an end-of-string, like three spaces or a low-value character.
This example code demonstrates all three.
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTPROG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ONE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 ONE-A-TLY PIC 9(02) VALUE ZERO.
01 ONE-A-LEN PIC 9(02) VALUE ZERO.
01 ONE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 ONE-B-TLY PIC 9(02) VALUE ZERO.
01 ONE-B-LEN PIC 9(02) VALUE ZERO.
01 TWO-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 TWO-A-LEN PIC 9(02) VALUE ZERO.
01 TWO-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 TWO-B-LEN PIC 9(02) VALUE ZERO.
01 THREE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 THREE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 THREE-C PIC X(80) VALUE SPACES.
PROCEDURE DIVISION.
DISPLAY ' -- METHOD ONE -- '
INSPECT FUNCTION REVERSE(ONE-A)
TALLYING ONE-A-TLY FOR LEADING SPACES.
SUBTRACT ONE-A-TLY FROM LENGTH OF ONE-A GIVING ONE-A-LEN.
INSPECT FUNCTION REVERSE(ONE-B)
TALLYING ONE-B-TLY FOR LEADING SPACES.
SUBTRACT ONE-B-TLY FROM LENGTH OF ONE-A GIVING ONE-B-LEN.
DISPLAY ONE-A(1:ONE-A-LEN)
' ' ONE-B(1:ONE-B-LEN)
'.'.
DISPLAY ' -- METHOD TWO -- '
PERFORM VARYING TWO-A-LEN FROM LENGTH OF TWO-A BY -1
UNTIL TWO-A-LEN < 1 OR TWO-A(TWO-A-LEN:1) > SPACE
END-PERFORM.
PERFORM VARYING TWO-B-LEN FROM LENGTH OF TWO-B BY -1
UNTIL TWO-B-LEN < 1 OR TWO-B(TWO-B-LEN:1) > SPACE
END-PERFORM.
DISPLAY TWO-A(1:TWO-A-LEN)
' ' TWO-B(1:TWO-B-LEN)
'.'.
DISPLAY ' -- METHOD THREE, NAIVE -- '
* DELIMITING BY JUST ANY SPACES ISN'T GOOD ENOUGH.
STRING THREE-A DELIMITED BY SPACES
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY SPACES
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
DISPLAY ' -- METHOD THREE, OK -- '
STRING THREE-A DELIMITED BY ' '
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY ' '
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
EXIT-PROG.
STOP RUN.
and the output looks like this:
-- METHOD ONE --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD TWO --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD THREE, NAIVE --
RALPH LIKES.
-- METHOD THREE, OK --
RALPH WIGGAM LIKES LEARNDING.