OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxa4026.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CXA4026.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9
--     this public release, the Government intends to confer upon all
10
--     recipients unlimited rights  equal to those held by the Government.
11
--     These rights include rights to use, duplicate, release or disclose the
12
--     released technical data and computer software in whole or in part, in
13
--     any manner and for any purpose whatsoever, and to have or permit others
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
--
26
-- OBJECTIVE:
27
--      Check that Ada.Strings.Fixed procedures Head, Tail, and Trim, as well
28
--      as the versions of subprograms Translate (procedure and function),
29
--      Index, and Count, available in the package which use a
30
--      Maps.Character_Mapping_Function input parameter, produce correct
31
--      results.
32
--
33
-- TEST DESCRIPTION:
34
--      This test examines the operation of several subprograms contained in
35
--      the Ada.Strings.Fixed package.
36
--      This includes procedure versions of Head, Tail, and Trim, as well as
37
--      four subprograms that use a Character_Mapping_Function as a parameter
38
--      to provide the mapping capability.
39
--
40
--      Two functions are defined to provide the mapping.  Access values
41
--      are defined to refer to these functions.  One of the functions will
42
--      map upper case characters in the range 'A'..'Z' to their lower case
43
--      counterparts, while the other function will map lower case characters
44
--      ('a'..'z', or a character whose position is in one of the ranges
45
--      223..246 or 248..255, provided the character has an upper case form)
46
--      to their upper case form.
47
--
48
--      Function Index uses the mapping function access value to map the input
49
--      string prior to searching for the appropriate index value to return.
50
--      Function Count uses the mapping function access value to map the input
51
--      string prior to counting the occurrences of the pattern string.
52
--      Both the Procedure and Function version of Translate use the mapping
53
--      function access value to perform the translation.
54
--
55
--      Results of all subprograms are compared with expected results.
56
--
57
--
58
-- CHANGE HISTORY:
59
--      10 Feb 95   SAIC    Initial prerelease version
60
--      21 Apr 95   SAIC    Modified definition of string variable Str_2.
61
--
62
--!
63
 
64
 
65
package CXA4026_0 is
66
 
67
   -- Function Map_To_Lower_Case will return the lower case form of
68
   -- Characters in the range 'A'..'Z' only, and return the input
69
   -- character otherwise.
70
 
71
   function Map_To_Lower_Case (From : Character) return Character;
72
 
73
 
74
   -- Function Map_To_Upper_Case will return the upper case form of
75
   -- Characters in the range 'a'..'z', or whose position is in one
76
   -- of the ranges 223..246 or 248..255, provided the character has
77
   -- an upper case form.
78
 
79
   function Map_To_Upper_Case (From : Character) return Character;
80
 
81
end CXA4026_0;
82
 
83
 
84
with Ada.Characters.Handling;
85
package body CXA4026_0 is
86
 
87
   function Map_To_Lower_Case (From : Character) return Character is
88
   begin
89
      if From in 'A'..'Z' then
90
         return Character'Val(Character'Pos(From) -
91
                             (Character'Pos('A') - Character'Pos('a')));
92
      else
93
         return From;
94
      end if;
95
   end Map_To_Lower_Case;
96
 
97
   function Map_To_Upper_Case (From : Character) return Character is
98
   begin
99
      return Ada.Characters.Handling.To_Upper(From);
100
   end Map_To_Upper_Case;
101
 
102
end CXA4026_0;
103
 
104
 
105
with CXA4026_0;
106
with Ada.Strings.Fixed;
107
with Ada.Strings.Maps;
108
with Ada.Characters.Handling;
109
with Ada.Characters.Latin_1;
110
with Report;
111
 
112
procedure CXA4026 is
113
 
114
begin
115
 
116
   Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " &
117
                           "as well as the versions of subprograms "      &
118
                           "Translate, Index, and Count, which use the "  &
119
                           "Character_Mapping_Function input parameter,"  &
120
                           "produce correct results");
121
 
122
   Test_Block:
123
   declare
124
 
125
      use Ada.Strings, CXA4026_0;
126
 
127
      -- The following strings are used in examination of the Translation
128
      -- subprograms.
129
 
130
      New_Character_String : String(1..10) :=
131
                               Ada.Characters.Latin_1.LC_A_Grave          &
132
                               Ada.Characters.Latin_1.LC_A_Ring           &
133
                               Ada.Characters.Latin_1.LC_AE_Diphthong     &
134
                               Ada.Characters.Latin_1.LC_C_Cedilla        &
135
                               Ada.Characters.Latin_1.LC_E_Acute          &
136
                               Ada.Characters.Latin_1.LC_I_Circumflex     &
137
                               Ada.Characters.Latin_1.LC_Icelandic_Eth    &
138
                               Ada.Characters.Latin_1.LC_N_Tilde          &
139
                               Ada.Characters.Latin_1.LC_O_Oblique_Stroke &
140
                               Ada.Characters.Latin_1.LC_Icelandic_Thorn;
141
 
142
 
143
      TC_New_Character_String : String(1..10) :=
144
                               Ada.Characters.Latin_1.UC_A_Grave          &
145
                               Ada.Characters.Latin_1.UC_A_Ring           &
146
                               Ada.Characters.Latin_1.UC_AE_Diphthong     &
147
                               Ada.Characters.Latin_1.UC_C_Cedilla        &
148
                               Ada.Characters.Latin_1.UC_E_Acute          &
149
                               Ada.Characters.Latin_1.UC_I_Circumflex     &
150
                               Ada.Characters.Latin_1.UC_Icelandic_Eth    &
151
                               Ada.Characters.Latin_1.UC_N_Tilde          &
152
                               Ada.Characters.Latin_1.UC_O_Oblique_Stroke &
153
                               Ada.Characters.Latin_1.UC_Icelandic_Thorn;
154
 
155
 
156
      -- Functions used to supply mapping capability.
157
 
158
 
159
      -- Access objects that will be provided as parameters to the
160
      -- subprograms.
161
 
162
      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
163
                                Map_To_Lower_Case'Access;
164
 
165
      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
166
                                Map_To_Upper_Case'Access;
167
 
168
 
169
   begin
170
 
171
      -- Function Index, Forward direction search.
172
      -- Note: Several of the following cases use the default value
173
      --       Forward for the Going parameter.
174
 
175
      if Fixed.Index(Source => "The library package Strings.Fixed",
176
                     Pattern => "fix",
177
                     Going   => Ada.Strings.Forward,
178
                     Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
179
         Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN",
180
                     "ain",
181
                     Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
182
         Fixed.Index("maximum number",
183
                     "um",
184
                     Ada.Strings.Forward,
185
                     Map_To_Lower_Case_Ptr)               /= 6    or
186
         Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
187
                     "MIXED CASE STRING",
188
                     Ada.Strings.Forward,
189
                     Map_To_Upper_Case_Ptr)               /= 12   or
190
         Fixed.Index("STRING WITH NO MATCHING PATTERNS",
191
                     "WITH",
192
                     Ada.Strings.Forward,
193
                     Map_To_Lower_Case_Ptr)               /= 0    or
194
         Fixed.Index("THIS STRING IS IN UPPER CASE",
195
                     "IS",
196
                     Ada.Strings.Forward,
197
                     Map_To_Upper_Case_Ptr)               /= 3    or
198
         Fixed.Index("",  -- Null string.
199
                     "is",
200
                     Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
201
         Fixed.Index("AAABBBaaabbb",
202
                     "aabb",
203
                     Mapping => Map_To_Lower_Case_Ptr)    /= 2
204
      then
205
         Report.Failed("Incorrect results from Function Index, going "    &
206
                       "in Forward direction, using a Character Mapping " &
207
                       "Function parameter");
208
      end if;
209
 
210
 
211
 
212
      -- Function Index, Backward direction search.
213
 
214
      if Fixed.Index("Case of a Mixed Case String",
215
                     "case",
216
                     Ada.Strings.Backward,
217
                     Map_To_Lower_Case_Ptr)               /= 17   or
218
         Fixed.Index("Case of a Mixed Case String",
219
                     "CASE",
220
                     Ada.Strings.Backward,
221
                     Map_To_Upper_Case_Ptr)               /= 17   or
222
         Fixed.Index("rain, Rain, and more RAIN",
223
                     "rain",
224
                     Ada.Strings.Backward,
225
                     Map_To_Lower_Case_Ptr)               /= 22   or
226
         Fixed.Index("RIGHT place, right time",
227
                     "RIGHT",
228
                     Ada.Strings.Backward,
229
                     Map_To_Upper_Case_Ptr)               /= 14   or
230
         Fixed.Index("WOULD MATCH BUT FOR THE CASE",
231
                     "WOULD MATCH BUT FOR THE CASE",
232
                     Ada.Strings.Backward,
233
                     Map_To_Lower_Case_Ptr)               /= 0
234
      then
235
         Report.Failed("Incorrect results from Function Index, going "     &
236
                       "in Backward direction, using a Character Mapping " &
237
                       "Function parameter");
238
      end if;
239
 
240
 
241
 
242
      -- Function Index, Pattern_Error if Pattern = Null_String
243
 
244
      declare
245
         use Ada.Strings.Fixed;
246
         Null_Pattern_String : constant String := "";
247
         TC_Natural          : Natural         := 1000;
248
      begin
249
         TC_Natural := Index("A Valid String",
250
                             Null_Pattern_String,
251
                             Ada.Strings.Forward,
252
                             Map_To_Lower_Case_Ptr);
253
         Report.Failed("Pattern_Error not raised by Function Index when " &
254
                       "given a null pattern string");
255
      exception
256
         when Pattern_Error => null;   -- OK, expected exception.
257
         when others        =>
258
            Report.Failed("Incorrect exception raised by Function Index " &
259
                          "using a Character Mapping Function parameter " &
260
                          "when given a null pattern string");
261
      end;
262
 
263
 
264
 
265
      -- Function Count.
266
 
267
      if Fixed.Count(Source  => "ABABABA",
268
                     Pattern => "aba",
269
                     Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
270
         Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /=  0   or
271
         Fixed.Count("This IS a MISmatched issue",
272
                     "is",
273
                     Map_To_Lower_Case_Ptr)                   /=  4   or
274
         Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /=  2   or
275
         Fixed.Count("This IS a MISmatched issue",
276
                     "is",
277
                     Map_To_Upper_Case_Ptr)                   /=  0   or
278
         Fixed.Count("She sells sea shells by the sea shore",
279
                     "s",
280
                     Map_To_Lower_Case_Ptr)                   /=  8   or
281
         Fixed.Count("",                       -- Null string.
282
                     "match",
283
                     Map_To_Upper_Case_Ptr)                   /=  0
284
      then
285
         Report.Failed("Incorrect results from Function Count, using " &
286
                       "a Character Mapping Function parameter");
287
      end if;
288
 
289
 
290
 
291
      -- Function Count, Pattern_Error if Pattern = Null_String
292
 
293
      declare
294
         use Ada.Strings.Fixed;
295
         Null_Pattern_String : constant String := "";
296
         TC_Natural          : Natural         := 1000;
297
      begin
298
         TC_Natural := Count("A Valid String",
299
                             Null_Pattern_String,
300
                             Map_To_Lower_Case_Ptr);
301
         Report.Failed("Pattern_Error not raised by Function Count using " &
302
                       "a Character Mapping Function parameter when "      &
303
                       "given a null pattern string");
304
      exception
305
         when Pattern_Error => null;   -- OK, expected exception.
306
         when others        =>
307
            Report.Failed("Incorrect exception raised by Function Count " &
308
                          "using a Character Mapping Function parameter " &
309
                          "when given a null pattern string");
310
      end;
311
 
312
 
313
 
314
      -- Function Translate.
315
 
316
      if Fixed.Translate(Source  => "A Sample Mixed Case String",
317
                         Mapping => Map_To_Lower_Case_Ptr) /=
318
         "a sample mixed case string"                         or
319
 
320
         Fixed.Translate("ALL LOWER CASE",
321
                         Map_To_Lower_Case_Ptr)            /=
322
         "all lower case"                                     or
323
 
324
         Fixed.Translate("end with lower case",
325
                         Map_To_Lower_Case_Ptr)            /=
326
         "end with lower case"                                or
327
 
328
         Fixed.Translate("", Map_To_Lower_Case_Ptr)        /=
329
         ""                                                   or
330
 
331
         Fixed.Translate("start with lower case",
332
                         Map_To_Upper_Case_Ptr)            /=
333
         "START WITH LOWER CASE"                              or
334
 
335
         Fixed.Translate("ALL UPPER CASE STRING",
336
                         Map_To_Upper_Case_Ptr)            /=
337
         "ALL UPPER CASE STRING"                              or
338
 
339
         Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
340
                         Map_To_Upper_Case_Ptr)            /=
341
         "LOTS OF MIXED CASE CHARACTERS"                      or
342
 
343
         Fixed.Translate("", Map_To_Upper_Case_Ptr)        /=
344
         ""                                                   or
345
 
346
         Fixed.Translate(New_Character_String,
347
                         Map_To_Upper_Case_Ptr)            /=
348
         TC_New_Character_String
349
      then
350
         Report.Failed("Incorrect results from Function Translate, using " &
351
                       "a Character Mapping Function parameter");
352
      end if;
353
 
354
 
355
 
356
      -- Procedure Translate.
357
 
358
      declare
359
 
360
         use Ada.Strings.Fixed;
361
 
362
         Str_1    : String(1..24)   := "AN ALL UPPER CASE STRING";
363
         Str_2    : String(1..19)   := "A Mixed Case String";
364
         Str_3    : String(1..32)   := "a string with lower case letters";
365
         TC_Str_1 : constant String := Str_1;
366
         TC_Str_3 : constant String := Str_3;
367
 
368
      begin
369
 
370
         Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
371
 
372
         if Str_1 /= "an all upper case string" then
373
            Report.Failed("Incorrect result from Procedure Translate - 1");
374
         end if;
375
 
376
         Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
377
 
378
         if Str_1 /= TC_Str_1 then
379
            Report.Failed("Incorrect result from Procedure Translate - 2");
380
         end if;
381
 
382
         Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);
383
 
384
         if Str_2 /= "a mixed case string" then
385
            Report.Failed("Incorrect result from Procedure Translate - 3");
386
         end if;
387
 
388
         Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);
389
 
390
         if Str_2 /= "A MIXED CASE STRING" then
391
            Report.Failed("Incorrect result from Procedure Translate - 4");
392
         end if;
393
 
394
         Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);
395
 
396
         if Str_3 /= TC_Str_3 then
397
            Report.Failed("Incorrect result from Procedure Translate - 5");
398
         end if;
399
 
400
         Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);
401
 
402
         if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
403
            Report.Failed("Incorrect result from Procedure Translate - 6");
404
         end if;
405
 
406
         Translate(New_Character_String, Map_To_Upper_Case_Ptr);
407
 
408
         if New_Character_String /= TC_New_Character_String then
409
            Report.Failed("Incorrect result from Procedure Translate - 6");
410
         end if;
411
 
412
      end;
413
 
414
 
415
      -- Procedure Trim.
416
 
417
      declare
418
         Use Ada.Strings.Fixed;
419
         Trim_String : String(1..30) := "    A string of characters    ";
420
      begin
421
 
422
         Trim(Source  => Trim_String,
423
              Side    => Ada.Strings.Left,
424
              Justify => Ada.Strings.Right,
425
              Pad     => 'x');
426
 
427
         if Trim_String /= "xxxxA string of characters    " then
428
            Report.Failed("Incorrect result from Procedure Trim, trim " &
429
                          "side = left, justify = right, pad = x");
430
         end if;
431
 
432
         Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
433
 
434
         if Trim_String /= "  xxxxA string of characters  " then
435
            Report.Failed("Incorrect result from Procedure Trim, trim " &
436
                          "side = right, justify = center, default pad");
437
         end if;
438
 
439
         Trim(Trim_String, Ada.Strings.Both, Pad => '*');
440
 
441
         if Trim_String /= "xxxxA string of characters****" then
442
            Report.Failed("Incorrect result from Procedure Trim, trim " &
443
                          "side = both, default justify, pad = *");
444
         end if;
445
 
446
      end;
447
 
448
 
449
      -- Procedure Head.
450
 
451
      declare
452
         Fixed_String : String(1..20) := "A sample test string";
453
      begin
454
 
455
         Fixed.Head(Source  => Fixed_String,
456
                    Count   => 14,
457
                    Justify => Ada.Strings.Center,
458
                    Pad     => '$');
459
 
460
         if Fixed_String /= "$$$A sample test $$$" then
461
            Report.Failed("Incorrect result from Procedure Head, " &
462
                          "justify = center, pad = $");
463
         end if;
464
 
465
         Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
466
 
467
         if Fixed_String /= "         $$$A sample" then
468
            Report.Failed("Incorrect result from Procedure Head, " &
469
                          "justify = right, default pad");
470
         end if;
471
 
472
         Fixed.Head(Fixed_String, 9, Pad => '*');
473
 
474
         if Fixed_String /= "         ***********" then
475
            Report.Failed("Incorrect result from Procedure Head, " &
476
                          "default justify, pad = *");
477
         end if;
478
 
479
      end;
480
 
481
 
482
      -- Procedure Tail.
483
 
484
      declare
485
         Use Ada.Strings.Fixed;
486
         Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
487
      begin
488
 
489
         Tail(Source => Tail_String, Count => 10, Pad => '-');
490
 
491
         if Tail_String /= "KLMNOPQRST----------" then
492
            Report.Failed("Incorrect result from Procedure Tail, " &
493
                          "default justify, pad = -");
494
         end if;
495
 
496
         Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');
497
 
498
         if Tail_String /= "aaaaaaa------aaaaaaa" then
499
            Report.Failed("Incorrect result from Procedure Tail, " &
500
                          "justify = center, pad = a");
501
         end if;
502
 
503
         Tail(Tail_String, 1, Ada.Strings.Right);
504
 
505
         if Tail_String /= "                   a" then
506
            Report.Failed("Incorrect result from Procedure Tail, " &
507
                          "justify = right, default pad");
508
         end if;
509
 
510
         Tail(Tail_String, 19, Ada.Strings.Right, 'A');
511
 
512
         if Tail_String /= "A                  a" then
513
            Report.Failed("Incorrect result from Procedure Tail, " &
514
                          "justify = right, pad = A");
515
         end if;
516
 
517
      end;
518
 
519
   exception
520
      when others => Report.Failed ("Exception raised in Test_Block");
521
   end Test_Block;
522
 
523
 
524
   Report.Result;
525
 
526
end CXA4026;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.