Canonical_Case_File_Name (Archive_Name);
Canonical_Case_File_Name (DLL_Name);
- Change_Dir (Lib_Directory);
- Open (Direc, ".");
+ if Is_Directory (Lib_Directory) then
+ Change_Dir (Lib_Directory);
+ Open (Direc, ".");
- -- For each regular file in the directory, if switch -n has not
- -- been specified, make it writable and delete the file if it is
- -- the library file.
+ -- For each regular file in the directory, if switch -n has not
+ -- not been specified, make it writable and delete the file if
+ -- it is the library file.
- loop
- Read (Direc, Name, Last);
- exit when Last = 0;
-
- declare
- Filename : constant String := Name (1 .. Last);
+ loop
+ Read (Direc, Name, Last);
+ exit when Last = 0;
- begin
- if Is_Regular_File (Filename)
- or else Is_Symbolic_Link (Filename)
- then
- Canonical_Case_File_Name (Name (1 .. Last));
- Delete_File := False;
+ declare
+ Filename : constant String := Name (1 .. Last);
- if (Project.Library_Kind = Static
- and then Name (1 .. Last) = Archive_Name)
- or else
- ((Project.Library_Kind = Dynamic
- or else
- Project.Library_Kind = Relocatable)
- and then
- (Name (1 .. Last) = DLL_Name
- or else
- Name (1 .. Last) = Minor.all
- or else
- Name (1 .. Last) = Major.all))
+ begin
+ if Is_Regular_File (Filename)
+ or else Is_Symbolic_Link (Filename)
then
- if not Do_Nothing then
- Set_Writable (Filename);
- end if;
+ Canonical_Case_File_Name (Name (1 .. Last));
+ Delete_File := False;
+
+ if (Project.Library_Kind = Static
+ and then Name (1 .. Last) = Archive_Name)
+ or else
+ ((Project.Library_Kind = Dynamic
+ or else
+ Project.Library_Kind = Relocatable)
+ and then
+ (Name (1 .. Last) = DLL_Name
+ or else
+ Name (1 .. Last) = Minor.all
+ or else
+ Name (1 .. Last) = Major.all))
+ then
+ if not Do_Nothing then
+ Set_Writable (Filename);
+ end if;
- Delete (Lib_Directory, Filename);
+ Delete (Lib_Directory, Filename);
+ end if;
end if;
- end if;
- end;
- end loop;
+ end;
+ end loop;
- Close (Direc);
+ Close (Direc);
+ end if;
+
+ if not Is_Directory (Lib_ALI_Directory) then
+ -- Nothing more to do, return now
+ return;
+ end if;
Change_Dir (Lib_ALI_Directory);
Open (Direc, ".");
Processed_Projects.Increment_Last;
Processed_Projects.Table (Processed_Projects.Last) := Project;
- if Project.Object_Directory /= No_Path_Information then
+ if Project.Object_Directory /= No_Path_Information
+ and then Is_Directory
+ (Get_Name_String (Project.Object_Directory.Display_Name))
+ then
declare
Obj_Dir : constant String :=
Get_Name_String (Project.Object_Directory.Display_Name);
end;
end if;
- if Project.Object_Directory /= No_Path_Information then
+ if Project.Object_Directory /= No_Path_Information
+ and then Is_Directory
+ (Get_Name_String (Project.Object_Directory.Display_Name))
+ then
Delete_Binder_Generated_Files
(Get_Name_String (Project.Object_Directory.Display_Name),
Strip_Suffix (Main_Source_File));
----------------
procedure Make_Index
- (I : Node_Id;
+ (N : Node_Id;
Related_Nod : Node_Id;
Related_Id : Entity_Id := Empty;
- Suffix_Index : Nat := 1;
- In_Iter_Schm : Boolean := False)
+ Suffix_Index : Nat := 1;
+ In_Iter_Schm : Boolean := False)
is
R : Node_Id;
T : Entity_Id;
-- Character literals also have a universal type in the absence of
-- of additional context, and are resolved to Standard_Character.
- if Nkind (I) = N_Range then
+ if Nkind (N) = N_Range then
-- The index is given by a range constraint. The bounds are known
-- to be of a consistent type.
- if not Is_Overloaded (I) then
- T := Etype (I);
+ if not Is_Overloaded (N) then
+ T := Etype (N);
-- For universal bounds, choose the specific predefined type
T := Standard_Integer;
elsif T = Any_Character then
- Ambiguous_Character (Low_Bound (I));
+ Ambiguous_Character (Low_Bound (N));
T := Standard_Character;
end if;
-- are available, but if a universal interpretation exists it is
-- also the selected one.
- elsif Universal_Interpretation (I) = Universal_Integer then
+ elsif Universal_Interpretation (N) = Universal_Integer then
T := Standard_Integer;
else
It : Interp;
begin
- Get_First_Interp (I, Ind, It);
+ Get_First_Interp (N, Ind, It);
while Present (It.Typ) loop
if Is_Discrete_Type (It.Typ) then
and then not Covers (It.Typ, T)
and then not Covers (T, It.Typ)
then
- Error_Msg_N ("ambiguous bounds in discrete range", I);
+ Error_Msg_N ("ambiguous bounds in discrete range", N);
exit;
else
T := It.Typ;
end loop;
if T = Any_Type then
- Error_Msg_N ("discrete type required for range", I);
- Set_Etype (I, Any_Type);
+ Error_Msg_N ("discrete type required for range", N);
+ Set_Etype (N, Any_Type);
return;
elsif T = Universal_Integer then
end if;
if not Is_Discrete_Type (T) then
- Error_Msg_N ("discrete type required for range", I);
- Set_Etype (I, Any_Type);
+ Error_Msg_N ("discrete type required for range", N);
+ Set_Etype (N, Any_Type);
return;
end if;
- if Nkind (Low_Bound (I)) = N_Attribute_Reference
- and then Attribute_Name (Low_Bound (I)) = Name_First
- and then Is_Entity_Name (Prefix (Low_Bound (I)))
- and then Is_Type (Entity (Prefix (Low_Bound (I))))
- and then Is_Discrete_Type (Entity (Prefix (Low_Bound (I))))
+ if Nkind (Low_Bound (N)) = N_Attribute_Reference
+ and then Attribute_Name (Low_Bound (N)) = Name_First
+ and then Is_Entity_Name (Prefix (Low_Bound (N)))
+ and then Is_Type (Entity (Prefix (Low_Bound (N))))
+ and then Is_Discrete_Type (Entity (Prefix (Low_Bound (N))))
then
-- The type of the index will be the type of the prefix, as long
-- as the upper bound is 'Last of the same type.
- Def_Id := Entity (Prefix (Low_Bound (I)));
+ Def_Id := Entity (Prefix (Low_Bound (N)));
- if Nkind (High_Bound (I)) /= N_Attribute_Reference
- or else Attribute_Name (High_Bound (I)) /= Name_Last
- or else not Is_Entity_Name (Prefix (High_Bound (I)))
- or else Entity (Prefix (High_Bound (I))) /= Def_Id
+ if Nkind (High_Bound (N)) /= N_Attribute_Reference
+ or else Attribute_Name (High_Bound (N)) /= Name_Last
+ or else not Is_Entity_Name (Prefix (High_Bound (N)))
+ or else Entity (Prefix (High_Bound (N))) /= Def_Id
then
Def_Id := Empty;
end if;
end if;
- R := I;
+ R := N;
Process_Range_Expr_In_Decl (R, T, In_Iter_Schm => In_Iter_Schm);
- elsif Nkind (I) = N_Subtype_Indication then
+ elsif Nkind (N) = N_Subtype_Indication then
-- The index is given by a subtype with a range constraint
- T := Base_Type (Entity (Subtype_Mark (I)));
+ T := Base_Type (Entity (Subtype_Mark (N)));
if not Is_Discrete_Type (T) then
- Error_Msg_N ("discrete type required for range", I);
- Set_Etype (I, Any_Type);
+ Error_Msg_N ("discrete type required for range", N);
+ Set_Etype (N, Any_Type);
return;
end if;
- R := Range_Expression (Constraint (I));
+ R := Range_Expression (Constraint (N));
Resolve (R, T);
Process_Range_Expr_In_Decl
- (R, Entity (Subtype_Mark (I)), In_Iter_Schm => In_Iter_Schm);
+ (R, Entity (Subtype_Mark (N)), In_Iter_Schm => In_Iter_Schm);
- elsif Nkind (I) = N_Attribute_Reference then
+ elsif Nkind (N) = N_Attribute_Reference then
-- The parser guarantees that the attribute is a RANGE attribute
-- If the node denotes the range of a type mark, that is also the
-- resulting type, and we do no need to create an Itype for it.
- if Is_Entity_Name (Prefix (I))
- and then Comes_From_Source (I)
- and then Is_Type (Entity (Prefix (I)))
- and then Is_Discrete_Type (Entity (Prefix (I)))
+ if Is_Entity_Name (Prefix (N))
+ and then Comes_From_Source (N)
+ and then Is_Type (Entity (Prefix (N)))
+ and then Is_Discrete_Type (Entity (Prefix (N)))
then
- Def_Id := Entity (Prefix (I));
+ Def_Id := Entity (Prefix (N));
end if;
- Analyze_And_Resolve (I);
- T := Etype (I);
- R := I;
+ Analyze_And_Resolve (N);
+ T := Etype (N);
+ R := N;
-- If none of the above, must be a subtype. We convert this to a
-- range attribute reference because in the case of declared first
-- original index for instantiation purposes.
else
- if not Is_Entity_Name (I) or else not Is_Type (Entity (I)) then
- Error_Msg_N ("invalid subtype mark in discrete range ", I);
- Set_Etype (I, Any_Integer);
+ if not Is_Entity_Name (N) or else not Is_Type (Entity (N)) then
+ Error_Msg_N ("invalid subtype mark in discrete range ", N);
+ Set_Etype (N, Any_Integer);
return;
else
-- now that we can get the full view, previous analysis does
-- not look specifically for a type mark.
- Set_Entity (I, Get_Full_View (Entity (I)));
- Set_Etype (I, Entity (I));
- Def_Id := Entity (I);
+ Set_Entity (N, Get_Full_View (Entity (N)));
+ Set_Etype (N, Entity (N));
+ Def_Id := Entity (N);
if not Is_Discrete_Type (Def_Id) then
- Error_Msg_N ("discrete type required for index", I);
- Set_Etype (I, Any_Type);
+ Error_Msg_N ("discrete type required for index", N);
+ Set_Etype (N, Any_Type);
return;
end if;
end if;
if Expander_Active then
- Rewrite (I,
- Make_Attribute_Reference (Sloc (I),
+ Rewrite (N,
+ Make_Attribute_Reference (Sloc (N),
Attribute_Name => Name_Range,
- Prefix => Relocate_Node (I)));
+ Prefix => Relocate_Node (N)));
-- The original was a subtype mark that does not freeze. This
-- means that the rewritten version must not freeze either.
- Set_Must_Not_Freeze (I);
- Set_Must_Not_Freeze (Prefix (I));
- Analyze_And_Resolve (I);
- T := Etype (I);
- R := I;
+ Set_Must_Not_Freeze (N);
+ Set_Must_Not_Freeze (Prefix (N));
+ Analyze_And_Resolve (N);
+ T := Etype (N);
+ R := N;
-- If expander is inactive, type is legal, nothing else to construct
end if;
if not Is_Discrete_Type (T) then
- Error_Msg_N ("discrete type required for range", I);
- Set_Etype (I, Any_Type);
+ Error_Msg_N ("discrete type required for range", N);
+ Set_Etype (N, Any_Type);
return;
elsif T = Any_Type then
- Set_Etype (I, Any_Type);
+ Set_Etype (N, Any_Type);
return;
end if;
-- new subtype is non-static, then the subtype we create is non-
-- static, even if its bounds are static.
- if Nkind (I) = N_Subtype_Indication
- and then not Is_OK_Static_Subtype (Entity (Subtype_Mark (I)))
+ if Nkind (N) = N_Subtype_Indication
+ and then not Is_OK_Static_Subtype (Entity (Subtype_Mark (N)))
then
Set_Is_Non_Static_Subtype (Def_Id);
end if;
-- Final step is to label the index with this constructed type
- Set_Etype (I, Def_Id);
+ Set_Etype (N, Def_Id);
end Make_Index;
------------------------------
projects / gcc.git / commitdiff