Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/sem_ch2.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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; |