| 3838 | // |
| 3839 | |
| 3840 | static void make_array_declaration( ref* reference) |
| 3841 | { |
| 3842 | gpre_fld* field = reference->ref_field; |
| 3843 | const TEXT* name = field->fld_symbol->sym_string; |
| 3844 | |
| 3845 | // Don't generate multiple declarations for the array. V3 Bug 569. |
| 3846 | |
| 3847 | if (field->fld_array_info->ary_declared) |
| 3848 | return; |
| 3849 | |
| 3850 | field->fld_array_info->ary_declared = true; |
| 3851 | |
| 3852 | fprintf(gpreGlob.out_file, "%s01 %s%dL.\n", |
| 3853 | COLUMN8, names[isc_a_pos], field->fld_array_info->ary_ident); |
| 3854 | TEXT space[128]; |
| 3855 | strcpy(space, " "); |
| 3856 | |
| 3857 | // Print out the dimension part of the declaration |
| 3858 | const dim* dimension = field->fld_array_info->ary_dimension; |
| 3859 | int i = 3; |
| 3860 | for (; dimension->dim_next; dimension = dimension->dim_next, i += 2) |
| 3861 | { |
| 3862 | const int dimension_size = dimension->dim_upper - dimension->dim_lower + 1; |
| 3863 | printa(space, false, "%02d %s%d%s%d OCCURS %d TIMES.", |
| 3864 | i, names[isc_a_pos], field->fld_array_info->ary_ident, |
| 3865 | names[UNDER], i, dimension_size); |
| 3866 | strcat(space, " "); // Will overflow at 41 dimensions, is it relevant? |
| 3867 | } |
| 3868 | |
| 3869 | TEXT string1[256]; |
| 3870 | TEXT* p = string1; |
| 3871 | const int dimension_size = dimension->dim_upper - dimension->dim_lower + 1; |
| 3872 | sprintf(p, "%02d %s%d OCCURS %d TIMES ", |
| 3873 | i, names[isc_a_pos], field->fld_array_info->ary_ident, dimension_size); |
| 3874 | while (*p) |
| 3875 | p++; |
| 3876 | |
| 3877 | SSHORT digits, scale; |
| 3878 | |
| 3879 | switch (field->fld_array_info->ary_dtype) |
| 3880 | { |
| 3881 | case dtype_short: |
| 3882 | case dtype_long: |
| 3883 | case dtype_int64: |
| 3884 | if (field->fld_array_info->ary_dtype == dtype_short) |
| 3885 | digits = 5; |
| 3886 | else if (field->fld_array_info->ary_dtype == dtype_long) |
| 3887 | digits = 10; |
| 3888 | else |
| 3889 | digits = 19; |
| 3890 | scale = field->fld_array->fld_scale; |
| 3891 | strcpy(p, "PIC S"); |
| 3892 | while (*p) |
| 3893 | p++; |
| 3894 | if (scale >= -digits && scale <= 0) |
| 3895 | { |
| 3896 | if (scale > -digits) |
| 3897 | sprintf(p, "9(%d)", digits + scale); |
no test coverage detected