Hi Dave,
I voted for your RFE, because it is already overdue.
I do not know whether or not the API approach is better that your "select" solution, but it might be worth to have a look at it.
Regards,
Thomas.
<CHAR_FREE>
**FREE
//=====================================================================*
// Unit Test Suite: char() *
//=====================================================================*
// Command to create the service program: *
// RUCRTTST TSTPGM(RPGUNIT/TEMPLATE) SRCFILE(RPGUNIT/QSRC) *
//=====================================================================*
// Tools/400 STRPREPRC instructions: *
// >>PRE-COMPILER<< *
// >>CRTCMD<< RUCRTTST TSTPGM(&LI/&OB) + *
// SRCFILE(&SL/&SF) SRCMBR(&SM); *
// >>COMPILE<< *
// >>PARM<< COPTION(*EVENTF); *
// >>PARM<< DBGVIEW(*LIST); *
// >>PARM<< BNDDIR(*N); *
// >>END-COMPILE<< *
// >>EXECUTE<< *
// >>END-PRE-COMPILER<< *
//=====================================================================*
// Compile options: *
// *SrcStmt - Assign SEU line numbers when compiling the *
// source member. This option is required to *
// position the LPEX editor to the line in error *
// when the source member is opened from the *
// RPGUnit view. *
// *NoDebugIO - Do not generate breakpoints for input and *
// output specifications. Optional but useful. *
//=====================================================================*
ctl-opt nomain option(*srcstmt : *nodebugio) decedit(*jobrun);
/include qinclude,TESTCASE
dcl-s value_t zoned(60:20) template;
dcl-pr char varchar(64) extproc('CHAR_FREE_char');
i_value like(value_t) value;
i_length int(10) value;
i_decPos int(10) value;
end-pr;
dcl-pr testCharPositiveValues extproc('testCharPositiveValues');
end-pr;
dcl-pr testCharNegativeValues extproc('testCharNegativeValues');
end-pr;
// =========================================================================
// Test positive values.
// =========================================================================
dcl-proc testCharPositiveValues export;
dcl-pi *N end-pi;
dcl-s value packed(20:5);
dcl-s valueMax like(value_t);
dcl-s valueExpected zoned(20:2);
dcl-s valueExpectedOverflow zoned(18:2);
dcl-s actual varchar(64);
dcl-s expected varchar(64);
value = 123456789.12345;
valueExpected = value;
valueExpectedOverflow = value;
actual = char(value: %len(valueExpected): %decpos(valueExpected));
expected = %char(valueExpected);
aEqual(expected: actual);
actual = char(value: %len(valueExpectedOverflow): %decpos(valueExpectedOverflow));
expected = %char(valueExpectedOverflow);
aEqual(expected: actual);
valueMax = *hival;
actual = char(valueMax: %len(valueMax): %decpos(valueMax));
expected = %char(valueMax);
aEqual(expected: actual);
value = 0;
valueExpected = value;
actual = char(value: %len(valueExpected): %decpos(valueExpected));
expected = %char(valueExpected);
aEqual(expected: actual);
end-proc;
// =========================================================================
// Test negative values.
// =========================================================================
dcl-proc testCharNegativeValues export;
dcl-pi *N;
end-pi;
dcl-s value packed(20:5);
dcl-s valueMin like(value_t);
dcl-s valueExpected zoned(20:2);
dcl-s valueExpectedOverflow zoned(18:2);
dcl-s actual varchar(64);
dcl-s expected varchar(64);
value = -123456789.12345;
valueExpected = value;
valueExpectedOverflow = value;
actual = char(value: %len(valueExpected): %decpos(valueExpected));
expected = %char(valueExpected);
aEqual(expected: actual);
actual = char(value: %len(valueExpectedOverflow): %decpos(valueExpectedOverflow));
expected = %char(valueExpectedOverflow);
aEqual(expected: actual);
valueMin = *loval;
actual = char(valueMin: %len(valueMin): %decpos(valueMin));
expected = %char(valueMin);
aEqual(expected: actual);
end-proc;
// =========================================================================
// This function returns a character result representing the numeric
// value edited according length and decimal positions specified.
// =========================================================================
// Parameters:
// i_value - NUmeric value up to nn length and dd decimal digits.
// i_length - Number of digits of the numeric value.
// i_decPos - Number of decimal positions of the numeric value.
// to a character string.
//
// Returns:
// fmtString - Formatted string.
// =========================================================================
dcl-proc char export;
dcl-pi *N varchar(64);
i_value like(value_t) value;
i_length INT(10) value;
i_decPos INT(10) value;
end-pi;
// Return value
dcl-s fmtString varchar(64) inz;
// Local fields
dcl-s buffer char(64) based(pBuffer);
dcl-s editMask char(256) inz;
dcl-s editMaskLen int(10) inz;
dcl-s rcvVar char(64) inz;
dcl-s rcvVarLen int(10) inz;
dcl-s zeroBalanceFillChar char(1) inz;
dcl-ds errCode qualified inz;
bytPrv int(10);
bytAvl int(10);
end-ds;
dcl-s i int(10);
dcl-c FILL_CHAR ' ';
// Convert Edit Code (QECCVTEC) API
dcl-pr QECCVTEC extpgm('QECCVTEC');
o_editMask char(256);
o_editMaskLen int(10);
o_rcvVarLen int(10);
o_zeroFilChar char(1);
i_editCode char(2) const;
i_floatInd char(1) const;
i_precision int(10) const;
i_decPos int(10) const;
io_ErrCode char(32767) options(*varsize);
end-pr;
// Edit (QECEDT) API
dcl-pr QECEDT extpgm('QECEDT');
o_rcvVar char(32767) options(*varsize);
i_rcvVarLen INT(10) const;
i_srcVar char(32767) const options(*varsize);
i_srcVarClass char(10) const;
i_srcVarPrec int(10) const;
i_editMask char(32767) const options(*varsize);
i_editMaskLen int(10) const;
i_zeroFilChar char(1) const;
io_ErrCode char(32767) options(*varsize);
end-pr;
//-------------------------------------------------------------------
pBuffer = %addr(i_value) + (%len(i_value) - %decpos(i_value))
- (i_length - i_decPos);
// Produce edit mask for the given edit code
clear errCode;
QECCVTEC(editMask: editMaskLen: rcvVarLen: zeroBalanceFillChar
: 'P' // Edit code
: FILL_CHAR // Fill or Floating currency indication
: i_length: i_decPos: errCode);
// Translate the numeric value to a character string
QECEDT(rcvVar: rcvVarLen: buffer
: '*ZONED': i_length: editMask: editMaskLen
: zeroBalanceFillChar: errCode);
// Set return value
fmtString = %subst(rcvVar: 1: rcvVarLen);
i = %check(FILL_CHAR: fmtString) - 1;
if (i > 0);
if (i_value < 0);
%subst(fmtString: i: 1) = '-';
else;
// No action required.
endif;
endif;
return %trim(fmtString);
end-proc;
</CHAR_FREE>
-----Ursprüngliche Nachricht-----
Von: RPG400-L [mailto:rpg400-l-bounces@xxxxxxxxxxxxxxxxxx] Im Auftrag von dlclark@xxxxxxxxxxxxxxxx
Gesendet: Montag, 9. März 2020 17:24
An: RPG programming on IBM i
Betreff: Re: Decimal Place in Character String
"RPG400-L" <rpg400-l-bounces@xxxxxxxxxxxxxxxxxx> wrote on 03/08/2020
08:49:32 AM:
Anyway, I guess I was a bit too vague about where I think the compiler
could tolerate variables for length and decimals ... after a bit more
pondering, I now think that it would pretty much be limited to %CHAR.
Vote for an RFE on the subject, anyone?
http://www.ibm.com/developerworks/rfe/execute?use_case=viewRfe&CR_ID=140864
Sincerely,
Dave Clark
--
IMPORTANT NOTICE:
This email is confidential, may be legally privileged, and is for the intended recipient only. Access, disclosure, copying, distribution, or reliance on any of it by anyone else is prohibited and may be a criminal offence. Please delete if obtained in error and email confirmation to the sender.
midrange.com
