]>
Commit | Line | Data |
---|---|---|
5c20e503 | 1 | ------------------------------------------------------------------------------ |
d23b8f57 | 2 | -- -- |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
d23b8f57 RK |
4 | -- -- |
5 | -- A D A . T E X T _ I O . E N U M E R A T I O N _ I O -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
d23b8f57 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
d23b8f57 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
d23b8f57 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
d23b8f57 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | with Ada.Text_IO.Enumeration_Aux; | |
33 | ||
34 | package body Ada.Text_IO.Enumeration_IO is | |
35 | ||
36 | package Aux renames Ada.Text_IO.Enumeration_Aux; | |
37 | ||
38 | --------- | |
39 | -- Get -- | |
40 | --------- | |
41 | ||
0ae9f22f | 42 | procedure Get (File : File_Type; Item : out Enum) is |
cc9e83af | 43 | Buf : String (1 .. Enum'Width + 1); |
d23b8f57 RK |
44 | Buflen : Natural; |
45 | ||
46 | begin | |
47 | Aux.Get_Enum_Lit (File, Buf, Buflen); | |
48 | ||
49 | declare | |
50 | Buf_Str : String renames Buf (1 .. Buflen); | |
51 | pragma Unsuppress (Range_Check); | |
52 | begin | |
53 | Item := Enum'Value (Buf_Str); | |
54 | end; | |
55 | ||
56 | exception | |
57 | when Constraint_Error => raise Data_Error; | |
58 | end Get; | |
59 | ||
60 | procedure Get (Item : out Enum) is | |
61 | pragma Unsuppress (Range_Check); | |
d23b8f57 RK |
62 | begin |
63 | Get (Current_In, Item); | |
64 | end Get; | |
65 | ||
66 | procedure Get | |
0ae9f22f | 67 | (From : String; |
d23b8f57 RK |
68 | Item : out Enum; |
69 | Last : out Positive) | |
70 | is | |
71 | Start : Natural; | |
72 | ||
73 | begin | |
74 | Aux.Scan_Enum_Lit (From, Start, Last); | |
75 | ||
76 | declare | |
77 | From_Str : String renames From (Start .. Last); | |
78 | pragma Unsuppress (Range_Check); | |
79 | begin | |
80 | Item := Enum'Value (From_Str); | |
81 | end; | |
82 | ||
83 | exception | |
84 | when Constraint_Error => raise Data_Error; | |
85 | end Get; | |
86 | ||
87 | --------- | |
88 | -- Put -- | |
89 | --------- | |
90 | ||
91 | procedure Put | |
0ae9f22f RD |
92 | (File : File_Type; |
93 | Item : Enum; | |
94 | Width : Field := Default_Width; | |
95 | Set : Type_Set := Default_Setting) | |
d23b8f57 | 96 | is |
d23b8f57 | 97 | begin |
2d1debf8 AC |
98 | -- Ensure that Item is valid before attempting to retrieve the Image, to |
99 | -- prevent the possibility of out-of-bounds addressing of index or image | |
21d7ef70 | 100 | -- tables. Units in the run-time library are normally compiled with |
2d1debf8 AC |
101 | -- checks suppressed, which includes instantiated generics. |
102 | ||
103 | if not Item'Valid then | |
4913e24c | 104 | raise Constraint_Error with "invalid enumeration value"; |
2d1debf8 AC |
105 | end if; |
106 | ||
4913e24c | 107 | Aux.Put (File, Enum'Image (Item), Width, Set); |
d23b8f57 RK |
108 | end Put; |
109 | ||
110 | procedure Put | |
0ae9f22f RD |
111 | (Item : Enum; |
112 | Width : Field := Default_Width; | |
113 | Set : Type_Set := Default_Setting) | |
d23b8f57 RK |
114 | is |
115 | begin | |
116 | Put (Current_Out, Item, Width, Set); | |
117 | end Put; | |
118 | ||
119 | procedure Put | |
120 | (To : out String; | |
0ae9f22f RD |
121 | Item : Enum; |
122 | Set : Type_Set := Default_Setting) | |
d23b8f57 | 123 | is |
d23b8f57 | 124 | begin |
2d1debf8 AC |
125 | -- Ensure that Item is valid before attempting to retrieve the Image, to |
126 | -- prevent the possibility of out-of-bounds addressing of index or image | |
127 | -- tables. Units in the run-time library are normally compiled with | |
128 | -- checks suppressed, which includes instantiated generics. | |
129 | ||
130 | if not Item'Valid then | |
4913e24c | 131 | raise Constraint_Error with "invalid enumeration value"; |
2d1debf8 AC |
132 | end if; |
133 | ||
4913e24c | 134 | Aux.Puts (To, Enum'Image (Item), Set); |
d23b8f57 RK |
135 | end Put; |
136 | ||
137 | end Ada.Text_IO.Enumeration_IO; |