===================================================================
@@ -54,6 +54,7 @@ with Sinfo; use Sinfo;
with Snames; use Snames;
with Stringt; use Stringt;
with Stand; use Stand;
+with Style; use Style;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
@@ -3779,7 +3780,15 @@ package body Sem_Aggr is
New_Assoc := First (New_Assoc_List);
while Present (New_Assoc) loop
Component := First (Choices (New_Assoc));
- exit when Chars (Selectr) = Chars (Component);
+
+ if Chars (Selectr) = Chars (Component) then
+ if Style_Check then
+ Check_Identifier (Selectr, Entity (Component));
+ end if;
+
+ exit;
+ end if;
+
Next (New_Assoc);
end loop;
===================================================================
@@ -2140,6 +2140,19 @@ package body Sem_Ch10 is
-- Start of processing for Analyze_Subunit
begin
+ if Style_Check then
+ declare
+ Nam : Node_Id := Name (Unit (N));
+
+ begin
+ if Nkind (Nam) = N_Selected_Component then
+ Nam := Selector_Name (Nam);
+ end if;
+
+ Check_Identifier (Nam, Par_Unit);
+ end;
+ end if;
+
if not Is_Empty_List (Context_Items (N)) then
-- Save current use clauses
===================================================================
@@ -5793,6 +5793,14 @@ package body Sem_Res is
Set_Etype (N, Typ);
Eval_Named_Real (N);
+ -- For enumeration literals, we need to make sure that a proper style
+ -- check is done, since such literals are overloaded, and thus we did
+ -- not do a style check during the first phase of analysis.
+
+ elsif Ekind (E) = E_Enumeration_Literal then
+ Set_Entity_With_Style_Check (N, E);
+ Eval_Entity_Name (N);
+
-- Allow use of subtype only if it is a concurrent type where we are
-- currently inside the body. This will eventually be expanded into a
-- call to Self (for tasks) or _object (for protected objects). Any
@@ -5847,7 +5855,6 @@ package body Sem_Res is
and then not In_Spec_Expression
and then not Is_Imported (E)
then
-
if No_Initialization (Parent (E))
or else (Present (Full_View (E))
and then No_Initialization (Parent (Full_View (E))))
===================================================================
@@ -4377,13 +4377,18 @@ package body Sem_Ch8 is
return;
end if;
- -- Set the entity. Note that the reason we call Set_Entity here, as
- -- opposed to Set_Entity_With_Style_Check is that in the overloaded
- -- case, the initial call can set the wrong homonym. The call that
- -- sets the right homonym is in Sem_Res and that call does use
- -- Set_Entity_With_Style_Check, so we don't miss a style check.
+ -- Set the entity. Note that the reason we call Set_Entity for the
+ -- overloadable case, as opposed to Set_Entity_With_Style_Check is
+ -- that in the overloaded case, the initial call can set the wrong
+ -- homonym. The call that sets the right homonym is in Sem_Res and
+ -- that call does use Set_Entity_With_Style_Check, so we don't miss
+ -- a style check.
- Set_Entity (N, E);
+ if Is_Overloadable (E) then
+ Set_Entity (N, E);
+ else
+ Set_Entity_With_Style_Check (N, E);
+ end if;
if Is_Type (E) then
Set_Etype (N, E);
This patch fixes some missed cases of checking proper spelling (capitalization) of references to entities as follows: Non overloaded enumeration literals Parent package names in subunits Field names in record component references The following example, compiled with -gnatyaknpr shows four messages that were previously missed. 1. -- gnatmake -gnatyaknpr casing.adb 2. procedure Casing is 3. 4. package S is 5. type T is (abc, xyz); 6. end S; 7. 8. package Sep is 9. type T is (Abc, Xyz); 10. function F return Boolean; 11. end Sep; 12. 13. package body Sep is separate; 14. 15. begin 16. null; 17. end Casing; 1. separate (CASING) -- Casing | >>> (style) bad casing of "Casing" declared at casing.adb:2 2. package body Sep is 3. Global_Var : T := Abc; 4. 5. type Record_Var_T is record 6. Field : Integer; 7. end record; 8. 9. Record_Var : Record_Var_T; 10. 11. function F return Boolean is 12. begin 13. Record_Var := Record_Var_T'(FIELD => 1); -- Field | >>> (style) bad casing of "Field" declared at line 6 14. case Global_Var is 15. when ABC => -- Abc | >>> (style) bad casing of "Abc" declared at casing.adb:9 16. return True; 17. when XYZ => -- Xyz | >>> (style) bad casing of "Xyz" declared at casing.adb:9 18. return False; 19. end case; 20. end F; 21. end Sep; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Robert Dewar <dewar@adacore.com> * sem_aggr.adb (Resolve_Record_Aggregate): Do style check on component name. * sem_ch10.adb (Analyze_Subunit): Do style check on parent unit name. * sem_ch8.adb (Find_Direct_Name): For non-overloadable entities, do style check. * sem_res.adb (Resolve_Entity_Name): Do style check for enumeration literals.