diff --git a/gcc/testsuite/cobol.dg/group2/BINARY_and_COMP-5__little-endian_.out b/gcc/testsuite/cobol.dg/group2/BINARY_and_COMP-5__little-endian_.out new file mode 100644 index 00000000000..3fd09c41c30 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/BINARY_and_COMP-5__little-endian_.out @@ -0,0 +1,35 @@ + 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 ++0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +-0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x0000000000123456 +0x0000000000123456 +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xffffffffffedcbaa +0xffffffffffedcbaa + 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 0.0001193046 ++0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +0.0001193046 +-0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 -0.0001193046 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x5634120000000000 +0x0000000000123456 +0x0000000000123456 +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xaacbedffffffffff +0xffffffffffedcbaa +0xffffffffffedcbaa + diff --git a/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.cob b/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.cob new file mode 100644 index 00000000000..6145797870a --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.cob @@ -0,0 +1,56 @@ + *> { dg-do run } + *> { dg-options "-dialect mf" } + *> { dg-output-file "group2/Checking_IS_NUMERIC.out" } + identification division. + program-id. prog. + data division. + working-storage section. + 01 var0 pic xxxx. + 01 var1 redefines var0 pic 9999. + 01 var2 redefines var0 pic s9999 trailing. + 01 var3 redefines var0 pic s9999 leading. + 01 var4 redefines var0 pic s999 trailing separate. + 01 var5 redefines var0 pic s999 leading separate. + procedure division. + move "1234" to var0 display var0 + if var1 is not numeric display "Failure 1-1" space var0 end-if + if var2 is not numeric display "Failure 1-2" space var0 end-if + if var3 is not numeric display "Failure 1-3" space var0 end-if + if var4 is numeric display "Failure 1-4" space var0 end-if + if var5 is numeric display "Failure 1-5" space var0 end-if + move "12a4" to var0 display var0 + if var1 is numeric display "Failure 2-1" space var0 end-if + if var2 is numeric display "Failure 2-2" space var0 end-if + if var3 is numeric display "Failure 2-3" space var0 end-if + if var4 is numeric display "Failure 2-4" space var0 end-if + if var5 is numeric display "Failure 2-5" space var0 end-if + move "+123" to var0 display var0 + if var1 is numeric display "Failure 3-1" space var0 end-if + if var2 is numeric display "Failure 3-2" space var0 end-if + if var3 is numeric display "Failure 3-3" space var0 end-if + if var4 is numeric display "Failure 3-4" space var0 end-if + if var5 is not numeric display "Failure 3-5" space var0 end-if + move "123-" to var0 display var0 + if var1 is numeric display "Failure 4-1" space var0 end-if + if var2 is numeric display "Failure 4-2" space var0 end-if + if var3 is numeric display "Failure 4-3" space var0 end-if + if var4 is not numeric display "Failure 4-4" space var0 end-if + if var5 is numeric display "Failure 4-5" space var0 end-if + move -123 to var2 display var2 + move var2(1:) to var0(1:) + if var1 is numeric display "Failure 5-1" space var0 end-if + if var2 is not numeric display "Failure 5-2" space var0 end-if + if var3 is numeric display "Failure 5-3" space var0 end-if + if var4 is numeric display "Failure 5-4" space var0 end-if + if var5 is numeric display "Failure 5-5" space var0 end-if + move -123 to var3 display var3 + move var2(1:) to var0(1:) + if var1 is numeric display "Failure 6-1" space var0 end-if + if var2 is numeric display "Failure 6-2" space var0 end-if + if var3 is not numeric display "Failure 6-3" space var0 end-if + if var4 is numeric display "Failure 6-4" space var0 end-if + if var5 is numeric display "Failure 6-5" space var0 end-if + goback. + end program prog. + + diff --git a/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.out b/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.out new file mode 100644 index 00000000000..26e6a7185c3 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Checking_IS_NUMERIC.out @@ -0,0 +1,7 @@ +1234 +12a4 ++123 +123- +-0123 +-0123 + diff --git a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.cob b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.cob deleted file mode 100644 index 90a173c4e84..00000000000 --- a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.cob +++ /dev/null @@ -1,93 +0,0 @@ - *> { dg-do run } - *> { dg-options "-fexec-charset=utf16le" } - *> { dg-output-file "group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.out" } - identification division. - program-id. hex-init. - data division. - working-storage section. - 01 template. - 05 under-test pic x(8). - 05 filler pic x. - 05 msg pic x(12). - 05 filler pic x. - 05 utf16-val pic x(8). - - 01 var01020304. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE X'01020304'. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var01020304". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300010203040000000033003300". - - 01 var-low. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE LOW-VALUES. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var-low". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300000000000000000033003300". - - 01 var-space. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE SPACE. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var-space". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300200020002000200033003300". - - 01 var-quote. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE QUOTE. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var-quote". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300220022002200220033003300". - - 01 var-zero. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE ZERO. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var-zero". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300300030003000300033003300". - - 01 var-high. - 05 filler1. - 10 filler2 pic x(2) VALUE "33". - 10 as-value pic x(4) VALUE HIGH-VALUES. - 10 filler3 pic x(2) VALUE "33". - 05 filler pic x value space. - 05 msg pic x(12) value "var-high". - 05 filler pic x value space. - 05 utf16-val pic x(8) value X"33003300FF00FF00FF00FF0033003300". - - procedure division. - move var01020304 to template perform checker - move var-low to template perform checker - move var-space to template perform checker - move var-quote to template perform checker - move var-zero to template perform checker - move var-high to template perform checker - goback. - checker. - display msg of template space with no advancing - if utf16-val of template = - utf16-val of template - display "is okay." - else - display "is no good: " function hex-of(under-test) - end-if - continue. - end program hex-init. - diff --git a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.out b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.out deleted file mode 100644 index 0d3e250a5a8..00000000000 --- a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE_-_UTF-16.out +++ /dev/null @@ -1,7 +0,0 @@ -var01020304 is okay. -var-low is okay. -var-space is okay. -var-quote is okay. -var-zero is okay. -var-high is okay. - diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out b/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out deleted file mode 100644 index d17de5756f0..00000000000 --- a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.out +++ /dev/null @@ -1,12 +0,0 @@ -12340 -12340 --1234 -12340 --1234 -+1234 --1234 -12340 --1234 -1234+ -1234- - diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob index 27b7f5d4992..bd4e44b50bf 100644 --- a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob +++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob @@ -6,12 +6,12 @@ configuration section. special-names. locale cp1252 is "cp1252" - locale utf16le is "utf16le". + locale utf16 is "utf16". Object-Computer. linux Character Classification for Alphanumeric is cp1252 - for National is utf16le. + for National is utf16. data division. working-storage section. 01 from-8 pic x(10) value " 8888 ". diff --git a/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob index 049db396ddc..23cda89f056 100644 --- a/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob +++ b/gcc/testsuite/cobol.dg/group2/Hexadecimal_literal.cob @@ -11,6 +11,9 @@ when X"F0" display X"F1F2F3" when X"30" DISPLAY X"313233" when X"3000" DISPLAY X"310032003300" - when other display "BaCK to the drawing board" + when X"0030" DISPLAY X"003100320033" + when X"30000000" DISPLAY X"310000003200000033000000" + when X"00000030" DISPLAY X"000000310000003200000033" + when other display function hex-of(A) goback. diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric-display__1_.cob b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric-display__1_.cob new file mode 100644 index 00000000000..1adced6f2b4 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric-display__1_.cob @@ -0,0 +1,27 @@ + *> { dg-do run } + *> { dg-output-file "group2/Non-numeric_data_in_numeric-display__1_.out" } + + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X. + 03 X-NUM PIC 9(06) VALUE 123. + 77 NUM PIC 9(06). + PROCEDURE DIVISION. + MOVE x"0000" TO X (2:2) + IF X-NUM NUMERIC + DISPLAY "low-value is numeric" UPON SYSERR + END-DISPLAY + END-IF + MOVE x"01" TO X (3:1) + IF X-NUM NUMERIC + DISPLAY "SOH is numeric" UPON SYSERR + END-DISPLAY + END-IF + MOVE X-NUM TO NUM + DISPLAY "test over" + END-DISPLAY + * + GOBACK. + diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric-display__1_.out similarity index 100% rename from gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out rename to gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric-display__1_.out diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob deleted file mode 100644 index 56a31a7a81d..00000000000 --- a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob +++ /dev/null @@ -1,23 +0,0 @@ - *> { dg-do run } - *> { dg-output-file "group2/Non-numeric_data_in_numeric_items__2_.out" } - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X-NUM PIC 9(06) PACKED-DECIMAL VALUE 123. - 77 NUM PIC 9(06). - PROCEDURE DIVISION. - *> "O" is non-numeric BCD in ascii or ebcdic - MOVE "O" TO X (2:1) - IF X-NUM NUMERIC - DISPLAY "bad prog" - END-DISPLAY - END-IF - MOVE X-NUM TO NUM - DISPLAY "test over" - END-DISPLAY - * - GOBACK. - diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.cob b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.cob new file mode 100644 index 00000000000..a5bc6068cea --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.cob @@ -0,0 +1,22 @@ + *> { dg-do run } + *> { dg-output-file "group2/Non-numeric_data_in_packed_decimal.out" } + identification division. + program-id. prog2. + data division. + working-storage section. + 01 x. + 03 x-num pic 9(06) packed-decimal value 123. + 03 x-bin redefines x-num binary-char. + procedure division. + if x-num numeric + display "Starts off numeric" + end-display + move 255 to x-bin + if x-num numeric + display "bad prog" + end-display + end-if + display "test over" + end-display + goback. + diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.out b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.out new file mode 100644 index 00000000000..46def994bb5 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_packed_decimal.out @@ -0,0 +1,3 @@ +Starts off numeric +test over + diff --git a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.cob similarity index 78% rename from gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob rename to gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.cob index 946d6599147..0f4c5cb5b8b 100644 --- a/gcc/testsuite/cobol.dg/group2/DISPLAY__Sign_ASCII.cob +++ b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.cob @@ -1,5 +1,5 @@ *> { dg-do run } - *> { dg-output-file "group2/DISPLAY__Sign_ASCII.out" } + *> { dg-output-file "group2/Numeric-display_sign_encoding__2_.out" } IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. @@ -13,26 +13,31 @@ 02 X-S9-T REDEFINES X PIC S9(4) TRAILING. 02 X-S9-TS REDEFINES X PIC S9(4) TRAILING SEPARATE. PROCEDURE DIVISION. + display "Should be 12340" MOVE ZERO TO X MOVE 1234 TO X-9 DISPLAY X MOVE ZERO TO X MOVE 1234 TO X-S9 DISPLAY X - MOVE ZERO TO X MOVE -1234 TO X-S9 + MOVE ZERO TO X MOVE 1234 TO X-S9-L DISPLAY X + MOVE ZERO TO X MOVE 1234 TO X-S9-T DISPLAY X + display "Should be +1234" + MOVE ZERO TO X MOVE 1234 TO X-S9-LS DISPLAY X *> Let's be ecumenical with regard to ASCII and EBCDIC: - if X equals "123M0" or "123t0" DISPLAY "-1234" + display "Should be -1234" + MOVE ZERO TO X MOVE -1234 TO X-S9 + if X equals "123M0" or "123t0" DISPLAY "-1234" else DISPLAY X " Not Good" end-if - MOVE ZERO TO X MOVE 1234 TO X-S9-L DISPLAY X MOVE ZERO TO X MOVE -1234 TO X-S9-L - if X equals "J2340" or "q2340" DISPLAY "-1234" + if X equals "J2340" or "q2340" DISPLAY "-1234" else DISPLAY X " Not Good" end-if - MOVE ZERO TO X MOVE 1234 TO X-S9-LS DISPLAY X MOVE ZERO TO X MOVE -1234 TO X-S9-LS DISPLAY X - MOVE ZERO TO X MOVE 1234 TO X-S9-T DISPLAY X MOVE ZERO TO X MOVE -1234 TO X-S9-T - if X equals "123M0" or "123t0" DISPLAY "-1234" + if X equals "123M0" or "123t0" DISPLAY "-1234" else DISPLAY X " Not Good" end-if + display "Should be 1234+" MOVE ZERO TO X MOVE 1234 TO X-S9-TS DISPLAY X + display "Should be 1234-" MOVE ZERO TO X MOVE -1234 TO X-S9-TS DISPLAY X goback. end program prog. diff --git a/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.out b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.out new file mode 100644 index 00000000000..5f9b0d428ad --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding__2_.out @@ -0,0 +1,17 @@ +Should be 12340 +12340 +12340 +12340 +12340 +Should be +1234 ++1234 +Should be -1234 +-1234 +-1234 +-1234 +-1234 +Should be 1234+ +1234+ +Should be 1234- +1234- + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.cob b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.cob new file mode 100644 index 00000000000..1b8108dbc03 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.cob @@ -0,0 +1,23 @@ + *> { dg-do run } + *> { dg-output-file "group2/Numeric-display_sign_encoding_sanity_check.out" } + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 RESULT0 PIC 999V999. + 01 RESULT1 PIC S999V999 leading . + 01 RESULT2 PIC S999V999 trailing . + 01 RESULT3 PIC S999V999 leading separate . + 01 RESULT4 PIC S999V999 trailing separate. + PROCEDURE DIVISION. + move 123.456 to RESULT0 DISPLAY RESULT0 + move 123.456 to RESULT1 DISPLAY RESULT1 + move 123.456 to RESULT2 DISPLAY RESULT2 + move 123.456 to RESULT3 DISPLAY RESULT3 + move 123.456 to RESULT4 DISPLAY RESULT4 + move -123.456 to RESULT1 DISPLAY RESULT1 + move -123.456 to RESULT2 DISPLAY RESULT2 + move -123.456 to RESULT3 DISPLAY RESULT3 + move -123.456 to RESULT4 DISPLAY RESULT4 + STOP RUN. + diff --git a/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.out b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.out new file mode 100644 index 00000000000..4ef3f9fbab1 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/Numeric-display_sign_encoding_sanity_check.out @@ -0,0 +1,10 @@ +123.456 ++123.456 ++123.456 ++123.456 +123.456+ +-123.456 +-123.456 +-123.456 +123.456- + diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob index 52a4e0a8fe1..f932d436d03 100644 --- a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.cob @@ -1,41 +1,27 @@ *> { dg-do run } *> { dg-options "-dialect mf" } *> { dg-output-file "group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out" } - identification division. program-id. prog. data division. working-storage section. - 01 vars. - 05 var1d . - 10 var01 pic 99v99 comp-3 value 43.21 . - 10 filler binary-double value zero . - 05 var1 redefines var1d pointer . - 05 var2d . - 10 var02 pic s99v99 comp-3 value 43.21 . - 10 filler binary-double value zero . - 05 var2 redefines var2d pointer . - 05 var3d . - 10 var03 pic s99v99 comp-3 value -43.21 . - 10 filler binary-double value zero . - 05 var3 redefines var3d pointer . - 05 var4d . - 10 var04 pic 99v99 comp-6 value 43.21 . - 10 filler binary-double value zero . - 05 var4 redefines var4d pointer . + 01 var01 pic 99v99 comp-3 value 43.21 . + 01 var02 pic s99v99 comp-3 value 43.21 . + 01 var03 pic s99v99 comp-3 value -43.21 . + 01 var04 pic 99v99 comp-6 value 43.21 . procedure division. - display length of var01 space var1 space space var01 - display length of var02 space var2 space var02 - display length of var03 space var3 space var03 - display length of var04 space var4 space space var04 - move 12.34 to var01 - move 12.34 to var02 - move 12.34 to var03 - move 12.34 to var04 - display function length(var01) space var1 space space var01 - display function length(var02) space var2 space var02 - display function length(var03) space var3 space var03 - display function length(var04) space var4 space space var04 + display length of var01 space "0x" function hex-of(var01) space space var01 + display length of var02 space "0x" function hex-of(var02) space var02 + display length of var03 space "0x" function hex-of(var03) space var03 + display length of var04 " " "0x" function hex-of(var04) space space var04 + move 12.34 to var01 + move 12.34 to var02 + move -12.34 to var03 + move 12.34 to var04 + display function length(var01) space "0x" function hex-of(var01) space space var01 + display function length(var02) space "0x" function hex-of(var02) space var02 + display function length(var03) space "0x" function hex-of(var03) space var03 + display function length(var04) " " "0x" function hex-of(var04) space space var04 goback. end program prog. diff --git a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out index 6acdee42b58..96c0b780a6d 100644 --- a/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out +++ b/gcc/testsuite/cobol.dg/group2/PACKED-DECIMAL_basic_comp-3_comp-6__2_.out @@ -1,9 +1,9 @@ -3 0x00000000001f3204 43.21 -3 0x00000000001c3204 +43.21 -3 0x00000000001d3204 -43.21 -2 0x0000000000002143 43.21 -3 0x00000000004f2301 12.34 -3 0x00000000004c2301 +12.34 -3 0x00000000004c2301 +12.34 -2 0x0000000000003412 12.34 +3 0x04321F 43.21 +3 0x04321C +43.21 +3 0x04321D -43.21 +2 0x4321 43.21 +3 0x01234F 12.34 +3 0x01234C +12.34 +3 0x01234D -12.34 +2 0x1234 12.34 diff --git a/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob b/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob new file mode 100644 index 00000000000..c43edb201ed --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob @@ -0,0 +1,7 @@ + *> { dg-do compile } + +00002 PROGRAM-ID. PROG. RJD0002 +00003 PROCEDURE DIVISION. RJD0003 +00004 GOBACK. RJD0004 +00005 END PROGRAM PROG. RJD0005 + diff --git a/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob b/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob new file mode 100644 index 00000000000..39b37c67400 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob @@ -0,0 +1,9 @@ + *> { dg-do run } + *> { dg-options "-O0 -Wno-ibm-cdf -I copybooks -Wno-recording-mode -ffixed-form -dialect ibm -fno-static-call -fexec-charset=CP037 -fexec-national-charset=CP037" } + +00001 PROCESS FLAG(I,W) FDUMP +00002 IDENTIFICATION DIVISION. +00003 PROGRAM-ID. prog. +00004 PROCEDURE DIVISION. +00005 DISPLAY "OK". + diff --git a/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob index 108c6385a63..2c85a2f1060 100644 --- a/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob +++ b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob @@ -6,7 +6,7 @@ configuration section. special-names. locale greek is "cyrillic" - locale unicode is "utf16le". + locale unicode is "utf16". object-computer. xerox-parc-star character classification diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc index 8f28f85c8e5..1c70afc0fc9 100644 --- a/libgcobol/charmaps.cc +++ b/libgcobol/charmaps.cc @@ -42,13 +42,33 @@ #include #include +#if defined(IN_GCC_FRONTEND) +#include "cobol-system.h" +#include "coretypes.h" +#include "tree.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "diagnostic-core.h" +#include "target.h" +#include "tm.h" +#include "../../libgcobol/ec.h" +#include "../../libgcobol/common-defs.h" +#include "../../libgcobol/io.h" +#include "../../libgcobol/gcobolio.h" +#include "../../libgcobol/valconv.h" +#include "../../libgcobol/cobol-endian.h" +#include "../../libgcobol/charmaps.h" +#include "../../libgcobol/encodings.h" +#else #include "ec.h" #include "common-defs.h" #include "io.h" #include "gcobolio.h" #include "valconv.h" +#include "cobol-endian.h" #include "charmaps.h" #include "encodings.h" +#endif // These values are in the ASCII space. int __gg__decimal_point = '.' ; @@ -1432,7 +1452,11 @@ static const encodings_t * encoding_descr( const char name[] ) { static encodings_t *eoencodings = encodings + COUNT_OF(encodings); +#if defined(IN_GCC_FRONTEND) + char *slashless = xstrdup(name); +#else char *slashless = strdup(name); +#endif assert(slashless); char *pslash = strchr(slashless, '/'); if( pslash ) @@ -1509,7 +1533,12 @@ __gg__iconverter( cbl_encoding_t from, charmap_t *charmap_to = __gg__get_charmap(to); static size_t retsize = 1; + +#if defined(IN_GCC_FRONTEND) + static char *retval = static_cast(xmalloc(retsize)); +#else static char *retval = static_cast(malloc(retsize)); +#endif if( outlength_p ) *outlength_p = 0; if( iconv_retval_p ) *iconv_retval_p = 0; @@ -1518,7 +1547,11 @@ __gg__iconverter( cbl_encoding_t from, if( retsize < needed ) { retsize = needed; +#if defined(IN_GCC_FRONTEND) + retval = static_cast(xrealloc(retval, retsize)); +#else retval = static_cast(realloc(retval, retsize)); +#endif } size_t outlength; @@ -1589,7 +1622,11 @@ __gg__iconverter( cbl_encoding_t from, const charmap_t *map_from = __gg__get_charmap(from); if( map_from->is_like_ebcdic() ) { +#if defined(IN_GCC_FRONTEND) + inbuf_cpy = static_cast(xmalloc(length)); +#else inbuf_cpy = static_cast(malloc(length)); +#endif assert(inbuf_cpy); memcpy(inbuf_cpy, inbuf, length); inbuf = inbuf_cpy; @@ -1612,6 +1649,7 @@ __gg__iconverter( cbl_encoding_t from, iconv_retval = 1; // This primes the pump: for(;;) { + errno = 0; iconv_retval = iconv( cd, &inbuf, &inbytesleft, &outbuf, &outbytesleft); @@ -1707,7 +1745,11 @@ __gg__miconverter( cbl_encoding_t from, length, outlength_p, iconv_retval_p); +#if defined(IN_GCC_FRONTEND) + char *retval = static_cast(xmalloc(*outlength_p + 4)); +#else char *retval = static_cast(malloc(*outlength_p + 4)); +#endif assert(retval); memcpy(retval, converted, *outlength_p); // Tack on four zeros to be a NUL in any encoding. @@ -1756,3 +1798,109 @@ __gg__get_charmap(cbl_encoding_t encoding) return retval; } +static void +fixcode( char *ach, size_t N ) + { + if( strncasecmp(ach, "UTF16", N) == 0 + || strncasecmp(ach, "UTF-16", N) == 0 ) + { + strcpy(ach, "UTF-16" ); + if( cobol_target_big_endian() ) // cppcheck-suppress knownConditionTrueFalse + { + strcat(ach, "BE"); + } + else + { + strcat(ach, "LE"); + } + } + else if( strncasecmp(ach, "UTF32", N) == 0 + || strncasecmp(ach, "UTF-32", N) == 0 ) + { + strcpy(ach, "UTF-32" ); + if( cobol_target_big_endian() ) // cppcheck-suppress knownConditionTrueFalse + { + strcat(ach, "BE"); + } + else + { + strcat(ach, "LE"); + } + } + else if( strncasecmp(ach, "UTF16BE", N) == 0 ) + { + strcpy(ach, "UTF-16BE"); + } + else if( strncasecmp(ach, "UTF16LE", N) == 0 ) + { + strcpy(ach, "UTF-16LE"); + } + else if( strncasecmp(ach, "UTF32BE", N) == 0 ) + { + strcpy(ach, "UTF-32BE"); + } + else if( strncasecmp(ach, "UTF32LE", N) == 0 ) + { + strcpy(ach, "UTF-32LE"); + } + } + +iconv_t +helpful_iconv_open(const char *tocode, const char *fromcode) + { + // This routine is helpful in two ways. FreeBSD systems provide for + // "utf-16le" as an iconv_open(3) input, but not "utf16le", as does Ubuntu. + // So it converts "utf16" to "utf-16" + + // It also provides for converting "utf-16" to either "utf-16be" or "utf16le" + // depending on the endianness of the target machine. Because we can't + // handle an unspecified "utf-16" because of the Byte Order Marker, this is + // my justification for forcing it to one or the other. + + // When the programmer specifies "le" or "be", we let that be forced through. + // Specify disaster, and you get disaster. + + char ach_to[32]; + char ach_from[32]; + + strncpy(ach_to, tocode, sizeof(ach_to)); + strncpy(ach_from, fromcode, sizeof(ach_from)); + + fixcode(ach_to, sizeof(ach_to)); + fixcode(ach_from, sizeof(ach_from)); + + iconv_t cd = iconv_open(ach_to, ach_from); + + return cd; + } + +char +char_from_figconst(cbl_figconst_t figconst) + { + char retval; + switch(figconst) + { + case normal_value_e : + retval = 0; + break; + case low_value_e : + retval = __gg__low_value_character; + break; + case null_value_e : + retval = '\0'; + break; + case zero_value_e : + retval = ascii_zero; + break; + case space_value_e : + retval = ascii_space; + break; + case quote_value_e : + retval = __gg__quote_character; + break; + case high_value_e : + retval = __gg__high_value_character; + break; + } + return retval; + } \ No newline at end of file diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h index 1e53df78275..ac0ebd63f02 100644 --- a/libgcobol/charmaps.h +++ b/libgcobol/charmaps.h @@ -31,8 +31,14 @@ #ifndef CHARMAPS_H #define CHARMAPS_H +#include +#include +#include +#include #include #include +#include +#include #include #include @@ -48,13 +54,15 @@ * calls are in the "console" domain. * * Second is the internal single-byte-coded codeset of the data, in memory, - * being manipulated by the generated code of the cobol executable. The actual + * being manipulated by the generated code of the cobol executable. The + * actual * codeset of "internal" is either EBCDIC (in the form of Code Page 1140 or * ASCII (Code Page 1252) * * Third is the C++ source code of the GCOBOL compiler; this comment is * in that environment. We neither know, nor care, if this code is encoded in - * in UTF-8 (as is probable, in these enlighted days of 2022) or something like + * in UTF-8 (as is probable, in these enlighted days of 2022) or + * something like * Code Page1252. We are going to regard it as "ascii" under the * assumption that there is no reason for any character in the compiler's * source code to have a code point outside of the plain vanilla 0x20 through @@ -66,7 +74,8 @@ * bytes long in UTF-8, and five bytes long in CP1252. We start with an * assumption that it is UTF-8 and switch to CP1252 upon encountering a byte * sequence with values above 0x80 that can't be UTF-8. We have provision for - * forcing it to be one or the other. Codepoints in that domain are referenced + * forcing it to be one or the other. Codepoints in that domain are + * referenced * as "raw". Codepoint in the "raw" domain don't last long; they are be * converted to either "ascii" or "internal" early on, as necessary. */ @@ -85,7 +94,8 @@ compiled is also ASCII-based, even if it is actually UTF-8. Said another way, characters encoded between zero and 127 are regarded as ASCII. - This means that we are not going to try to compile EBCDIC COBOL source code; + This means that we are not going to try to compile EBCDIC COBOL + source code; any such will have to be externally converted to ASCII before feeding it through this compiler on an ASCII based Linux system. @@ -259,13 +269,16 @@ enum #define ascii_underscore ((uint8_t)('_')) #define ascii_asterisk ((uint8_t)('*')) #define ascii_query ((uint8_t)('?')) -#define ascii_cr ((uint8_t)('\r')) +#define ascii_lbrace ((uint8_t)('{')) +#define ascii_rbrace ((uint8_t)('}')) #define ascii_ff ((uint8_t)('\f')) -#define ascii_newline ((uint8_t)('\n')) #define ascii_return ((uint8_t)('\r')) +#define ascii_newline ((uint8_t)('\n')) +#define ebcdic_return ((uint8_t)(0x0D)) #define ebcdic_zero ((uint8_t)(0xF0)) #define ebcdic_plus ((uint8_t)(0x4E)) #define ebcdic_minus ((uint8_t)(0x60)) +#define ebcdic_newline ((uint8_t)(0x25)) extern unsigned char __gg__data_space[1] ; extern unsigned char __gg__data_low_values[1] ; @@ -287,6 +300,8 @@ const char * __gg__encoding_iconv_name( cbl_encoding_t encoding ); cbl_encoding_t __gg__encoding_iconv_type( const char *name ); extern cbl_encoding_t __gg__console_encoding; +extern iconv_t helpful_iconv_open(const char *tocode, const char *fromcode); + // returns a pointer to a static buffer. Beware! char * __gg__iconverter(cbl_encoding_t from, cbl_encoding_t to, @@ -306,17 +321,59 @@ char * __gg__miconverter(cbl_encoding_t from, #define DEFAULT_SOURCE_ENCODING (iconv_CP1252_e) -#if __FreeBSD__ -#define DEFAULT_32_ENCODING (iconv_UTF_32LE_e) -#else -#define DEFAULT_32_ENCODING (iconv_UTF32LE_e) -#endif +#define HOST_32_ENCODING (cobol_target_big_endian() ? iconv_UTF_32BE_e : iconv_UTF_32LE_e) #ifndef IN_TARGET_LIBS void error_msg_direct( const char gmsgid[], ... ); - //// ATTRIBUTE_GCOBOL_DIAG(1, 2); can't appear here? #endif + +static inline unsigned char * +charmap_as_unsigned_chars(char *p) + { + return reinterpret_cast(p); + } + +static inline const unsigned char * +charmap_as_unsigned_chars(const char *p) + { + return reinterpret_cast(p); + } + +template +static T +charmap_load_unaligned(const void *p) + { + static_assert(std::is_trivially_copyable::value, + "charmap_load_unaligned requires a trivially copyable type"); + T retval; + std::memcpy(&retval, p, sizeof(retval)); + return retval; + } + +template +static void +charmap_store_unaligned(void *p, T value) + { + static_assert(std::is_trivially_copyable::value, + "charmap_store_unaligned requires a trivially copyable type"); + std::memcpy(p, &value, sizeof(value)); + } + +static inline void +store_uint16(unsigned char *p, uint16_t value) + { + // This routine is handling encoded characters, so the storage is literal + memcpy(p, &value, 2); + } + +static inline void +store_uint32(unsigned char *p, uint32_t value) + { + // This routine is handling encoded characters, so the storage is literal + memcpy(p, &value, 4); + } + class charmap_t; /* @@ -370,7 +427,7 @@ class cbl_iconv_t { auto p = cds.find(key); if( p != cds.end() ) return p->second; - iconv_t cd = iconv_open(key.tocode, key.fromcode); + iconv_t cd = helpful_iconv_open(key.tocode, key.fromcode); cds[key] = cd; // whether or not failed if( ! valid(cd) ) { @@ -413,9 +470,76 @@ class charmap_t sign_type_ebcdic, } m_numeric_sign_type; - // This map retains the ASCII-to-encoded value in m_encoding, so that iconv - // need be called but once for each ASCII value. - std::unordered_mapm_map_of_encodings; + // This map retains the ASCII-to-encoded value in m_encoding, so that + // iconv need be called but once for each ASCII value. + std::unordered_map m_map_of_encodings; + + const unsigned char * + skip_bom(const unsigned char *p, size_t outlength) const + { + if( m_has_bom && outlength >= 2 * m_stride ) + { + p += m_stride; + } + return p; + } + + cbl_char_t + get_encoded_char(const void *base_, size_t location) const + { + const unsigned char *base = static_cast(base_); + const unsigned char *p = base + location; + cbl_char_t retval = 0; + + switch(m_stride) + { + case 1: + { + retval = p[0]; + break; + } + + case 2: + { + uint16_t c; + memcpy(&c, p, 2); + retval = c; + break; + } + + default: + { + uint32_t c; + memcpy(&c, p, 4); + retval = c; + break; + } + } + + return retval; + } + + void + put_encoded_char(cbl_char_t ch, void *base_, size_t location) const + { + unsigned char *base = static_cast(base_); + unsigned char *p = base + location; + + switch(m_stride) + { + case 1: + p[0] = static_cast(ch); + break; + + case 2: + store_uint16(p, static_cast(ch)); + break; + + default: + store_uint32(p, ch); + break; + } + } public: explicit charmap_t(cbl_encoding_t e) @@ -451,8 +575,7 @@ class charmap_t &outbuf, &outbytesleft); outlength = sizeof(response_) - outbytesleft; - const unsigned char *response = - reinterpret_cast(response_); + const unsigned char *response = charmap_as_unsigned_chars(response_); unsigned char char_0 = 0x00; @@ -508,10 +631,12 @@ class charmap_t m_stride = 4; if( response[0] == 0xFF && response[1] == 0xFE ) { + m_has_bom = true; char_0 = response[4]; } else if( response[0] == 0xFE && response[1] == 0xFF ) { + m_has_bom = true; m_is_big_endian = true; char_0 = response[7]; } @@ -553,14 +678,16 @@ class charmap_t bool has_bom() const { return m_has_bom ; } uint8_t stride() const { return m_stride ; } - cbl_char_t mapped_character(unsigned char ch) + cbl_char_t + mapped_character(unsigned char ch) { // The assumption is that anybody calling this routine is providing // a single-byte character in the DEFAULT_SOURCE_ENCODING encoding. We - // return the equivalent character in the m_encoding + // return the equivalent character in the m_encoding. cbl_char_t retval; std::unordered_map::const_iterator it = - m_map_of_encodings.find(ch); + m_map_of_encodings.find(ch); + if( it != m_map_of_encodings.end() ) { retval = it->second; @@ -574,17 +701,39 @@ class charmap_t &ch, 1, &outlength); + size_t data_length = outlength; + const unsigned char *p = charmap_as_unsigned_chars(mapped); + if( m_has_bom && data_length >= 2 * stride() ) + { + p = skip_bom(p, data_length); + data_length -= stride(); + } + switch(stride()) { case 1: - retval = *reinterpret_cast(mapped); + { + uint8_t c; + memcpy(&c, mapped, m_stride); + retval = c; break; + } + case 2: - retval = *reinterpret_cast(mapped); + { + uint16_t c; + memcpy(&c, mapped, m_stride); + retval = c; break; + } + case 4: - retval = *reinterpret_cast(mapped); + { + uint32_t c; + memcpy(&c, mapped, m_stride); + retval = c; break; + } } m_map_of_encodings[ch] = retval; } @@ -610,7 +759,7 @@ class charmap_t cbl_char_t high_value_character() { cbl_char_t retval = 0; - if( __gg__high_value_character == DEFAULT_HIGH_VALUE_8 ) + if( false && __gg__high_value_character == DEFAULT_HIGH_VALUE_8 ) { switch(m_stride) { @@ -690,26 +839,36 @@ class charmap_t switch(m_numeric_sign_type) { case sign_type_ascii: + { + uint32_t the_bit = m_is_big_endian + ? NUMERIC_DISPLAY_SIGN_BIT_ASCII << (m_stride-1) * 8 + : NUMERIC_DISPLAY_SIGN_BIT_ASCII; if( is_negative ) { - digit |= NUMERIC_DISPLAY_SIGN_BIT_ASCII; + digit |= the_bit; } else { - digit &= ~NUMERIC_DISPLAY_SIGN_BIT_ASCII; + digit &= ~the_bit; } break; + } case sign_type_ebcdic: + { + uint32_t the_bit = m_is_big_endian + ? NUMERIC_DISPLAY_SIGN_BIT_EBCDIC << (m_stride-1) * 8 + : NUMERIC_DISPLAY_SIGN_BIT_EBCDIC; if( is_negative ) { - digit &= ~NUMERIC_DISPLAY_SIGN_BIT_EBCDIC; + digit &= ~the_bit; } else { - digit |= NUMERIC_DISPLAY_SIGN_BIT_EBCDIC; + digit |= the_bit; } break; + } } return digit; } @@ -729,30 +888,28 @@ class charmap_t void memset(void *dest_, cbl_char_t ch, size_t bytelength) { - uint8_t *dest = static_cast(dest_); + unsigned char *dest = static_cast(dest_); switch(m_stride) { case 1: { if( (ch & 0xFFFFFF00) == 0x00000000 ) { - // This is the normal case of filling a buffer with a single byte - ::memset(dest, ch & 0xff, bytelength); + // This is the normal case of filling a buffer with a single byte. + std::memset(dest, ch & 0xff, bytelength); } else { // We are being asked to fill a byte-wide buffer with a multi-byte // character. - uint8_t byte3 = ch >> 24; - uint8_t byte2 = ch >> 16; - uint8_t byte1 = ch >> 8; - uint8_t byte0 = ch; - size_t fill; - size_t i=0; + unsigned char byte3 = static_cast(ch >> 24); + unsigned char byte2 = static_cast(ch >> 16); + unsigned char byte1 = static_cast(ch >> 8); + unsigned char byte0 = static_cast(ch); + size_t i = 0; if( byte3 ) { - fill = bytelength / 4; - while( i( + mapped_character(ascii_space)); } } break; @@ -789,104 +945,119 @@ class charmap_t case 2: { - assert( !(bytelength&1) ); + assert( !(bytelength & 1) ); // We know the target has an even number of bytes available. We also // know that each codepoint is usually one, but sometimes two, pairs - // of bytes - uint16_t top_half = ch>>16; - uint16_t bottom_half = ch; - size_t fill = bytelength; + // of bytes. + uint16_t top_half = static_cast(ch >> 16); + uint16_t bottom_half = static_cast(ch); size_t i = 0; - uint16_t *p = PTRCAST(uint16_t, dest); - while( i= fill ) + if( top_half ) { - break; + if( i + 4 <= bytelength ) + { + store_uint16(dest + i, top_half); + i += 2; + store_uint16(dest + i, bottom_half); + i += 2; + } + else + { + store_uint16(dest + i, + static_cast( + mapped_character(ascii_space))); + i += 2; + } } - if( top_half ) + else { - p[i/2] = bottom_half; + store_uint16(dest + i, bottom_half); i += 2; } } - if( i < bytelength ) - { - // We were trying to put two-pair values into the destination, but - // there were an odd number of pairs available. - p[i] = mapped_character(ascii_space); - i += 2; // cppcheck-suppress unreadVariable - } break; } case 4: { - assert( !(bytelength&3) ); - // We know the target has multiple of four bytes available. - uint32_t *p = PTRCAST(uint32_t, dest); - size_t i = 0; - while( i(base_); - switch(m_stride) - { - case 1: - *reinterpret_cast(base+location) = ch; - break; - case 2: - *reinterpret_cast(base+location) = ch; - break; - default: - *reinterpret_cast(base+location) = ch; - break; - } + put_encoded_char(ch, base_, location); } - void putch(cbl_char_t ch, void *base_, size_t *location) + void + putch(cbl_char_t ch, void *base_, size_t *location) { - // This routine puts a character at a location, and updates the location + // This routine puts a character at a location, and updates the location. this->putch(ch, base_, *location); *location += m_stride; } - cbl_char_t getch(const void *base_, size_t location) const + cbl_char_t + getch(const void *base_, size_t location) const + { + // This routine gets the encoded character at a byte location. + return get_encoded_char(base_, location); + } + + cbl_char_t + getch(const void *base_, size_t *location) const { - // This routine gets a character at a location - cbl_char_t retval; - const uint8_t *base = static_cast(base_); - switch(m_stride) + // This routine gets a character at a location, and updates the location. + cbl_char_t retval = this->getch(base_, *location); + *location += m_stride; + return retval; + } + + cbl_char_t + getch_native(const void *base_, size_t location) const + { + // This routine handles the situation where, for example, a character is + // picked up, and the program needs to know if is in the range of + // '0' through '9'. So, if the charset is big-endian, but this is a + // little-endian machine, then the value needs to be byte-flipped. + cbl_char_t retval = get_encoded_char(base_, location); + + // retval is the encoded value. + bool target_big_endian = cobol_target_big_endian() ; // cppcheck-suppress knownConditionTrueFalse + if( ( m_is_big_endian && !target_big_endian) // cppcheck-suppress knownConditionTrueFalse + || (!m_is_big_endian && target_big_endian) ) // cppcheck-suppress knownConditionTrueFalse { - case 1: - retval = *reinterpret_cast(base+location); - break; - case 2: - retval = *reinterpret_cast(base+location); - break; - default: - retval = *reinterpret_cast(base+location); - break; + // Flip the encoded value to match the machine's endianness + if( m_stride == 4 ) + { + retval = __builtin_bswap32(retval); + } + else + { + uint16_t v = retval; + v = __builtin_bswap16(v); + retval = v; + } } return retval; } - cbl_char_t getch(const void *base_, size_t *location) const + cbl_char_t + getch_native(const void *base_, size_t *location) const { - // This routine gets a character at a location, and updates the location - cbl_char_t retval = this->getch(base_, *location); + // This routine gets a character at a location, and updates the location. + cbl_char_t retval = this->getch_native(base_, *location); *location += m_stride; return retval; } @@ -908,93 +1079,64 @@ class charmap_t retval *= 10; retval += ch & 0x0F; } - *end = in + index-m_stride ; + *end = in + index - m_stride ; return retval; } - template size_t - Strlen( T *input, ssize_t limit = SSIZE_MAX ) { - size_t i; - for( i = 0; i < (limit / sizeof(T)) && input[i] != 0; i++ ) - ; - return i; - } - size_t strlen2( const void *converted, ssize_t limit = SSIZE_MAX ) { - switch(m_stride) { - case 1: - return Strlen( reinterpret_cast(converted), limit ); - case 2: - return Strlen( reinterpret_cast(converted), limit ); - case 4: - return Strlen( reinterpret_cast(converted), limit ); + strlen2(const void *converted, ssize_t limit = SSIZE_MAX) + { + return strlen(converted, limit) / m_stride; } - //// gcc_unreachable(); - return -1; // Mollify cppcheck. - } size_t - strlen( const void *converted, - ssize_t limit = SSIZE_MAX) + strlen(const void *converted, ssize_t limit = SSIZE_MAX) const { - size_t retval; + const unsigned char *p_start = + static_cast(converted); + size_t limit_bytes; - union + if( limit < 0 ) { - const uint8_t *p8 ; - const uint16_t *p16; - const uint32_t *p32; - } ; - const uint8_t *p_start = reinterpret_cast(converted); - p8 = p_start; - switch(m_stride) + limit_bytes = SIZE_MAX; + } + else { - case 1: - { - // Loop until the pointer is past the limit, or until we hit - // a character that is all zeroes - while(*p8) - { - if( p8 - p_start > limit ) - { - break; - } - p8 += 1; - } - break; - } - case 2: - { - // Loop until the pointer is past the limit, or until we hit - // a character that is all zeroes - while(*p16) - { - if( p8 - p_start > limit ) - { - break; - } - p8 += 2; - } - break; - } - case 4: + limit_bytes = static_cast(limit); + } + + size_t offset = 0; + while( offset + m_stride <= limit_bytes ) + { + if( getch(p_start, offset) == 0 ) { - // Loop until the pointer is past the limit, or until we hit - // a character that is all zeroes - while(*p32) - { - if( p8 - p_start > limit ) - { - break; - } - p8 += 4; - } break; } + offset += m_stride; } - retval = p8 - p_start; - return retval; + + return offset; + } + + void + get_byte_string(char *ach, char ch) + { + /* This routine takes a single ASCII character and converts it to the + m_stride bytes of the m_encoding, and copies those bytes to the ach + array, which had best be defined as ach[4] for generality. The idea + here is to create a byte stream that can be, for example, copied to + a file without going crazy about the endianness of the target machine + and the endianness of the encoding. */ + size_t nbytes; + const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING, + m_encoding, + &ch, + 1, + &nbytes); + memcpy(ach, converted, nbytes); } }; +char char_from_figconst(cbl_figconst_t figconst); + #endif