| Poster |
Thread |
| human |
Posted on: 2008/7/2 9:13 |
Home away from home   Joined: 2007/5/15 From: GERMANY Posts: 1416 |
Re: Example Sample Program for group critique It would be nice to have some markers (for example in column 73 if using fixed format) like perform mf-things MARKMF
perform 85-things MARK85
perform 2002-things MARK02 For Doing things like
cobc -x -Wall -std=mf -inclMark=MARKMF -exclMark=MARK85 -exclMark=MARK02 prog.cob
cobc -x -Wall -std=cobol85 -inclMark=MARK85 -exclMark=MARKMF -exclMark=MARK02 prog.cob
cobc -x -Wall -std=cobol2002 -inclMark=MARK02 -exclMark=MARKMF -exclMark=MARK85 prog.cob (the -exclMark should be commented out, the -inclMark should be commented in) I think ACU had something like that. Has anybody an idea for doing that stuff in free format? With techniques like that we could have samples working on all std's |
|
|
| simrw |
Posted on: 2008/7/2 10:10 |
Webmaster  Joined: 2005/5/31 From: Bad Soden, Germany Posts: 791 |
Re: Example Sample Program for group critique Note that OC (per Cobol standard) also supports floating comments in fixed-format.
That means that the '*>' construct can also be used
in fixed-format with the proviso that the asterisk must
must be on column 7 or greater to be effective. Logical, as in fixed-format, columns 1 - 6 are stripped.
Therefore it is quite valid in fixed-format to put a floating comment construct following a statement on the same line.
Roger
|
|
|
| btiffin |
Posted on: 2008/7/2 16:51 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique Updated justify.cob that compiles without warning for -std mf, cobol85 and cobol2002
>>SOURCE FORMAT IS FIXED
*> **************************************************************
*>
*> Copyright (C) 2008 The OpenCOBOL Project
*>
*> This program is free software; you can redistribute it and/or
*> modify it under the terms of the GNU General Public License as
*> published by the Free Software Foundation; either version 2,
*> or (at your option) any later version.
*>
*> This program is distributed in the hope that it will be
*> useful, but WITHOUT ANY WARRANTY; without even the implied
*> warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
*> PURPOSE. See the GNU General Public License for more details.
*>
*> You should have received a copy of the
*> GNU General Public License along with this software;
*> see the file COPYING. If not, write to
*> the Free Software Foundation, 51 Franklin Street, Fifth Floor
*> Boston, MA 02110-1301 USA
*> **************************************************************
*> Author: Brian Tiffin
*> Date: 01-Jul-2008
*> Purpose: Demonstrate the usage of OpenCOBOL call library
*> C$JUSTIFY, C$TOUPPER, C$TOLOWER
*> Tectonics: cobc -x -Wall justify.cob
*> Using OpenCOBOL 1.1, posted 02-Jul-2008
*> History: 02-Jul-2008, updated to remove warnings
identification division.
program-id. justify.
environment division.
configuration section.
source-computer. IBMPC.
object-computer. IBMPC.
data division.
working-storage section.
01 source-str pic x(80)
value " this is a test of the internal voice communication
- " system".
01 just-str pic x(80).
01 justification pic x.
01 result pic s9(8) comp-5.
procedure division.
move source-str to just-str.
* Left justification
move "L" to justification.
perform demonstrate-justification.
* case change to upper, demonstrate LENGTH verb
call "C$TOUPPER" using just-str
by value length just-str
returning result
end-call.
* Centre
move "C" to justification.
perform demonstrate-justification.
* case change to lower
call "C$TOLOWER" using just-str
by value 80
returning result
end-call.
* Right, default if no second argument
call "C$JUSTIFY" using just-str
returning result
end-call.
move "R" to justification.
perform show-justification.
exit program.
stop run.
*****************************************
demonstrate-justification.
call "C$JUSTIFY" using just-str
justification
returning result
end-call
if result not equal 0 then
display "Problem: " result end-display
stop run
end-if
perform show-justification
.
*****************************************
show-justification.
evaluate justification
when "L" display "Left justify" end-display
when "C" display "Centred (in UPPERCASE)" end-display
when other display "Right justify" end-display
end-evaluate
display "|" source-str "|" end-display
display "|" just-str "|" end-display
display space end-display
.
Thanks once again to Mr. While. Cheers, Brian |
|
|
| btiffin |
Posted on: 2008/7/4 2:42 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique This is probably the last of the samples I'll post here. Standard IO, TRIM, WHEN-COMPILED and a little INSPECT REPLACING.
>>SOURCE FORMAT IS FIXED
*> **************************************************************
*>
*> Copyright (C) 2008 The OpenCOBOL Project
*>
*> This program is free software; you can redistribute it and/or
*> modify it under the terms of the GNU General Public License as
*> published by the Free Software Foundation; either version 2,
*> or (at your option) any later version.
*>
*> This program is distributed in the hope that it will be
*> useful, but WITHOUT ANY WARRANTY; without even the implied
*> warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
*> PURPOSE. See the GNU General Public License for more details.
*>
*> You should have received a copy of the
*> GNU General Public License along with this software;
*> see the file COPYING. If not, write to
*> the Free Software Foundation, 51 Franklin Street, Fifth Floor
*> Boston, MA 02110-1301 USA
*> **************************************************************
*>
*> **************************************************************
*> * Standard IO programming with OpenCOBOL *
*> **************************************************************
*> Author: Brian Tiffin
*> Date: 04-Jul-2008
*> Tectonics: cobc -x standardio.cob
*> Usage: ./standardio
*> or ./standardio <input >output
*> Notes:
*> OpenCOBOL executables can use normal stdio redirection and
*> with the ENVIROMENT variable extensions can also be used
*> for web CGI server side programming.
IDENTIFICATION DIVISION.
PROGRAM-ID. standard-io.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DATAREC PIC X(80).
01 ENVREC PIC X(32767).
01 DATEREC PIC XXXX/XX/XXBXX/XX/XXXXXXX/XX.
PROCEDURE DIVISION.
*> Get datetime of program compile
MOVE FUNCTION WHEN-COMPILED TO DATEREC.
*> The DISPLAY verb and PICTURE in OpenCOBOL makes output easy.
*> (but, PIC does not allow colons, so ...
*> replace the PIC /'s (after the B) with colons.
INSPECT DATEREC REPLACING ALL "/" BY ":" AFTER INITIAL SPACE.
DISPLAY
"Intrinsic function WHEN-COMPILED returned " DATEREC
END-DISPLAY.
*> OpenCOBOL's DISPLAY verb includes most extended functionality
*> NO ADVANCING supresses the default newline of DISPLAY
DISPLAY "Input: " WITH NO ADVANCING END-DISPLAY.
*> Simple console accept to an 80 character COBOL data record
ACCEPT DATAREC END-ACCEPT.
*> Trim the input for display using an intrinsic funtion
*> TRIM is a new extension from proposed 2008 COBOL standard
DISPLAY "|" FUNCTION TRIM(DATAREC) "|" END-DISPLAY.
*> sysin can also be used, and is the same as the previous accept
DISPLAY "Input: " WITH NO ADVANCING END-DISPLAY.
ACCEPT DATAREC FROM SYSIN END-ACCEPT.
*> Without trimming, OpenCOBOL will display all of DATAREC
*> which is an 80 character alphanumeric field.
DISPLAY "|" DATAREC "|" END-DISPLAY.
*> OpenCOBOL supports the ACCEPT ... FROM ENVIRONMENT
*> and DISPLAY ... UPON ENVIRONMENT extensions.
*> This sample uses bash's usually long ls command coloring var
ACCEPT ENVREC FROM ENVIRONMENT "LS_COLORS" END-ACCEPT.
*> Without the trim, this would display a full 32K field
DISPLAY
"Value of LS_COLORS environment variable is: "
FUNCTION TRIM(ENVREC)
END-DISPLAY.
EXIT PROGRAM.
STOP RUN.
With sample output
$ ./standardio
Intrinsic function WHEN-COMPILED returned 2008/07/04 04:55:5100-04:00
Input: test
|test|
Input: test
|test |
Value of LS_COLORS environment variable is: no=00:fi=00:di=01;34:ln=01;36:pi=40;33:so=01;35:do=01;35: ...
I truncated the env var output so it wouldn't cause too much browser grief for everyone. This may be your last chance for ruthless critiques before these start getting added to OpenCOBOL releases, so ... :) Cheers Brian |
|
|
| btiffin |
Posted on: 2008/7/11 17:30 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique Ok, last one wasn't the last. :)
>>SOURCE FORMAT IS FREE
*> Author: Brian Tiffin for the OpenCOBOL Project
*> and posts from opencobol.org
*> Dated: 11-July-2008
*> Purpose: Count trailing spaces
*> Tectonics: cobc trailingsp.cob
*> cobcrun trailingsp
*> Note: hard loop profiler, results will vary.
IDENTIFICATION DIVISION.
PROGRAM-ID. trailingsp.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 START-PROFILE PIC 9(18).
01 END-PROFILE PIC 9(18).
01 SHOW-PROFILE PIC Z(5)9.
01 TITLE-PROFILE PIC X(18).
01 WAY PIC 9.
01 B-COUNT PIC 999 VALUE 0.
01 TEST-CASE PIC X(80)
VALUE "This is my string.".
PROCEDURE DIVISION.
PERFORM VARYING WAY FROM 1 BY 1
UNTIL WAY > 4
ACCEPT START-PROFILE FROM TIME END-ACCEPT
EVALUATE WAY
WHEN 1
MOVE "PERFORM varying: " TO TITLE-PROFILE
PERFORM ONE-WAY 10000 TIMES
WHEN 2
MOVE "INSPECT reverse: " TO TITLE-PROFILE
PERFORM TWO-WAY 10000 TIMES
WHEN 3
MOVE "INSPECT trailing: " TO TITLE-PROFILE
PERFORM THREE-WAY 10000 TIMES
WHEN 4
MOVE "Trim and length: " TO TITLE-PROFILE
PERFORM FOUR-WAY 10000 TIMES
END-EVALUATE
ACCEPT END-PROFILE FROM TIME END-ACCEPT
SUBTRACT
START-PROFILE FROM END-PROFILE GIVING START-PROFILE
END-SUBTRACT
MOVE START-PROFILE TO SHOW-PROFILE
DISPLAY
TITLE-PROFILE SHOW-PROFILE "ticks, " B-COUNT
END-DISPLAY
END-PERFORM.
GOBACK.
*> ******************************************************************
ONE-WAY.
PERFORM VARYING B-COUNT FROM LENGTH OF TEST-CASE BY -1
UNTIL TEST-CASE(B-COUNT:1) NOT EQUAL SPACE
END-PERFORM
SUBTRACT
B-COUNT FROM LENGTH OF TEST-CASE GIVING B-COUNT
END-SUBTRACT
.
TWO-WAY.
MOVE ZERO TO B-COUNT
INSPECT FUNCTION REVERSE(TEST-CASE)
TALLYING B-COUNT
FOR ALL LEADING ' '
.
THREE-WAY.
MOVE ZERO TO B-COUNT
INSPECT TEST-CASE
TALLYING B-COUNT
FOR TRAILING SPACE
.
FOUR-WAY.
COMPUTE
B-COUNT = LENGTH TEST-CASE - FUNCTION LENGTH(FUNCTION TRIM(TEST-CASE))
END-COMPUTE
.
Results will vary, maybe 0 on a lot of machines.
PERFORM varying: 8ticks, 062
INSPECT reverse: 4ticks, 062
INSPECT trailing: 4ticks, 062
Trim and length: 3ticks, 062
Cheers, Brian |
|
|
| simrw |
Posted on: 2008/7/12 0:29 |
Webmaster Joined: 2005/5/31 From: Bad Soden, Germany Posts: 791 |
Re: Example Sample Program for group critique Whilst this is OK for the defined value
of TEST-CASE, consider the case when the
content of TEST-CASE is unknown.
eg. Set TEST-CASE to SPACES.
In ONE-WAY, you will get undefined results.
In a PERFORM/UNTIL using an index/subscript,
always test (in the UNTIL phrase) the index/subscript for a possible exit condition BEFORE the condition using the
index/subscript.
ie. UNTIL check-index OR condition-using-index.
Also note that OR evaluates left to right and therefore
the above UNTIL conditions can NOT be reversed
(You must check the index BEFORE using the index)
Incidentally, this is one of the most prevalent
mistakes made in Cobol programming.
In FOUR-WAY, careful using FUNCTION TRIM.
The default, with no second param defined, is to trim
leading AND trailing spaces.
So strictly speaking in this example it should be
FUNCTION TRIM (TEST-CASE TRAILING).
Roger
|
|
|
| btiffin |
Posted on: 2008/7/12 1:19 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique Thanks Roger.
I fixed the TRIM, but I don't think I see the problem with ONE-WAY. I think.
LENGTH OF will always return a valid index no? Something that will always be a valid reference for (IND:1)? That code will stop at 1 won't it? For all space? I tested with ZEROES too.
The only weirdness is SPACES and FOUR-WAY returning 79 ?? ... I'm new to the trim bit, but should it return one space or no spaces after a trim?
I definitely have to get used to running more test-cases.
And I still can't rid of the truncation warnings. In this case START-PROFILE to SHOW-PROFILE. Is there a trick for that?
And again, thanks for the heads up.
Cheers,
Brian.
|
|
|
| simrw |
Posted on: 2008/7/12 1:43 |
Webmaster Joined: 2005/5/31 From: Bad Soden, Germany Posts: 791 |
Re: Example Sample Program for group critique Most definitely ONE-WAY has a problem. It relies on undefined behaviour. To demonstrate, replace your definition of TEST-CASE with something like this -
01 MYTEST01.
03 MYFIRSTFLD PIC XXX VALUE SPACES.
03 TEST-CASE PIC X(80) VALUE SPACES.
It will loop. Even worse, the behaviour is also dependent on whether or not B-COUNT is signed. If it is signed you will get a negative reference into MYFIRSTFLD. (Which only eventually terminates as the character in memory preceeding the 01 level is likely not to be space) Roger Roger |
|
|
| btiffin |
Posted on: 2008/7/12 9:05 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique Well, well, well.
So, luckily, I'm too dense to let being WRONG stop me. Corrected ONE-WAY (more like; Changed ONE-WAY). But now I'm off to read more refreshers. Hopefully I'll get to a point soon where you won't have to worry about me leading everyone too far into bug city.
"Those that can, do. Those that can't teach, write documentation."
Please excuse the taint everyone. Learn by FAIL. :)
Cheers,
Brian
|
|
|
| btiffin |
Posted on: 2008/7/13 7:57 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: Example Sample Program for group critique New version. Holy moly. BINARY-LONG data representation really is a performance changing choice. This version comes with a question still. Is the logical OR operation in ONE-WAY still safe for the TEST-CASE(B-COUNT:1) ? Does the OR short-circuit - meaning there is no need to check the other condition? By the way, changing B-COUNT from pic 99999 to binary-long had a huge impact on the performance values on this PC. So much so, I cranked up the time to loop by an order of magnitude. Oh, and thanks Roger, light bulbs came on yesterday re the VARYING clause. (Aside from feeling like an idiot) Thanks. Cheers, Brian
PERFORM varying: 9ticks, +000000062
INSPECT reverse: 34ticks, +000000062
INSPECT trailing: 27ticks, +000000062
Trim and length: 15ticks, +000000062
>>SOURCE FORMAT IS FREE
*> Author: Brian Tiffin for the OpenCOBOL Project
*> Dated: 11-July-2008
*> Purpose: Count trailing spaces
*> Tectonics: cobc trailingsp.cob
*> cobcrun trailingsp
*> Note: hard coded loop profiler, results will vary.
*> Logic errors corrected thanks to Roger While
IDENTIFICATION DIVISION.
PROGRAM-ID. trailingsp.
DATA DIVISION.
WORKING-STORAGE SECTION.
78 TIMES-TO-PROFILE VALUE 100000.
01 START-PROFILE USAGE BINARY-LONG.
01 END-PROFILE USAGE BINARY-LONG.
01 SHOW-PROFILE PIC Z(5)9.
01 TITLE-PROFILE PIC X(18).
01 WAY PIC 9.
01 B-COUNT USAGE BINARY-LONG VALUE 0.
01 TEST-HOLDER.
02 TEST-HEAD PIC XXX.
02 TEST-CASE PIC X(80)
VALUE "This is my string.".
PROCEDURE DIVISION.
PERFORM VARYING WAY FROM 1 BY 1
UNTIL WAY > 4
ACCEPT START-PROFILE FROM TIME END-ACCEPT
EVALUATE WAY
WHEN 1
MOVE "PERFORM varying: " TO TITLE-PROFILE
PERFORM ONE-WAY TIMES-TO-PROFILE TIMES
WHEN 2
MOVE "INSPECT reverse: " TO TITLE-PROFILE
PERFORM TWO-WAY TIMES-TO-PROFILE TIMES
WHEN 3
MOVE "INSPECT trailing: " TO TITLE-PROFILE
PERFORM THREE-WAY TIMES-TO-PROFILE TIMES
WHEN 4
MOVE "Trim and length: " TO TITLE-PROFILE
PERFORM FOUR-WAY TIMES-TO-PROFILE TIMES
END-EVALUATE
ACCEPT END-PROFILE FROM TIME END-ACCEPT
SUBTRACT
START-PROFILE FROM END-PROFILE GIVING START-PROFILE
END-SUBTRACT
MOVE START-PROFILE TO SHOW-PROFILE
DISPLAY
TITLE-PROFILE SHOW-PROFILE "ticks, " B-COUNT
END-DISPLAY
END-PERFORM.
GOBACK.
*> ******************************************************************
ONE-WAY.
PERFORM VARYING B-COUNT FROM LENGTH OF TEST-CASE BY -1
UNTIL (B-COUNT < 1)
OR (TEST-CASE(B-COUNT:1) NOT EQUAL SPACE)
END-PERFORM
SUBTRACT
B-COUNT FROM LENGTH OF TEST-CASE GIVING B-COUNT
END-SUBTRACT
.
TWO-WAY.
MOVE ZERO TO B-COUNT
INSPECT FUNCTION REVERSE(TEST-CASE)
TALLYING B-COUNT
FOR ALL LEADING ' '
.
THREE-WAY.
MOVE ZERO TO B-COUNT
INSPECT TEST-CASE
TALLYING B-COUNT
FOR TRAILING SPACE
.
FOUR-WAY.
COMPUTE
B-COUNT = LENGTH TEST-CASE -
FUNCTION LENGTH(FUNCTION TRIM(TEST-CASE TRAILING))
END-COMPUTE
.
|
|
|
OpenCOBOL Forum Index