Project

General

Profile

nested-fk.p

Test program - Igor Skornyakov, 03/15/2023 12:43 PM

Download (13.1 KB)

 
1
DEFINE TEMP-TABLE tt-1 NO-UNDO
2
    NAMESPACE-URI "http://goldencode.com/testNamespace5" 
3
//    NAMESPACE-PREFIX "fwdPrefix1"  
4
    FIELD a1char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 
5
    FIELD a1int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'
6
    FIELD f1char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
7
    FIELD f1charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 
8
    FIELD f1decimal AS DECIMAL FORMAT "->>,>>9.99" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
9
    FIELD f1int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 
10
    FIELD f1int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 
11
    FIELD f1int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'   
12
    FIELD f1bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
13
    INDEX i1dx1 f1char
14
    INDEX i1dx2 a1char DESC f1char DESC
15
    INDEX i1dx3 AS UNIQUE f1int 
16
.
17

    
18
DEFINE TEMP-TABLE tt2 NO-UNDO
19
    NAMESPACE-URI "http://goldencode.com/testNamespace2"
20
//    NAMESPACE-PREFIX "fwdPrefix2"
21
    FIELD a2char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 
22
    FIELD a2int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'
23
    FIELD f2char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
24
    FIELD f2charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 
25
    FIELD f2decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
26
    FIELD f2int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 
27
    FIELD f2int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 
28
    FIELD f2int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  
29
    FIELD f2bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
30
    INDEX i2dx1 f2char
31
    INDEX i2dx2 a2char DESC f2char DESC
32
    INDEX i2dx3 AS UNIQUE f2int 
33
.
34

    
35
DEFINE TEMP-TABLE tt3 NO-UNDO
36
    NAMESPACE-URI "http://goldencode.com/testNamespace2"
37
    NAMESPACE-PREFIX "fwdPrefix3"
38
    FIELD a3char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 
39
    FIELD a3int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'
40
    FIELD f3char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
41
    FIELD f3charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 
42
    FIELD f3decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
43
    FIELD f3int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 
44
    FIELD f3int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 
45
    FIELD f3int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  
46
    FIELD f3bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
47
    INDEX i3dx1 f3char
48
    INDEX i3dx2 a3char DESC f3char DESC
49
    INDEX i3dx3 AS UNIQUE f3int 
50
.
51

    
52
DEFINE TEMP-TABLE tt4 NO-UNDO
53
    NAMESPACE-URI "http://goldencode.com/testNamespace5"
54
//    NAMESPACE-PREFIX "fwdPrefix4"
55
    FIELD a4char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 
56
    FIELD a4int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'
57
    FIELD f4char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
58
    FIELD f4charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 
59
    FIELD f4decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
60
    FIELD f4int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 
61
    FIELD f4int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 
62
    FIELD f4int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  
63
    FIELD f4bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
64
    INDEX i4dx1 f4char
65
    INDEX i4dx2 a4char DESC f4char DESC
66
    INDEX i4dx3 AS UNIQUE f4int 
67
.
68

    
69
DEFINE TEMP-TABLE tt5 NO-UNDO
70
    NAMESPACE-URI "http://goldencode.com/testNamespace5"
71
    NAMESPACE-PREFIX "fwdPrefix5"
72
    FIELD a5char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute' 
73
    FIELD a5int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE  'attribute'
74
    FIELD f5char  AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
75
    FIELD f5charcs  AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs" 
76
    FIELD f5decimal AS DECIMAL FORMAT "->>,>>9.9999" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
77
    FIELD f5int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int" 
78
    FIELD f5int1 AS INT  INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden' 
79
    FIELD f5int64 AS INT64 FORMAT "99999" INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'  
80
    FIELD f5bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
81
    INDEX i5dx1 f5char
82
    INDEX i5dx2 a5char DESC f5char DESC
83
    INDEX i5dx3 AS UNIQUE f5int 
84
.
85

    
86
DEFINE DATASET ds
87
    NAMESPACE-URI "http://goldencode.com/testNamespace" 
88
    NAMESPACE-PREFIX "fwdPrefix"
89
    FOR tt-1, tt2, tt3, tt4, tt5
90
    DATA-RELATION rel12 FOR tt-1, tt2 RELATION-FIELDS(f1int, f2int) NESTED FOREIGN-KEY-HIDDEN
91
    DATA-RELATION rel13 FOR tt-1, tt3 RELATION-FIELDS(f1int, f3int) NESTED FOREIGN-KEY-HIDDEN
92
    DATA-RELATION rel34 FOR tt3, tt4 RELATION-FIELDS(f3int, f4int) NESTED FOREIGN-KEY-HIDDEN
93
    DATA-RELATION rel51 FOR tt5, tt-1 RELATION-FIELDS(f5int, f1int) NESTED FOREIGN-KEY-HIDDEN
94
.
95
    
96
DEF VAR dsh AS HANDLE NO-UNDO.
97
DEF VAR hds AS HANDLE NO-UNDO.
98
DEF VAR hds1 AS HANDLE NO-UNDO.
99
DEF VAR hdss AS HANDLE NO-UNDO.
100
DEF VAR tth1 AS HANDLE NO-UNDO.
101
DEF VAR tth2 AS HANDLE NO-UNDO.
102
DEF VAR ttdh AS HANDLE NO-UNDO.
103
DEF VAR lRet AS LOGICAL NO-UNDO.
104
DEF VAR nmsg AS INTEGER NO-UNDO.
105
DEF VAR n AS INTEGER NO-UNDO.
106

    
107
OUTPUT TO 'ds-nested-test/ds-marshal.txt'.
108

    
109
CREATE tt-1. tt-1.f1char = '1.1111'. tt-1.f1int = 11. tt-1.f1decimal = 3.1465.
110
CREATE tt-1. tt-1.f1char = '1.2222'. tt-1.f1int = 12. tt-1.f1decimal = 3.1415926.
111

    
112
CREATE tt2. tt2.f2char = '2.1111'. tt2.f2int = 11. tt2.f2decimal = 3.1415.
113
CREATE tt2. tt2.f2char = '2.2222'. tt2.f2int = 22. tt2.f2decimal = 3.141515926.
114

    
115
CREATE tt3. tt3.f3char = '3.1111'. tt3.f3int = 11. tt3.f3decimal = 3.1415.
116
CREATE tt3. tt3.f3char = '3.2222'. tt3.f3int = 32. tt3.f3decimal = 3.141515926.
117

    
118
CREATE tt4. tt4.f4char = '4.1111'. tt4.f4int = 11. tt4.f4decimal = 3.1415.
119
CREATE tt4. tt4.f4char = '4.2222'. tt4.f4int = 42. tt4.f4decimal = 3.141515926.
120

    
121
CREATE tt5. tt5.f5char = '5.1111'. tt5.f5int = 11. tt5.f5decimal = 3.1415.
122
CREATE tt5. tt5.f5char = '5.2222'. tt5.f5int = 52. tt5.f5decimal = 3.141515926.
123

    
124
DEFINE STREAM xmlschema.
125
DEFINE STREAM xml.
126

    
127
CREATE DATASET hds.
128
CREATE DATASET hds1.
129
CREATE DATASET hdss.
130
CREATE TEMP-TABLE ttdh.
131

    
132
dsh = DATASET ds:HANDLE. 
133

    
134
tth1 = TEMP-TABLE tt-1:HANDLE. 
135
tth2 = TEMP-TABLE tt2:HANDLE. 
136

    
137
lRet = tth1:WRITE-XMLSCHEMA('file', 'ds-nested-test/tth1.xsd', TRUE,  'UTF-8', FALSE, FALSE).
138
MESSAGE 'tth1:WRITE-XMLSCHEMA' lRet.
139
lRet = tth1:WRITE-XMLSCHEMA('file', 'ds-nested-test/tth1-min.xsd', TRUE,  'UTF-8', TRUE, FALSE).
140
MESSAGE 'tth1:WRITE-XMLSCHEMA' lRet.
141
lRet = tth1:WRITE-XMLSCHEMA('file', 'ds-nested-test/tth1-nodef.xsd', TRUE,  'UTF-8', FALSE, TRUE).
142
MESSAGE 'tth1:WRITE-XMLSCHEMA' lRet.
143
lRet = tth1:WRITE-XMLSCHEMA('file', 'ds-nested-test/tth1-min-nodef.xsd', TRUE,  'UTF-8', TRUE, TRUE).
144
MESSAGE 'tth1:WRITE-XMLSCHEMA' lRet.
145
lRet = tth1:WRITE-XML('file', 'ds-nested-test/tth1.xml', TRUE,  'UTF-8', 'ds-nested-test/tth1.xsd', FALSE, FALSE, ?, FALSE).
146
MESSAGE 'tth1:WRITE-XML' lRet.
147

    
148
lRet = tth1:WRITE-JSON('file', 'ds-nested-test/tth1.json', TRUE, ?, FALSE, FALSE).
149
MESSAGE 'tth1:WRITE-JSON' lRet.
150

    
151
lRet = ttdh:READ-JSON('file', 'ds-nested-test/tth1.json', 'empty') NO-ERROR.
152
RUN show-error('ttdh:READ-JSON').
153
MESSAGE 'ttdh:READ-JSON' lRet.
154

    
155
IF lRet THEN DO:
156
    lRet = ttdh:WRITE-JSON('file', 'ds-nested-test/ttdh.json', TRUE, ?, FALSE, FALSE).
157
    MESSAGE 'ttdh:WRITE-JSON' lRet.
158
END.
159

    
160
lRet = dsh:WRITE-XMLSCHEMA('file', 'ds-nested-test/ds.xsd', TRUE,  'UTF-8', FALSE, FALSE).
161
MESSAGE 'dsh:WRITE-XMLSCHEMA' lRet.
162
lRet = dsh:WRITE-XMLSCHEMA('file', 'ds-nested-test/ds-min.xsd', TRUE,  'UTF-8', TRUE, FALSE).
163
MESSAGE 'dsh:WRITE-XMLSCHEMA min' lRet.
164
lRet = dsh:WRITE-XMLSCHEMA('file', 'ds-nested-test/ds-nodef.xsd', TRUE,  'UTF-8', FALSE, TRUE).
165
MESSAGE 'dsh:WRITE-XMLSCHEMA nodef' lRet.
166
lRet = dsh:WRITE-XMLSCHEMA('file', 'ds-nested-test/ds-min-nodef.xsd', TRUE,  'UTF-8', TRUE, TRUE).
167
MESSAGE 'dsh:WRITE-XMLSCHEMA min nodef' lRet.
168
lRet = dsh:WRITE-XML('file', 'ds-nested-test/ds.xml', TRUE,  'UTF-8', 'ds-nested-test/ds.xsd', FALSE, FALSE, ?, FALSE).
169
MESSAGE 'dsh:WRITE-XML' lRet.
170

    
171
lRet = hds:READ-XMLSCHEMA('file', 'ds-nested-test/ds.xsd', FALSE, ?, ?) NO-ERROR.
172
RUN show-error('hds:READ-XMLSCHEMA').
173
MESSAGE 'hds:READ-XMLSCHEMA' lRet.
174

    
175
lRet = hds:WRITE-XMLSCHEMA('file', 'ds-nested-test/hds.xsd', TRUE,  'UTF-8', FALSE, FALSE).
176
MESSAGE 'hds:WRITE-XMLSCHEMA' lRet.
177

    
178
lRet = hds:READ-XML('file', 'ds-nested-test/ds.xml', 'empty', 'ds-nested-test/ds.xsd', ?, ?, ?) NO-ERROR.
179
RUN show-error('hds:READ-XML').
180
MESSAGE 'hds:READ-XML' lRet.
181

    
182
lRet = hds:WRITE-XML('file', 'ds-nested-test/hds.xml', TRUE,  'UTF-8', 'ds-nested-test/hds.xsd', FALSE, FALSE, ?, FALSE).
183
MESSAGE 'hds:WRITE-XML' lRet.
184

    
185
DEF VAR htt AS HANDLE NO-UNDO.
186
n = 1.
187
DO WHILE n <= hds:NUM-BUFFERS.
188
    htt = hds:GET-BUFFER-HANDLE(n).
189
    lRet = htt:WRITE-XML('file', 'ds-nested-test/hds-' + STRING(n) + '.xml', TRUE,  ?, ?, FALSE, FALSE, ?, FALSE).
190
    MESSAGE 'hds' + STRING(n) + ':WRITE-XML' lRet.
191
    n = n + 1.
192
END.
193

    
194
lRet = dsh:WRITE-JSON('file', 'ds-nested-test/ds.json', TRUE, ?, FALSE, FALSE).
195
MESSAGE 'dsh:WRITE-JSON' lRet.
196

    
197
lRet = hdss:READ-JSON('file', 'ds-nested-test/ds.json', 'empty') NO-ERROR.
198
RUN show-error('hdss:READ-JSON').
199
MESSAGE 'hdss:READ-JSON' lRet.
200

    
201
lRet = hdss:WRITE-JSON('file', 'ds-nested-test/hdss.json', TRUE, ?, FALSE, FALSE).
202
MESSAGE 'hdss:WRITE-JSON' lRet.
203

    
204
dsh:EMPTY-DATASET().
205
MESSAGE 'dsh:EMPTY-DATASET' lRet.
206

    
207
lRet = dsh:READ-JSON('file', 'ds-nested-test/ds.json', 'empty') NO-ERROR.
208
RUN show-error('dsh:READ-JSON').
209
MESSAGE 'dsh:READ-JSON.1' lRet.
210

    
211
lRet = dsh:WRITE-JSON('file', 'ds-nested-test/ds.1.json', TRUE, ?, FALSE, FALSE).
212
MESSAGE 'dsh:WRITE-JSON.1' lRet.
213

    
214
n = 1.
215
DO WHILE n <= dsh:NUM-BUFFERS.
216
    htt = dsh:GET-BUFFER-HANDLE(n).
217
    lRet = htt:WRITE-JSON('file', 'ds-nested-test/ds.1-' + STRING(n) + '.json', TRUE, ?, FALSE, FALSE).
218
    MESSAGE 'dsh' + STRING(n) + ':WRITE-JSON.1' lRet.
219
    n = n + 1.
220
END.
221

    
222
lRet = dsh:EMPTY-DATASET().
223
MESSAGE 'dsh:EMPTY-DATASET' lRet.
224

    
225
lRet = dsh:READ-XML('file', 'ds-nested-test/ds.xml', 'empty', 'ds-nested-test/ds.xsd', ?, ?, ?) NO-ERROR.
226
RUN show-error('dsh:READ-XML').
227
MESSAGE 'dsh:READ-XML' lRet.
228

    
229
lRet = dsh:WRITE-XML('file', 'ds-nested-test/dsh.1.xml', TRUE,  'UTF-8', 'ds-nested-test/ds.xsd', FALSE, FALSE, ?, FALSE).
230
MESSAGE 'dsh:WRITE-XML.1' lRet.
231

    
232
n = 1.
233
DO WHILE n <= dsh:NUM-BUFFERS.
234
    htt = dsh:GET-BUFFER-HANDLE(n).
235
    lRet = htt:WRITE-XML('file', 'ds-nested-test/dsh-' + STRING(n) + '.xml', TRUE,  ?, ?, FALSE, FALSE, ?, FALSE).
236
    MESSAGE 'dsh' + STRING(n) + ':WRITE-XML' lRet.
237
    n = n + 1.
238
END.
239

    
240

    
241
lRet = hds1:READ-XMLSCHEMA('file', 'ds-nested-test/hds.xsd', FALSE, ?, ?) NO-ERROR.
242
RUN show-error('hds1:READ-XMLSCHEMA').
243
MESSAGE 'hds1:READ-XMLSCHEMA' lRet.
244

    
245
lRet = hds1:WRITE-XMLSCHEMA('file', 'ds-nested-test/hds1.xsd', TRUE,  'UTF-8', FALSE, FALSE).
246
MESSAGE 'hds1:WRITE-XMLSCHEMA' lRet.
247

    
248
lRet = hds1:WRITE-XML('file', 'ds-nested-test/hds1.xml', TRUE,  'UTF-8', 'ds-nested-test/hds1.xsd', FALSE, FALSE, ?, FALSE).
249
MESSAGE 'hds:WRITE-XML' lRet.
250

    
251
/*
252
lRet = hds1:WRITE-XMLSCHEMA('file', 'ds-nested-test/hds1.xsd', TRUE,  'UTF-8', FALSE, FALSE).
253
MESSAGE 'hds1:WRITE-XMLSCHEMA' lRet.
254
*/
255

    
256
OUTPUT CLOSE.
257

    
258
PROCEDURE show-error:
259
    DEF INPUT PARAM action AS CHAR.
260

    
261
    MESSAGE "After" action ": error =" ERROR-STATUS:ERROR 
262
            "num-messages =" ERROR-STATUS:NUM-MESSAGES 
263
            "type =" ERROR-STATUS:TYPE 
264
            .
265
    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
266
        DO nmsg = 1 TO ERROR-STATUS:NUM-MESSAGES:
267
          MESSAGE "***" ERROR-STATUS:GET-NUMBER(nmsg) ':' ERROR-STATUS:GET-MESSAGE(nmsg).
268
        END.
269
    END.                      
270
END.