with Errout; use Errout;
with Namet; use Namet;
with Nlists; use Nlists;
+with Sinput; use Sinput;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Table;
-with Uintp; use Uintp;
with GNAT.HTable; use GNAT.HTable;
package body Sem_Elim is
Result_Type : Name_Id;
-- Result type name if Result_Types parameter present, No_Name if not
- Homonym_Number : Uint;
- -- Homonyn number if Homonym_Number parameter present, No_Uint if not.
+ Source_Location : Name_Id;
+ -- String describing the source location of subprogram defining name if
+ -- Source_Location parameter present, No_Name if not
Hash_Link : Access_Elim_Data;
-- Link for hash table use
Elmt : Access_Elim_Data;
Scop : Entity_Id;
Form : Entity_Id;
- Ctr : Nat;
- Ent : Entity_Id;
function Original_Chars (S : Entity_Id) return Name_Id;
-- If the candidate subprogram is a protected operation of a single
elsif Ekind (E) = E_Function
or else Ekind (E) = E_Procedure
then
- -- If Homonym_Number present, then see if it matches
+ -- If Source_Location present, then see if it matches
+
+ if Elmt.Source_Location /= No_Name then
+ Get_Name_String (Elmt.Source_Location);
+
+ declare
+ Sloc_Trace : constant String :=
+ Name_Buffer (1 .. Name_Len);
+
+ Idx : Natural := Sloc_Trace'First;
+ -- Index in Sloc_Trace, if equals to 0, then we have
+ -- completely traversed Sloc_Trace
+
+ Last : constant Natural := Sloc_Trace'Last;
+
+ P : Source_Ptr;
+ Sindex : Source_File_Index;
+
+ function File_Mame_Match return Boolean;
+ -- This function is supposed to be called when Idx points
+ -- to the beginning of the new file name, and Name_Buffer
+ -- is set to contain the name of the proper source file
+ -- from the chain corresponding to the Sloc of E. First
+ -- it checks that these two files have the same name. If
+ -- this check is successful, moves Idx to point to the
+ -- beginning of the column number.
+
+ function Line_Num_Match return Boolean;
+ -- This function is supposed to be called when Idx points
+ -- to the beginning of the column number, and P is
+ -- set to point to the proper Sloc the chain
+ -- corresponding to the Sloc of E. First it checks that
+ -- the line number Idx points on and the line number
+ -- corresponding to P are the same. If this check is
+ -- successful, moves Idx to point to the beginning of
+ -- the next file name in Sloc_Trace. If there is no file
+ -- name any more, Idx is set to 0.
+
+ function Different_Trace_Lengths return Boolean;
+ -- From Idx and P, defines if there are in both traces
+ -- more element(s) in the instantiation chains. Returns
+ -- False if one trace contains more element(s), but
+ -- another does not. If both traces contains more
+ -- elements (that is, the function returns False), moves
+ -- P ahead in the chain corresponding to E, recomputes
+ -- Sindex and sets the name of the corresponding file in
+ -- Name_Buffer
+
+ function Skip_Spaces return Natural;
+ -- If Sloc_Trace (Idx) is not space character, returns
+ -- Idx. Otherwise returns the index of the nearest
+ -- non-space character in Sloc_Trace to the right of
+ -- Idx. Returns 0 if there is no such character.
+
+ function Different_Trace_Lengths return Boolean is
+ begin
+ P := Instantiation (Sindex);
+
+ if (P = No_Location and then Idx /= 0)
+ or else
+ (P /= No_Location and then Idx = 0)
+ then
+ return True;
+ else
- if Elmt.Homonym_Number /= No_Uint then
- Ctr := 1;
+ if P /= No_Location then
+ Sindex := Get_Source_File_Index (P);
+ Get_Name_String (File_Name (Sindex));
+ end if;
- Ent := E;
- while Present (Homonym (Ent))
- and then Scope (Ent) = Scope (Homonym (Ent))
- loop
- Ctr := Ctr + 1;
- Ent := Homonym (Ent);
- end loop;
+ return False;
+ end if;
+ end Different_Trace_Lengths;
- if Ctr /= Elmt.Homonym_Number then
- goto Continue;
- end if;
+ function File_Mame_Match return Boolean is
+ Tmp_Idx : Positive;
+ End_Idx : Positive;
+ begin
+
+ if Idx = 0 then
+ return False;
+ end if;
+
+ for J in Idx .. Last loop
+ if Sloc_Trace (J) = ':' then
+ Tmp_Idx := J - 1;
+ exit;
+ end if;
+ end loop;
+
+ for J in reverse Idx .. Tmp_Idx loop
+ if Sloc_Trace (J) /= ' ' then
+ End_Idx := J;
+ exit;
+ end if;
+ end loop;
+
+ if Sloc_Trace (Idx .. End_Idx) =
+ Name_Buffer (1 .. Name_Len)
+ then
+ Idx := Tmp_Idx + 2;
+
+ Idx := Skip_Spaces;
+
+ return True;
+ else
+ return False;
+ end if;
+
+ end File_Mame_Match;
+
+ function Line_Num_Match return Boolean is
+ N : Int := 0;
+ begin
+
+ if Idx = 0 then
+ return False;
+ end if;
+
+ while Idx <= Last
+ and then
+ Sloc_Trace (Idx) in '0' .. '9'
+ loop
+ N := N * 10 +
+ (Character'Pos (Sloc_Trace (Idx)) -
+ Character'Pos ('0'));
+
+ Idx := Idx + 1;
+ end loop;
+
+ if Get_Physical_Line_Number (P) =
+ Physical_Line_Number (N)
+ then
+
+ while Sloc_Trace (Idx) /= '['
+ and then
+ Idx <= Last
+ loop
+ Idx := Idx + 1;
+ end loop;
+
+ if Sloc_Trace (Idx) = '['
+ and then
+ Idx < Last
+ then
+ Idx := Idx + 1;
+ Idx := Skip_Spaces;
+ else
+ Idx := 0;
+ end if;
+
+ return True;
+ else
+ return False;
+ end if;
+
+ end Line_Num_Match;
+
+ function Skip_Spaces return Natural is
+ Res : Natural := Idx;
+ begin
+
+ while Sloc_Trace (Res) = ' ' loop
+ Res := Res + 1;
+
+ if Res > Last then
+ Res := 0;
+ exit;
+ end if;
+ end loop;
+
+ return Res;
+ end Skip_Spaces;
+
+ begin
+ P := Sloc (E);
+ Sindex := Get_Source_File_Index (P);
+ Get_Name_String (File_Name (Sindex));
+
+ Idx := Skip_Spaces;
+
+ while Idx > 0 loop
+
+ if not File_Mame_Match then
+ goto Continue;
+ elsif not Line_Num_Match then
+ goto Continue;
+ end if;
+
+ if Different_Trace_Lengths then
+ goto Continue;
+ end if;
+ end loop;
+ end;
end if;
-- If we have a Result_Type, then we must have a function
if Elmt.Parameter_Types /= null then
Form := First_Formal (E);
- if No (Form) and then Elmt.Parameter_Types = null then
+ if No (Form)
+ and then
+ Elmt.Parameter_Types'Length = 1
+ and then
+ Elmt.Parameter_Types (1) = No_Name
+ then
+ -- Parameterless procedure matches
+
null;
elsif Elmt.Parameter_Types = null then
Arg_Entity : Node_Id;
Arg_Parameter_Types : Node_Id;
Arg_Result_Type : Node_Id;
- Arg_Homonym_Number : Node_Id)
+ Arg_Source_Location : Node_Id)
is
Data : constant Access_Elim_Data := new Elim_Data;
-- Build result data here
and then Paren_Count (Arg_Parameter_Types) = 1
then
String_To_Name_Buffer (Strval (Arg_Parameter_Types));
- Data.Parameter_Types := new Names'(1 => Name_Find);
+
+ if Name_Len = 0 then
+ -- Parameterless procedure
+ Data.Parameter_Types := new Names'(1 => No_Name);
+ else
+ Data.Parameter_Types := new Names'(1 => Name_Find);
+ end if;
-- Otherwise must be an aggregate
Data.Result_Type := No_Name;
end if;
- -- Process Homonym_Number argument
+ -- Process Source_Location argument
- if Present (Arg_Homonym_Number) then
+ if Present (Arg_Source_Location) then
- if Nkind (Arg_Homonym_Number) /= N_Integer_Literal then
+ if Nkind (Arg_Source_Location) /= N_String_Literal then
Error_Msg_N
- ("Homonym_Number argument for pragma% must be integer literal",
- Arg_Homonym_Number);
+ ("Source_Location argument for pragma% must be string literal",
+ Arg_Source_Location);
return;
end if;
- Data.Homonym_Number := Intval (Arg_Homonym_Number);
+ String_To_Name_Buffer (Strval (Arg_Source_Location));
+ Data.Source_Location := Name_Find;
else
- Data.Homonym_Number := No_Uint;
+ Data.Source_Location := No_Name;
end if;
- -- Now link this new entry into the hash table
-
Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data));
-- If we already have an entry with this same key, then link
OSDN Git Service
