|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S E M _ C H 2 --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
|
|
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- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
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 --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
|
17 -- for more details. You should have received a copy of the GNU General --
|
|
|
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Atree; use Atree;
|
|
|
27 with Namet; use Namet;
|
|
|
28 with Opt; use Opt;
|
|
|
29 with Restrict; use Restrict;
|
|
|
30 with Rident; use Rident;
|
|
|
31 with Sem_Ch8; use Sem_Ch8;
|
|
|
32 with Sem_Dim; use Sem_Dim;
|
|
|
33 with Sinfo; use Sinfo;
|
|
|
34 with Stand; use Stand;
|
|
|
35 with Uintp; use Uintp;
|
|
|
36
|
|
|
37 package body Sem_Ch2 is
|
|
|
38
|
|
|
39 -------------------------------
|
|
|
40 -- Analyze_Character_Literal --
|
|
|
41 -------------------------------
|
|
|
42
|
|
|
43 procedure Analyze_Character_Literal (N : Node_Id) is
|
|
|
44 begin
|
|
|
45 -- The type is eventually inherited from the context. If expansion
|
|
|
46 -- has already established the proper type, do not modify it.
|
|
|
47
|
|
|
48 if No (Etype (N)) then
|
|
|
49 Set_Etype (N, Any_Character);
|
|
|
50 end if;
|
|
|
51
|
|
|
52 Set_Is_Static_Expression (N);
|
|
|
53
|
|
|
54 if Comes_From_Source (N)
|
|
|
55 and then not In_Character_Range (UI_To_CC (Char_Literal_Value (N)))
|
|
|
56 then
|
|
|
57 Check_Restriction (No_Wide_Characters, N);
|
|
|
58 end if;
|
|
|
59 end Analyze_Character_Literal;
|
|
|
60
|
|
|
61 ------------------------
|
|
|
62 -- Analyze_Identifier --
|
|
|
63 ------------------------
|
|
|
64
|
|
|
65 procedure Analyze_Identifier (N : Node_Id) is
|
|
|
66 begin
|
|
|
67 -- Ignore call if prior errors, and identifier has no name, since
|
|
|
68 -- this is the result of some kind of previous error generating a
|
|
|
69 -- junk identifier.
|
|
|
70
|
|
|
71 if Chars (N) in Error_Name_Or_No_Name
|
|
|
72 and then Total_Errors_Detected /= 0
|
|
|
73 then
|
|
|
74 return;
|
|
|
75 else
|
|
|
76 Find_Direct_Name (N);
|
|
|
77 end if;
|
|
|
78
|
|
|
79 Analyze_Dimension (N);
|
|
|
80 end Analyze_Identifier;
|
|
|
81
|
|
|
82 -----------------------------
|
|
|
83 -- Analyze_Integer_Literal --
|
|
|
84 -----------------------------
|
|
|
85
|
|
|
86 procedure Analyze_Integer_Literal (N : Node_Id) is
|
|
|
87 begin
|
|
|
88 Set_Etype (N, Universal_Integer);
|
|
|
89 Set_Is_Static_Expression (N);
|
|
|
90 end Analyze_Integer_Literal;
|
|
|
91
|
|
|
92 --------------------------
|
|
|
93 -- Analyze_Real_Literal --
|
|
|
94 --------------------------
|
|
|
95
|
|
|
96 procedure Analyze_Real_Literal (N : Node_Id) is
|
|
|
97 begin
|
|
|
98 Set_Etype (N, Universal_Real);
|
|
|
99 Set_Is_Static_Expression (N);
|
|
|
100 end Analyze_Real_Literal;
|
|
|
101
|
|
|
102 ----------------------------
|
|
|
103 -- Analyze_String_Literal --
|
|
|
104 ----------------------------
|
|
|
105
|
|
|
106 procedure Analyze_String_Literal (N : Node_Id) is
|
|
|
107 begin
|
|
|
108 -- The type is eventually inherited from the context. If expansion
|
|
|
109 -- has already established the proper type, do not modify it.
|
|
|
110
|
|
|
111 if No (Etype (N)) then
|
|
|
112 Set_Etype (N, Any_String);
|
|
|
113 end if;
|
|
|
114
|
|
|
115 -- String literals are static in Ada 95. Note that if the subtype
|
|
|
116 -- turns out to be non-static, then the Is_Static_Expression flag
|
|
|
117 -- will be reset in Eval_String_Literal.
|
|
|
118
|
|
|
119 if Ada_Version >= Ada_95 then
|
|
|
120 Set_Is_Static_Expression (N);
|
|
|
121 end if;
|
|
|
122
|
|
|
123 if Comes_From_Source (N) and then Has_Wide_Character (N) then
|
|
|
124 Check_Restriction (No_Wide_Characters, N);
|
|
|
125 end if;
|
|
|
126 end Analyze_String_Literal;
|
|
|
127
|
|
|
128 end Sem_Ch2;
|
