Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
Problem:
If the inventory total is less than 50, add a string of two asterisks (**) at the end of the written row to notify the inventory manager that more inventory is needed. If the inventory total is less than 10, add a string of five asterisks (*****) at the end of the row to let the inventory manager know the need for more inventory is urgent.
How would I make a string of asterisks in Cobol?
How would I make a string of asterisks in Cobol?
There are two methods.
The first controls the number of characters at the destination and works best when the data item is initialized before the move. The second controls the number of characters at the source and works best when initialization of the destination is of no concern or when used as part of a STRING statement.
Method 1:
move all "*" to data-name-1 (1:number-of-asterisks)
For example:
program-id. aster.
data division.
working-storage section.
1 n pic 99.
1 asterisk-line pic x(10) value space.
procedure division.
begin.
perform varying n from 10 by -1 until n < 1
move all "*" to asterisk-line (1:n)
display asterisk-line
move space to asterisk-line
end-perform
stop run
.
Output:
**********
*********
********
*******
******
*****
****
***
**
*
Notice that the program moves spaces to clear the destination after displaying the asterisks. This is prevent too many asterisks from showing on the following lines.
Method 2:
move asterisks (1:number-of-asterisks) to data-name-1
For example:
program-id. aster2.
data division.
working-storage section.
1 n pic 99.
1 asterisks pic x(10) value all "*".
1 asterisk-line pic x(10) value space.
procedure division.
begin.
perform varying n from 10 by -1 until n < 1
move asterisks (1:n) to asterisk-line
display asterisk-line
end-perform
stop run
.
The output is the same as above.
Notice there is no need to move spaces (or initialize) the destination before moving the asterisks.
Related
What am I doing wrong with the following piece of code under GnuCOBOL 3.1-rc1.0?
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMTEST.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM PIC 999V99.
PROCEDURE DIVISION.
DISPLAY "ENTER NUMBER: ".
ACCEPT NUM.
DISPLAY "NUMBER = ".
DISPLAY NUM.
STOP RUN.
I enter 123.45 as my input. I'm expecting 123.45 as the output, but instead I get 123.40
These are plain ACCEPTs, they only read in data from the command line (you can also enter a big lorem ipsum there).
While I think it is a reasonable request to have this working "as expected" the best option you currently have is ACCEPTing only PIC X and then use MOVE FUNCTON NUMVAL (INPUT-DATA) TO NUM (maybe test the data with FUNCTION TEST-NUMVAL() before). For DISPLAY you likely want an edited field with a PICTURE like ZZ9.99.
In any case: be aware that V is an implied decimal point, it is not part of the actual storage.
Using "extended" screenio (= input not from the command line) gives some benefits (like only allowing numeric data and not more than the fields's size) but has different culprits (for example you should use COLUMN/LINE for it and numeric ACCEPT still has some issues in GC 3.1).
As suggested by JoelFan I've tested edited fields - these work currently only correctly when in "command line mode" (so not if any attributes like positioning is used):
PROGRAM-ID. NUMTEST.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM-INP PIC 999.99.
01 NUM PIC 999V99.
01 NUM-OUT PIC zz9.99.
PROCEDURE DIVISION.
DISPLAY "ENTER NUMBER: ".
ACCEPT NUM-INP.
DISPLAY "NUMBER = ".
MOVE NUM-INP TO NUM
MOVE NUM TO NUM-OUT
DISPLAY NUM "/" NUM-OUT.
STOP RUN.
Producing the expected result:
ENTER NUMBER:
123.45
NUMBER =
123.45/123.45
ENTER NUMBER:
1.2
NUMBER =
001.20/ 1.20
ENTER NUMBER:
a
NUMBER =
000.00/ 0.00
ENTER NUMBER:
1234567
NUMBER =
567.00/567.00
Note: the third case should actually raise an exception when compiled with -fec=all / -debug (currently doesn't), the last case is completely correct as numbers are right justified.
Still: ACCEPTing alphanumeric data, do explicit checks/conversions, and display as edited field like NUM-OUT above is the safest option.
From my understanding when using UNSTRING, the use of ON OVERFLOW [INSTRUCTION] will be useful if there would be an overflow in the use of the UNSTRING.
But if there is no overflow, why would you use NOT ON OVERFLOW [INSTRUCTION] ?
The only possible utility to the NOT ON OVERFLOW [INSTRUCTION] would be to pass an instruction if there is no overflow but what would be the use of that if you already had the expected result from the UNSTRING ?
Is there any concrete example of how this could be useful in this example :
IDENTIFICATION DIVISION.
PROGRAM-ID. YOUR-PROGRAM-NAME.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VAR1 PIC A(11) VALUE "Hello World".
01 WS-VAR2 PIC A(5).
01 WS-VAR3 PIC A(5).
01 WS-COMPTEUR PIC 9 VALUE 2.
PROCEDURE DIVISION.
MAIN-PROCEDURE.
INTO WS-VAR2 WS-VAR3
WITH POINTER WS-COMPTEUR
ON OVERFLOW DISPLAY "This string is too large"
END-UNSTRING.
DISPLAY WS-VAR2
DISPLAY WS-VAR3.
STOP RUN.
END PROGRAM YOUR-PROGRAM-NAME.
Even when I read IBM documentation, it doesn't give me much explanation as to what could be used in this instance but to display a message ?
IBM Documentation : link
From my understanding when using UNSTRING, the use of ON OVERFLOW
phrase will be useful if there would be an overflow in the use
of the UNSTRING.
But if there is no overflow, why would you use NOT ON OVERFLOW
phrase ?
The only possible utility to the NOT ON OVERFLOW phrase would
be to pass an instruction if there is no overflow but what would be
the use of that if you already had the expected result from the
UNSTRING ?
In COBOL 74 there was no NOT ON OVERFLOW phrase. Therefore, it was necessary to use either a GO TO statement or set a flag for testing in an immediately following IF statement. The NOT ON OVERFLOW phrase and END-UNSTRING were added in COBOL 85 to to improve program structure.
For your example, I made some changes to first display WS-VAR1 then the result of the UNSTRING. Note that the OVERFLOW condition concerns the number of items and not the length of the text. I ran three tests to show the results
IDENTIFICATION DIVISION.
PROGRAM-ID. YOUR-PROGRAM-NAME.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VAR1 PIC A(11) VALUE "Hello World".
01 WS-VAR2 PIC A(5).
01 WS-VAR3 PIC A(5).
PROCEDURE DIVISION.
MAIN-PROCEDURE.
MOVE SPACE TO WS-VAR2 WS-VAR3
DISPLAY WS-VAR1
UNSTRING WS-VAR1
DELIMITED SPACE
INTO WS-VAR2 WS-VAR3
ON OVERFLOW
DISPLAY
"Incorrect number of items in WS-VAR1 - expected 2"
NOT ON OVERFLOW
DISPLAY WS-VAR2
DISPLAY WS-VAR3
END-UNSTRING
STOP RUN.
END PROGRAM YOUR-PROGRAM-NAME.
Results:
Hello World
Hello
World
--
Hello
Incorrect number of items in WS-VAR1 - expected 2
--
Hello W rld
Incorrect number of items in WS-VAR1 - expected 2
As may be seen in the code, ON OVERFLOW is used for error processing; NOT ON OVERFLOW is used for normal processing. Without the improved structure from NOT ON OVERFLOW, normal processing would immediately follow the error processing, unless one used the previously mentioned COBOL 74 type processing.
Note that DELIMITED ALL SPACE gives a different result than that shown for one case, above. [Ignore the --]
--
Hello
Hello
--
You can use the "NOT ON OVERFLOW " statement if you need to call a PROCEDURE to validate this sentence for example SORT-COLORS.
MOVE 0 TO COUNT-1.
UNSTRING COLOR-LIST
DELIMITED BY ":" OR "/" OR ALL SPACE
*DELIMIT-1 and COUNT-1 will hold only
*the values associated with COLOR-1.
INTO COLOR-1
DELIMITER IN DELIMIT-1
COUNT IN COUNT-1,
COLOR-2,
COLOR-3,
COLOR-4
ON OVERFLOW
DISPLAY "overflow: unstring colors"
NOT ON OVERFLOW
*do when UNSTRING succeeds.
PERFORM **SORT-COLORS**
END-UNSTRING.
*COLOR-1 = "RED "
*COLOR-2 = "BLUE "
*COLOR-3 = "GREEN "
*COLOR-4 = "YELLOW"
*DELIMIT-1 = ": "
*COUNT-1 = 3 count-1 holds the number of characters in RED
You can see more examples on this link https://supportline.microfocus.com/documentation/acucorpproducts/docs/v6_online_doc/gtman3/gt36141.htm
On practice if youy need to discovery if your command(unsting) are executed with sucess withou a IF you can use this statement to define it.
An example using your aplication
IDENTIFICATION DIVISION.
PROGRAM-ID. YOUR-PROGRAM-NAME.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VAR1 PIC A(11) VALUE "Hello World".
01 WS-VAR2 PIC A(5).
01 WS-VAR3 PIC A(5).
01 WS-COMPTEUR PIC 9 VALUE 2.
PROCEDURE DIVISION.
MAIN-PROCEDURE.
INTO WS-VAR2 WS-VAR3
WITH POINTER WS-COMPTEUR
ON OVERFLOW
PERFORM RT-SEND-ERROR-MAIL
NOT ON OVERFLOW
PERFORM RT-SEND-SUCESS-MAIL
END-UNSTRING.
DISPLAY WS-VAR2
DISPLAY WS-VAR3.
STOP RUN.
END PROGRAM YOUR-PROGRAM-NAME.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 6 years ago.
Improve this question
I am working with GnuCOBOL(Using Windows) and I need to write a compiler with it.
What i am asking is - given directory path, can i modify the files inside of it
using COBOL? It is important to say that you can't know the files names. You know only the path of the directory which contains them.
Here is some code for POSIX systems
identification division.
program-id. SAMPLE.
environment division.
configuration section.
repository.
function all intrinsic.
data data division.
working-storage section.
01 dir usage pointer.
01 dent usage pointer.
01 dirent based.
05 filler pic x(19). *> HERE BE DRAGONS
05 entname pic x(256).
05 filler pic x(237).
01 sayname pic x(256).
*> ************************************************
code procedure division.
call "opendir" using
by content z"."
returning dir
on exception
display "error: no opendir found" upon syserr end-display
bail stop run returning 1
end-call
if dir not equal null then
call "readdir" using
by value dir
returning dent
end-call
perform until dent equal null
*> set address of the based dirent and pull out the name
set address of dirent to dent
initialize sayname
string entname delimited by x"00" into sayname end-string
display trim(sayname TRAILING) end-display
call "readdir" using
by value dir
returning dent
end-call
end-perform
call "closedir" using by value dir end-call
else
call "perror" using by content z"" returning omitted end-call
bail stop run returning 1
end-if
done goback.
end program SAMPLE.
Originally posted to SourceForge, licensed under the GPL. Due to the assumption on sizing of dirent you'd want to duff the code over a little bit before unleashing it on the unwary.
I have an array of 5 elements and each of the elements holds a character. I want to accept user input in one line. For example: ABCDE. And I intend element 1 of the array to have A and element 2 of the array to have B and so on. Could someone help with this? I have attached the relevant portions of the code below:
environment division.
input-output section.
file-control.
select standard-input assign to keyboard.
select standard-output assign to display.
data division.
file section.
fd standard-input.
01 stdin-record pic x(80).
fd standard-output.
01 stdout-record pic x(80).
working-storage section.
01 input-area.
02 inputCharacters pic x(1) occurs 5 times.
01 print-line.
02 inputCharacters pic x(1) occurs 5 times.
procedure division.
open input standard-input, output standard-output.
read standard-input into input-area
at end
close standard-input, standard-output
end-read.
write
stdout-record from print-line after advancing 5 line
end-write
stop run.
MOVE input-area TO print-line
For the code you have, you could also do this:
write
stdout-record from input-area after advancing 5 line
end-write
If you don't need two copies of a table (COBOL doesn't really have "arrays" in the way you're probably used to) then don't have two copies.
If you do have two tables, I'd suggest making the item names different. If you don't, you're making things tougher by having to use "qualification" to make the references unique.
MOVE inputCharacters ( 1 ) OF input-area
TO inputCharacters ( 1 ) OF print-line
Instead of
MOVE inputCharacters ( 1 )
TO outputCharacters ( 1 )
If you don't mind qualification yourself, you may find that colleagues or future maintainers hate it.
I'm not quite sure what you want to happen with this:
read standard-input into input-area
at end
close standard-input, standard-output
end-read.
You only do one read, you you'll only get at end when there is no data (whatever that means with keyboard). In that case, you don't have data to do anything with.
You should look at how to use FILE STATUS for each file. Check the file-status field after each IO, and I'd also recommend using the file-status field for end-of-file checking, rather than the cumbersome AT END.
However, as I said, I don't know what that means with keyboard... so perhaps that won't work :-)
With this code, I get
16: Perform stmnt not terminated by end-perform
33: syntax error, unexpected end-perform
Why is it saying that I need an end-perform and also not need it?
identification division.
program-id. xxx.
* will accept and display a num until 0 is called then
* asks to go again
data division.
file section.
working-storage section.
01 num pic 9(4).
01 hold pic 9(4).
01 another pic x.
procedure division.
perform until another = 'N' (line 16)
Display "Another Session (Y/N)? "
with no advancing
if another = 'Y'
Display "Enter a 4-digit unsigned number (0 to stop): "
with no advancing
accept num
move num to hold
perform until num = 0
Display "Enter a 4-digit unsigned number (0 to stop): "
with no advancing
accept num
if num <> 0
move num to hold
end-perform.
display space
Display "The last number entered: "hold
End-perform. (Line 33)
stop run.
end-perform.
display space
Display "The last number entered: "hold
End-perform. (Line 33)
It's that full-stop/period (Line 30) which is the killer.
Although since the 1985 Standard COBOL is much more relaxed about full-stops/periods, a single one will bring all current scopes screaming to a halt. You could have nesting 50 levels deep, and one single full-stop/period would end them all, in one fell swoop.
My advice is to use the absolute minimum of full-stop/periods in the PROCEDURE DIVISION.
That is: one to terminate the PROCEDURE DIVISION header; one to terminate each paragraph/SECTION label; one to terminate a paragrpah/SECTION; one to terminate a program (for a program with no paragraphs/SECTIONS). Also, if you have PROCEDURE DIVISION COPY or REPLACE statements, you'll need full-stops/periods to terminate those.
Except for the termination of the labels I put each full-stop/period on a line of its own, never attached to any code. I can then move code around and insert code without worrying about whether I need to add/remove a full-stop/period.
As to why you need END-PERFORM, it is an "inline PERFORM". Syntactically, an inline PERFORM requires an END-PERFORM, but your use of the full-stop/period caused termination of the PERFORM scope before the END-PERFORM was located, so the error on line 16. Subsequently an END-PERFORM unconnected to a PERFORM was located, so the error on line 33.
It is important when putting error messages in your questions that you include the error message exactly as you see it. Copy/paste, don't re-trype, please. Include any message numbers, as well.
You absolutely can not mix the full stop "." scope terminator from Cobol-74 with the End-* scope terminators from Cobol-85.
The difference is that the full stop "." terminates ALL scopes.
The End-* terminates only the most recent scope, just like you might expect.
Putting a "." in the middle of code with End-* is kinda like dropping a nuclear bomb in the middle of it. As a rule, for compilers made in the last quarter century or so, a period should only occur in the procedure division at the end of a paragraph name, or at the end of a paragraph (and sections too, but those are useless in an age where segmentation and overlays are managed by the operating system). I like to use "EXIT." or "CONTINUE." just to highlight that I'm using one of the bad-nasty-best-avoided-periods in the procedure division.