function Get_Name (Lower : Boolean := False) return Name_Id;
-- Skip blanks, then scan out a name (name is left in Name_Buffer with
- -- length in Name_Len, as well as being returned in Name_Id form). The
- -- name is adjusted appropriately if it refers to a file that is to be
- -- substituted by another name as a result of a configuration pragma.
- -- If Lower is set to true then the Name_Buffer will be converted to
- -- all lower case. This only happends for systems where file names are
- -- not case sensitive, and ensures that gnatbind works correctly on
- -- such systems, regardless of the case of the file name. Note that
- -- a name can be terminated by a right typeref bracket or '='.
+ -- length in Name_Len, as well as being returned in Name_Id form).
+ -- If Lower is set to True then the Name_Buffer will be converted to
+ -- all lower case, for systems where file names are not case sensitive.
+ -- This ensures that gnatbind works correctly regardless of the case
+ -- of the file name on all systems. The name is terminated by a either
+ -- white space or a typeref bracket or an equal sign except for the
+ -- special case of an operator name starting with a double quite which
+ -- is terminated by another double quote.
function Get_Nat return Nat;
-- Skip blanks, then scan out an unsigned integer value in Nat range
loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
- exit when At_End_Of_Field
- or else Nextc = ')'
- or else Nextc = '}'
- or else Nextc = '>'
- or else Nextc = '=';
+
+ exit when At_End_Of_Field;
+
+ if Name_Buffer (1) = '"' then
+ exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
+
+ else
+ exit when At_End_Of_Field
+ or else Nextc = '(' or else Nextc = ')'
+ or else Nextc = '{' or else Nextc = '}'
+ or else Nextc = '<' or else Nextc = '>'
+ or else Nextc = '=';
+ end if;
end loop;
-- Convert file name to all lower case if file names are not case
Checkc (' ');
Skip_Space;
- for J in Partition_Restrictions loop
+ for J in All_Restrictions loop
C := Getc;
+ ALIs.Table (Id).Restrictions (J) := C;
- if C = 'v' or else C = 'r' or else C = 'n' then
- ALIs.Table (Id).Restrictions (J) := C;
- else
- Fatal_Error;
- end if;
+ case C is
+ when 'v' =>
+ Restrictions (J) := 'v';
+
+ when 'r' =>
+ if Restrictions (J) = 'n' then
+ Restrictions (J) := 'r';
+ end if;
+
+ when 'n' =>
+ null;
+
+ when others =>
+ Fatal_Error;
+ end case;
end loop;
if At_Eol then
if Debug_Flag_U then
Write_Str (" ----> reading unit ");
+ Write_Int (Int (Units.Last));
+ Write_Str (" ");
Write_Unit_Name (Units.Table (Units.Last).Uname);
Write_Str (" from file ");
Write_Name (Units.Table (Units.Last).Sfile);
and then Units.Table (Units.Last).Sfile /=
Units.Table (Unit_Id (Info)).Sfile
then
- -- If Err is set then treat duplicate unit name as an instance
- -- of a bad ALI format. This is the case of being called from
- -- gnatmake, and the point is that if anything is wrong with
- -- the ALI file, then gnatmake should just recompile.
+ -- If Err is set then ignore duplicate unit name. This is the
+ -- case of a call from gnatmake, where the situation can arise
+ -- from substitution of source files. In such situations, the
+ -- processing in gnatmake will always result in any required
+ -- recompilations in any case, and if we consider this to be
+ -- an error we get strange cases (for example when a generic
+ -- instantiation is replaced by a normal package) where we
+ -- read the old ali file, decide to recompile, and then decide
+ -- that the old and new ali files are incompatible.
if Err then
- raise Bad_ALI_Format;
+ null;
- -- If Err is not set, then this is a fatal error
+ -- If Err is not set, then this is a fatal error. This is
+ -- the case of being called from the binder, where we must
+ -- definitely diagnose this as an error.
else
Set_Standard_Error;
Units.Table (Units.Last).Last_With := Withs.Last;
Units.Table (Units.Last).Last_Arg := Args.Last;
- end loop Unit_Loop;
-
- -- End loop through units for one ALI file
+ -- If there are linker options lines present, scan them
- ALIs.Table (Id).Last_Unit := Units.Last;
- ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
+ Name_Len := 0;
- -- Set types of the units (there can be at most 2 of them)
+ Linker_Options_Loop : while C = 'L' loop
+ Checkc (' ');
+ Skip_Space;
+ Checkc ('"');
- if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
- Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
- Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
+ loop
+ C := Getc;
- else
- -- Deal with body only and spec only cases, note that the reason we
- -- do our own checking of the name (rather than using Is_Body_Name)
- -- is that Uname drags in far too much compiler junk!
+ if C < Character'Val (16#20#)
+ or else C > Character'Val (16#7E#)
+ then
+ Fatal_Error;
- Get_Name_String (Units.Table (Units.Last).Uname);
+ elsif C = '{' then
+ C := Character'Val (0);
- if Name_Buffer (Name_Len) = 'b' then
- Units.Table (Units.Last).Utype := Is_Body_Only;
- else
- Units.Table (Units.Last).Utype := Is_Spec_Only;
- end if;
- end if;
+ declare
+ V : Natural;
- -- If there are linker options lines present, scan them
+ begin
+ V := 0;
+ for J in 1 .. 2 loop
+ C := Getc;
- while C = 'L' loop
- Checkc (' ');
- Skip_Space;
- Checkc ('"');
+ if C in '0' .. '9' then
+ V := V * 16 +
+ Character'Pos (C) - Character'Pos ('0');
- Name_Len := 0;
- loop
- C := Getc;
+ elsif C in 'A' .. 'F' then
+ V := V * 16 +
+ Character'Pos (C) - Character'Pos ('A') + 10;
- if C < Character'Val (16#20#)
- or else C > Character'Val (16#7E#)
- then
- Fatal_Error;
+ else
+ Fatal_Error;
+ end if;
+ end loop;
- elsif C = '{' then
- C := Character'Val (0);
+ Checkc ('}');
- declare
- V : Natural;
+ Add_Char_To_Name_Buffer (Character'Val (V));
+ end;
- begin
- V := 0;
- for J in 1 .. 2 loop
+ else
+ if C = '"' then
+ exit when Nextc /= '"';
C := Getc;
+ end if;
- if C in '0' .. '9' then
- V := V * 16 +
- Character'Pos (C) - Character'Pos ('0');
+ Add_Char_To_Name_Buffer (C);
+ end if;
+ end loop;
- elsif C in 'A' .. 'F' then
- V := V * 16 +
- Character'Pos (C) - Character'Pos ('A') + 10;
+ Add_Char_To_Name_Buffer (nul);
- else
- Fatal_Error;
- end if;
- end loop;
+ Skip_Eol;
+ C := Getc;
+ end loop Linker_Options_Loop;
- Checkc ('}');
+ -- Store the linker options entry
- Add_Char_To_Name_Buffer (Character'Val (V));
- end;
+ if Name_Len /= 0 then
+ Linker_Options.Increment_Last;
- else
- if C = '"' then
- exit when Nextc /= '"';
- C := Getc;
- end if;
+ Linker_Options.Table (Linker_Options.Last).Name :=
+ Name_Enter;
- Add_Char_To_Name_Buffer (C);
- end if;
- end loop;
+ Linker_Options.Table (Linker_Options.Last).Unit :=
+ Units.Last;
- Add_Char_To_Name_Buffer (nul);
+ Linker_Options.Table (Linker_Options.Last).Internal_File :=
+ Is_Internal_File_Name (F);
- Skip_Eol;
- C := Getc;
+ Linker_Options.Table (Linker_Options.Last).Original_Pos :=
+ Linker_Options.Last;
+ end if;
+ end loop Unit_Loop;
- Linker_Options.Increment_Last;
+ -- End loop through units for one ALI file
- Linker_Options.Table (Linker_Options.Last).Name
- := Name_Enter;
+ ALIs.Table (Id).Last_Unit := Units.Last;
+ ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
- Linker_Options.Table (Linker_Options.Last).Unit
- := ALIs.Table (Id).First_Unit;
+ -- Set types of the units (there can be at most 2 of them)
- Linker_Options.Table (Linker_Options.Last).Internal_File
- := Is_Internal_File_Name (F);
+ if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
+ Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
+ Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
+
+ else
+ -- Deal with body only and spec only cases, note that the reason we
+ -- do our own checking of the name (rather than using Is_Body_Name)
+ -- is that Uname drags in far too much compiler junk!
- Linker_Options.Table (Linker_Options.Last).Original_Pos
- := Linker_Options.Last;
+ Get_Name_String (Units.Table (Units.Last).Uname);
- end loop;
+ if Name_Buffer (Name_Len) = 'b' then
+ Units.Table (Units.Last).Utype := Is_Body_Only;
+ else
+ Units.Table (Units.Last).Utype := Is_Spec_Only;
+ end if;
+ end if;
-- Scan out external version references and put in hash table
OSDN Git Service
