blob: 876c5dbba5dbf1f8d3d573e9bc926cb6a5013b5e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
with Ada.Text_IO; use Ada.Text_IO;
procedure Typing is
-- Notes:
-- Every "built-in" type in Ada is defined with facilities generally available
-- to the user.
------------------------------------------------------------------------------
-- Ranged integers.
------------------------------------------------------------------------------
type My_Int is range -1 .. 20;
function Overflow (X : My_Int) return My_Int is
begin
return X + 1;
end Overflow;
procedure Test_My_Int is
-- N overflows.
--N : My_Int := Overflow (My_Int'Last);
-- C is equal to (12 + 15) / 2 = 13.
-- The reason C does not overflow is that type-level overflows are performed
-- at specific boundaries for efficiency reasons, in this case when the
-- result of the computation is assigned to the variable C. The value 13 is
-- within the range of My_Int, so we do not get an overflow exception in this
-- case.
A : My_Int := 12;
B : My_Int := 15;
C : My_Int := (A + B) / 2;
begin
for I in My_int loop
Put_Line (My_Int'Image (I));
end loop;
--Put_Line ("My_Int N = " & My_Int'Image (N));
Put_Line ("My_Int C = " & My_Int'Image (C));
end Test_My_Int;
------------------------------------------------------------------------------
-- Unsigned integers / modular types.
------------------------------------------------------------------------------
type Mod_Int is mod 5;
procedure Test_Mod_Int is
A : Mod_Int := 2;
B : Mod_Int := 4;
C : Mod_Int := A + B; -- C = 1. No overflow, implicit mod operation.
begin
Put_Line ("Mod_Int C = " & Mod_Int'Image (C));
end Test_Mod_Int;
------------------------------------------------------------------------------
-- Enumerations.
------------------------------------------------------------------------------
type Days is (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday);
procedure Test_Days is
begin
for D in Days loop
Put (Days'Image (D));
case D is
when Monday .. Friday => Put_Line (" -> weekday");
when Saturday .. Sunday => Put_Line (" -> weekend");
end case;
end loop;
end Test_Days;
------------------------------------------------------------------------------
-- Floats with ranges.
------------------------------------------------------------------------------
type T_Norm is new Float range -1.0 .. +1.0;
procedure Test_T_Norm is
A : T_Norm := 0.5;
begin
Put_Line ("A = " & T_Norm'Image (A));
end Test_T_Norm;
------------------------------------------------------------------------------
-- Casting.
------------------------------------------------------------------------------
type Meters is new Float;
type Miles is new Float;
procedure Test_Units is
Dist_Imperial : Miles;
Dist_Metric : constant Meters := 100.0;
begin
Dist_Imperial := Miles (Dist_Metric) / 1609.0;
Put_Line (Meters'Image (Dist_Metric) & " meters is " & Miles'Image (Dist_Imperial) & " miles");
end Test_Units;
------------------------------------------------------------------------------
-- Derived types.
--
-- Derived types introduce a new type and usually constrain the parent type.
------------------------------------------------------------------------------
type SSN is new Integer range 0 .. 999_99_9999;
procedure Test_SSN is
X : SSN := 111_22_3333;
begin
Put_Line("SSN X = " & SSN'Image (X));
end Test_SSN;
------------------------------------------------------------------------------
-- Subtypes types.
--
-- Subtypes express constraints without introducing a new type.
-- Constraints are enforced at runtime.
------------------------------------------------------------------------------
subtype Weekend_Days is Days range Saturday .. Sunday;
procedure Test_Subtypes is
A : Weekend_Days := Saturday;
B : Days := A; -- OK.
begin
Put_Line ("Day B is " & Days'Image (B));
--A := Monday; -- Runtime exception.
end Test_Subtypes;
begin
Test_My_Int;
Test_Mod_Int;
Test_Days;
Test_T_Norm;
Test_Units;
Test_SSN;
Test_Subtypes;
end Typing;
|
