- -----------------------------------
- -- Prepare_Ada_Naming_Exceptions --
- -----------------------------------
-
- procedure Prepare_Ada_Naming_Exceptions
- (List : Array_Element_Id;
- In_Tree : Project_Tree_Ref;
- Kind : Spec_Or_Body)
- is
- Current : Array_Element_Id;
- Element : Array_Element;
- Unit : Unit_Info;
-
- begin
- -- Traverse the list
-
- Current := List;
- while Current /= No_Array_Element loop
- Element := In_Tree.Array_Elements.Table (Current);
-
- if Element.Index /= No_Name then
- Unit :=
- (Kind => Kind,
- Unit => Element.Index,
- Next => No_Ada_Naming_Exception);
- Reverse_Ada_Naming_Exceptions.Set
- (Unit, (Element.Value.Value, Element.Value.Index));
- Unit.Next :=
- Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
- Ada_Naming_Exception_Table.Increment_Last;
- Ada_Naming_Exception_Table.Table
- (Ada_Naming_Exception_Table.Last) := Unit;
- Ada_Naming_Exceptions.Set
- (File_Name_Type (Element.Value.Value),
- Ada_Naming_Exception_Table.Last);
- end if;
-
- Current := Element.Next;
- end loop;
- end Prepare_Ada_Naming_Exceptions;
-
- -----------------------
- -- Record_Ada_Source --
- -----------------------
-
- procedure Record_Ada_Source
- (File_Name : File_Name_Type;
- Path_Name : Path_Name_Type;
- Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Ada_Language : Language_Ptr;
- Location : Source_Ptr;
- Source_Recorded : in out Boolean)
- is
- Canonical_File : File_Name_Type;
- Canonical_Path : Path_Name_Type;
-
- File_Recorded : Boolean := False;
- -- True when at least one file has been recorded
-
- procedure Record_Unit
- (Unit_Name : Name_Id;
- Unit_Ind : Int := 0;
- Unit_Kind : Spec_Or_Body;
- Needs_Pragma : Boolean);
- -- Register of the units contained in the source file (there is in
- -- general a single such unit except when exceptions to the naming
- -- scheme indicate there are several such units)
-
- -----------------
- -- Record_Unit --
- -----------------
-
- procedure Record_Unit
- (Unit_Name : Name_Id;
- Unit_Ind : Int := 0;
- Unit_Kind : Spec_Or_Body;
- Needs_Pragma : Boolean)
- is
- The_Unit : Unit_Index :=
- Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
- UData : Unit_Data;
- Kind : Source_Kind;
- Source : Source_Id;
- Unit_Prj : Unit_Project;
- To_Record : Boolean := False;
- The_Location : Source_Ptr := Location;
-
- begin
- if Current_Verbosity = High then
- Write_Str (" Putting ");
- Write_Str (Get_Name_String (Unit_Name));
- Write_Line (" in the unit list.");
- end if;
-
- -- The unit is already in the list, but may be it is only the other
- -- unit kind (spec or body), or what is in the unit list is a unit of
- -- a project we are extending.
-
- if The_Unit /= No_Unit_Index then
- UData := In_Tree.Units.Table (The_Unit);
-
- if (UData.File_Names (Unit_Kind).Name = Canonical_File
- and then UData.File_Names (Unit_Kind).Path.Name = Slash)
- or else UData.File_Names (Unit_Kind).Name = No_File
- or else Is_Extending
- (Data.Extends,
- UData.File_Names (Unit_Kind).Project,
- In_Tree)
- then
- if UData.File_Names (Unit_Kind).Path.Name = Slash then
- Remove_Forbidden_File_Name
- (UData.File_Names (Unit_Kind).Name);
- end if;
-
- -- Record the file name in the hash table Files_Htable
-
- Unit_Prj := (Unit => The_Unit, Project => Project);
- Files_Htable.Set
- (In_Tree.Files_HT,
- Canonical_File,
- Unit_Prj);
-
- UData.File_Names (Unit_Kind) :=
- (Name => Canonical_File,
- Index => Unit_Ind,
- Display_Name => File_Name,
- Path => (Canonical_Path, Path_Name),
- Project => Project,
- Needs_Pragma => Needs_Pragma);
- In_Tree.Units.Table (The_Unit) := UData;
- To_Record := True;
- Source_Recorded := True;
-
- -- If the same file is already in the list, do not add it again
-
- elsif UData.File_Names (Unit_Kind).Project = Project
- and then
- (Data.Known_Order_Of_Source_Dirs
- or else
- UData.File_Names (Unit_Kind).Path.Name = Canonical_Path)
- then
- To_Record := False;
-
- -- Else, same unit but not same file => It is an error to have two
- -- units with the same name and the same kind (spec or body).
-
- else
- if The_Location = No_Location then
- The_Location := In_Tree.Projects.Table (Project).Location;
- end if;
-
- Err_Vars.Error_Msg_Name_1 := Unit_Name;
- Error_Msg
- (Project, In_Tree, "duplicate unit %%", The_Location);
-
- Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table
- (UData.File_Names (Unit_Kind).Project).Name;
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (UData.File_Names (Unit_Kind).Path.Name);
- Error_Msg
- (Project, In_Tree,
- "\ project file %%, {", The_Location);
-
- Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Project).Name;
- Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path);
- Error_Msg
- (Project, In_Tree, "\ project file %%, {", The_Location);
-
- To_Record := False;
- end if;
-
- -- It is a new unit, create a new record
-
- else
- -- First, check if there is no other unit with this file name in
- -- another project. If it is, report error but note we do that
- -- only for the first unit in the source file.
-
- Unit_Prj := Files_Htable.Get (In_Tree.Files_HT, Canonical_File);
-
- if not File_Recorded
- and then Unit_Prj /= No_Unit_Project
- then
- Error_Msg_File_1 := File_Name;
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Unit_Prj.Project).Name;
- Error_Msg
- (Project, In_Tree,
- "{ is already a source of project %%",
- Location);
-
- else
- Unit_Table.Increment_Last (In_Tree.Units);
- The_Unit := Unit_Table.Last (In_Tree.Units);
- Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
-
- Unit_Prj := (Unit => The_Unit, Project => Project);
- Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Unit_Prj);
-
- UData.Name := Unit_Name;
- UData.File_Names (Unit_Kind) :=
- (Name => Canonical_File,
- Index => Unit_Ind,
- Display_Name => File_Name,
- Path => (Canonical_Path, Path_Name),
- Project => Project,
- Needs_Pragma => Needs_Pragma);
- In_Tree.Units.Table (The_Unit) := UData;
-
- Source_Recorded := True;
- To_Record := True;
- end if;
- end if;
-
- if To_Record then
- case Unit_Kind is
- when Body_Part => Kind := Impl;
- when Specification => Kind := Spec;
- end case;
-
- Add_Source
- (Id => Source,
- In_Tree => In_Tree,
- Project => Project,
- Lang_Id => Ada_Language,
- Lang_Kind => Unit_Based,
- File_Name => Canonical_File,
- Display_File => File_Name,
- Unit => Unit_Name,
- Path => (Canonical_Path, Path_Name),
- Kind => Kind,
- Other_Part => No_Source); -- ??? Can we find file ?
- end if;
- end Record_Unit;
-
- Exception_Id : Ada_Naming_Exception_Id;
- Unit_Name : Name_Id;
- Unit_Kind : Spec_Or_Body;
- Unit_Ind : Int := 0;
- Info : Unit_Info;
- Name_Index : Name_And_Index;
- Except_Name : Name_And_Index := No_Name_And_Index;
- Needs_Pragma : Boolean;
-
- begin
- Canonical_File := Canonical_Case_File_Name (Name_Id (File_Name));
- Canonical_Path :=
- Path_Name_Type (Canonical_Case_File_Name (Name_Id (Path_Name)));
-
- -- Check the naming scheme to get extra file properties
-
- Get_Unit
- (In_Tree => In_Tree,
- Canonical_File_Name => Canonical_File,
- Naming => Data.Naming,
- Exception_Id => Exception_Id,
- Unit_Name => Unit_Name,
- Unit_Kind => Unit_Kind,
- Needs_Pragma => Needs_Pragma);
-
- if Exception_Id = No_Ada_Naming_Exception
- and then Unit_Name = No_Name
- then
- if Current_Verbosity = High then
- Write_Str (" """);
- Write_Str (Get_Name_String (Canonical_File));
- Write_Line (""" is not a valid source file name (ignored).");
- end if;
- return;
- end if;
-
- -- Check to see if the source has been hidden by an exception,
- -- but only if it is not an exception.
-
- if not Needs_Pragma then
- Except_Name :=
- Reverse_Ada_Naming_Exceptions.Get
- ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
-
- if Except_Name /= No_Name_And_Index then
- if Current_Verbosity = High then
- Write_Str (" """);
- Write_Str (Get_Name_String (Canonical_File));
- Write_Str (""" contains a unit that is found in """);
- Write_Str (Get_Name_String (Except_Name.Name));
- Write_Line (""" (ignored).");
- end if;
-
- -- The file is not included in the source of the project since
- -- it is hidden by the exception. So, nothing else to do.
-
- return;
- end if;
- end if;
-
- -- The following loop registers the unit in the appropriate table. It
- -- will be executed multiple times when the file is a multi-unit file,
- -- in which case Exception_Id initially points to the first file and
- -- then to each other unit in the file.
-
- loop
- if Exception_Id /= No_Ada_Naming_Exception then
- Info := Ada_Naming_Exception_Table.Table (Exception_Id);
- Exception_Id := Info.Next;
- Info.Next := No_Ada_Naming_Exception;
- Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
-
- Unit_Name := Info.Unit;
- Unit_Ind := Name_Index.Index;
- Unit_Kind := Info.Kind;
- end if;
-
- Record_Unit (Unit_Name, Unit_Ind, Unit_Kind, Needs_Pragma);
- File_Recorded := True;
-
- exit when Exception_Id = No_Ada_Naming_Exception;
- end loop;
- end Record_Ada_Source;
-