Rev 748 | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 748 | Rev 749 | ||
---|---|---|---|
Line 16... | Line 16... | ||
16 | 16 | ||
17 | function CompareOIDArcList(a, b: PStringList): integer; |
17 | function CompareOIDArcList(a, b: PStringList): integer; |
18 | function CompareOID(a, b: string): integer; |
18 | function CompareOID(a, b: string): integer; |
19 | procedure ListBubbleSortOID(list: PStringList); |
19 | procedure ListBubbleSortOID(list: PStringList); |
20 | function ASN1IDValid(asn1id: string): boolean; |
20 | function ASN1IDValid(asn1id: string): boolean; |
21 | function UnicodeLabelValid(unicodeLabel: string): boolean; |
21 | function UnicodeLabelValid(arc: string): boolean; |
22 | 22 | ||
23 | implementation |
23 | implementation |
24 | 24 | ||
25 | uses |
25 | uses |
26 | VtsFuncs; |
26 | VtsFuncs; |
Line 127... | Line 127... | ||
127 | end; |
127 | end; |
128 | if lastChar = '-' then exit; (* may not end with '-' *) |
128 | if lastChar = '-' then exit; (* may not end with '-' *) |
129 | ASN1IDValid := true; |
129 | ASN1IDValid := true; |
130 | end; |
130 | end; |
131 | 131 | ||
- | 132 | (* Note: Since this is DOS, we don't support Unicode, so we just check *) |
|
- | 133 | (* for Latin characters in the Unicode Label *) |
|
132 | function UnicodeLabelValid(unicodeLabel: string): boolean; |
134 | function IriCharValid(c: char; firstchar, lastchar: boolean): boolean; |
133 | begin |
135 | begin |
134 | UnicodeLabelValid := true; |
- | |
135 | (* TODO: Implement *) |
136 | (* see Rec. ITU-T X.660, clause 7.5 *) |
136 | 137 | ||
- | 138 | if ((firstchar or lastchar) and (c = '-')) then |
|
- | 139 | begin |
|
- | 140 | IriCharValid := false; |
|
- | 141 | Exit; |
|
137 | (* |
142 | end; |
138 | 143 | ||
- | 144 | if (c in ['-', '.', '_', '~']) then |
|
- | 145 | begin |
|
- | 146 | IriCharValid := true; |
|
- | 147 | Exit; |
|
- | 148 | end; |
|
139 | 149 | ||
140 | function iri_char_valid($c, $firstchar, $lastchar) { |
150 | if ((c in ['0'..'9']) and not firstchar) or |
- | 151 | (c in ['A'..'Z']) or |
|
141 | // see Rec. ITU-T X.660, clause 7.5 |
152 | (c in ['a'..'z']) then |
- | 153 | begin |
|
- | 154 | IriCharValid := true; |
|
- | 155 | Exit; |
|
- | 156 | end; |
|
142 | 157 | ||
- | 158 | (* |
|
- | 159 | v = mb_ord(c); |
|
- | 160 | if ((v >= 0x000000A0) && (v <= 0x0000DFFE)) return true; |
|
- | 161 | if ((v >= 0x0000F900) && (v <= 0x0000FDCF)) return true; |
|
143 | if (($firstchar || $lastchar) && ($c == '-')) return false; |
162 | if ((v >= 0x0000FDF0) && (v <= 0x0000FFEF)) return true; |
- | 163 | if ((v >= 0x00010000) && (v <= 0x0001FFFD)) return true; |
|
- | 164 | if ((v >= 0x00020000) && (v <= 0x0002FFFD)) return true; |
|
- | 165 | if ((v >= 0x00030000) && (v <= 0x0003FFFD)) return true; |
|
- | 166 | if ((v >= 0x00040000) && (v <= 0x0004FFFD)) return true; |
|
- | 167 | if ((v >= 0x00050000) && (v <= 0x0005FFFD)) return true; |
|
- | 168 | if ((v >= 0x00060000) && (v <= 0x0006FFFD)) return true; |
|
- | 169 | if ((v >= 0x00070000) && (v <= 0x0007FFFD)) return true; |
|
- | 170 | if ((v >= 0x00080000) && (v <= 0x0008FFFD)) return true; |
|
- | 171 | if ((v >= 0x00090000) && (v <= 0x0009FFFD)) return true; |
|
- | 172 | if ((v >= 0x000A0000) && (v <= 0x000AFFFD)) return true; |
|
- | 173 | if ((v >= 0x000B0000) && (v <= 0x000BFFFD)) return true; |
|
- | 174 | if ((v >= 0x000C0000) && (v <= 0x000CFFFD)) return true; |
|
- | 175 | if ((v >= 0x000D0000) && (v <= 0x000DFFFD)) return true; |
|
- | 176 | if ((v >= 0x000E1000) && (v <= 0x000EFFFD)) return true; |
|
- | 177 | *) |
|
144 | 178 | ||
145 | if ($c == '-') return true; |
- | |
146 | if ($c == '.') return true; |
- | |
147 | if ($c == '_') return true; |
- | |
148 | if ($c == '~') return true; |
- | |
149 | if (($c >= '0') && ($c <= '9') && (!$firstchar)) return true; |
- | |
150 | if (($c >= 'A') && ($c <= 'Z')) return true; |
- | |
151 | if (($c >= 'a') && ($c <= 'z')) return true; |
- | |
152 | - | ||
153 | $v = mb_ord($c); |
- | |
154 | - | ||
155 | if (($v >= 0x000000A0) && ($v <= 0x0000DFFE)) return true; |
- | |
156 | if (($v >= 0x0000F900) && ($v <= 0x0000FDCF)) return true; |
- | |
157 | if (($v >= 0x0000FDF0) && ($v <= 0x0000FFEF)) return true; |
- | |
158 | if (($v >= 0x00010000) && ($v <= 0x0001FFFD)) return true; |
- | |
159 | if (($v >= 0x00020000) && ($v <= 0x0002FFFD)) return true; |
- | |
160 | if (($v >= 0x00030000) && ($v <= 0x0003FFFD)) return true; |
- | |
161 | if (($v >= 0x00040000) && ($v <= 0x0004FFFD)) return true; |
- | |
162 | if (($v >= 0x00050000) && ($v <= 0x0005FFFD)) return true; |
- | |
163 | if (($v >= 0x00060000) && ($v <= 0x0006FFFD)) return true; |
- | |
164 | if (($v >= 0x00070000) && ($v <= 0x0007FFFD)) return true; |
- | |
165 | if (($v >= 0x00080000) && ($v <= 0x0008FFFD)) return true; |
- | |
166 | if (($v >= 0x00090000) && ($v <= 0x0009FFFD)) return true; |
- | |
167 | if (($v >= 0x000A0000) && ($v <= 0x000AFFFD)) return true; |
- | |
168 | if (($v >= 0x000B0000) && ($v <= 0x000BFFFD)) return true; |
- | |
169 | if (($v >= 0x000C0000) && ($v <= 0x000CFFFD)) return true; |
- | |
170 | if (($v >= 0x000D0000) && ($v <= 0x000DFFFD)) return true; |
- | |
171 | if (($v >= 0x000E1000) && ($v <= 0x000EFFFD)) return true; |
- | |
172 | - | ||
173 | // Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked |
179 | (* Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked *) |
174 | // in ISO/IEC 10646 as "(This position shall not be used)" |
180 | (* in ISO/IEC 10646 as "(This position shall not be used)" *) |
175 | // But tool implementers should be tolerate them, since these limitations can be removed in future. |
181 | (* But tool implementers should be tolerate them, since these limitations can be removed in future. *) |
176 | - | ||
177 | return false; |
- | |
178 | } |
- | |
179 | - | ||
180 | function iri_arc_valid($arc, $allow_numeric=true) { |
- | |
181 | if ($arc == '') return false; |
- | |
182 | - | ||
183 | $m = array(); |
- | |
184 | if ($allow_numeric && preg_match('@^(\\d+)$@', $arc, $m)) return true; # numeric arc |
- | |
185 | - | ||
186 | // Question: Should we strip RTL/LTR characters? |
- | |
187 | - | ||
188 | if (mb_substr($arc, 2, 2) == '--') return false; // see Rec. ITU-T X.660, clause 7.5.4 |
- | |
189 | - | ||
190 | $array = array(); |
- | |
191 | preg_match_all('/./u', $arc, $array, PREG_SET_ORDER); |
- | |
192 | $len = count($array); |
- | |
193 | foreach ($array as $i => $char) { |
- | |
194 | if (!iri_char_valid($char[0], $i==0, $i==$len-1)) return false; |
- | |
195 | } |
- | |
196 | 182 | ||
197 | return true; |
183 | IriCharValid := false; |
198 | } |
184 | end; |
199 | 185 | ||
- | 186 | function UnicodeLabelValid(arc: string): boolean; |
|
- | 187 | var |
|
- | 188 | i: integer; |
|
- | 189 | firstchar, lastchar: boolean; |
|
- | 190 | begin |
|
- | 191 | if arc = '' then |
|
- | 192 | begin |
|
- | 193 | UnicodeLabelValid := false; |
|
- | 194 | Exit; |
|
- | 195 | end; |
|
200 | 196 | ||
- | 197 | if (Copy(arc, 3, 2) = '--') then (* see Rec. ITU-T X.660, clause 7.5.4 *) |
|
- | 198 | begin |
|
- | 199 | UnicodeLabelValid := false; |
|
201 | *) |
200 | Exit; |
- | 201 | end; |
|
202 | 202 | ||
- | 203 | for i := 1 to Length(arc) do |
|
- | 204 | begin |
|
- | 205 | firstchar := i = 1; |
|
- | 206 | lastchar := i = Length(arc); |
|
- | 207 | if not IriCharValid(arc[i], firstchar, lastchar) then |
|
- | 208 | begin |
|
- | 209 | UnicodeLabelValid := false; |
|
- | 210 | Exit; |
|
- | 211 | end; |
|
- | 212 | end; |
|
- | 213 | ||
- | 214 | UnicodeLabelValid := true; |
|
203 | end; |
215 | end; |
204 | 216 | ||
205 | end. |
217 | end. |