with Atree; use Atree;
with Casing; use Casing;
with Csets; use Csets;
with Einfo; use Einfo;
with Err_Vars; use Err_Vars;
with Namet; use Namet;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Stand; use Stand;
with Stylesw; use Stylesw;
package body Styleg.C is
procedure Body_With_No_Spec (N : Node_Id) is
begin
if Style_Check_Specs then
if Nkind (Parent (N)) = N_Compilation_Unit then
declare
Spec : constant Node_Id := Specification (N);
Defnm : constant Node_Id := Defining_Unit_Name (Spec);
begin
if Nkind (Spec) = N_Procedure_Specification
and then Nkind (Defnm) = N_Defining_Identifier
and then No (First_Formal (Defnm))
then
return;
end if;
end;
end if;
Error_Msg_N ("(style): subprogram body has no previous spec", N);
end if;
end Body_With_No_Spec;
procedure Check_Identifier
(Ref : Node_Or_Entity_Id;
Def : Node_Or_Entity_Id)
is
Sref : Source_Ptr := Sloc (Ref);
Sdef : Source_Ptr := Sloc (Def);
Tref : Source_Buffer_Ptr;
Tdef : Source_Buffer_Ptr;
Nlen : Nat;
Cas : Casing_Type;
begin
if not Comes_From_Source (Ref) then
return;
elsif Error_Posted (Ref) or else Error_Posted (Def) then
return;
elsif Comes_From_Source (Def) then
if Style_Check_References then
Tref := Source_Text (Get_Source_File_Index (Sref));
Tdef := Source_Text (Get_Source_File_Index (Sdef));
if Tref (Sref) = '"' or else Tdef (Sdef) = '"' then
return;
else
while Tref (Sref) = Tdef (Sdef) loop
if not Identifier_Char (Tref (Sref)) then
return;
else
Sref := Sref + 1;
Sdef := Sdef + 1;
end if;
end loop;
if Identifier_Char (Tref (Sref))
or else
Identifier_Char (Tdef (Sdef))
then
Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def);
Error_Msg
("(style) bad casing of & declared#", Sref);
return;
else
return;
end if;
end if;
end if;
elsif Sdef = Standard_Location then
if Style_Check_Standard then
Tref := Source_Text (Get_Source_File_Index (Sref));
if Tref (Sref) = '"' then
null;
else
if Entity (Ref) = Standard_ASCII then
Cas := All_Upper_Case;
elsif Entity (Ref) in SE (S_LC_A) .. SE (S_LC_Z)
or else
Entity (Ref) in SE (S_NUL) .. SE (S_US)
or else
Entity (Ref) = SE (S_DEL)
then
Cas := All_Upper_Case;
else
Cas := Mixed_Case;
end if;
Nlen := Length_Of_Name (Chars (Ref));
if Determine_Casing
(Tref (Sref .. Sref + Source_Ptr (Nlen) - 1)) = Cas
then
null;
else
Name_Len := Integer (Nlen);
Name_Buffer (1 .. Name_Len) :=
String (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1));
Set_Casing (Cas);
Error_Msg_Name_1 := Name_Enter;
Error_Msg_N
("(style) bad casing of { declared in Standard", Ref);
end if;
end if;
end if;
end if;
end Check_Identifier;
procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id) is
begin
if Style_Check_Order_Subprograms then
Error_Msg_N
("(style) subprogram body& not in alphabetical order", Name);
end if;
end Subprogram_Not_In_Alpha_Order;
end Styleg.C;