From: Arnaud Charlet Date: Wed, 30 Jul 2014 14:26:55 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c98b825308a59e73598f30dd14827a8c57567369;p=gcc.git [multiple changes] 2014-07-30 Robert Dewar * sem_ch3.adb, sem_ch3.ads: Minor code reorganization. 2014-07-30 Pascal Obry * clean.adb (Clean_Project): Properly check for directory existence before trying to enter it. From-SVN: r213284 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cd83b811823..2141f0bb0d5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2014-07-30 Robert Dewar + + * sem_ch3.adb, sem_ch3.ads: Minor code reorganization. + +2014-07-30 Pascal Obry + + * clean.adb (Clean_Project): Properly check for directory + existence before trying to enter it. + 2014-07-30 Robert Dewar * sem_ch3.ads, prj.ads, prj-nmsc.adb: Minor reformatting. diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 0a7108d74a3..4abbc94b9f3 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -666,51 +666,58 @@ package body Clean is 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, "."); @@ -860,7 +867,10 @@ package body Clean is 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); @@ -1188,7 +1198,10 @@ package body Clean is 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)); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0e47f97f3c1..0a1bfd93b94 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -17139,11 +17139,11 @@ package body Sem_Ch3 is ---------------- 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; @@ -17164,13 +17164,13 @@ package body Sem_Ch3 is -- 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 @@ -17178,7 +17178,7 @@ package body Sem_Ch3 is T := Standard_Integer; elsif T = Any_Character then - Ambiguous_Character (Low_Bound (I)); + Ambiguous_Character (Low_Bound (N)); T := Standard_Character; end if; @@ -17187,7 +17187,7 @@ package body Sem_Ch3 is -- 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 @@ -17198,7 +17198,7 @@ package body Sem_Ch3 is 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 @@ -17206,7 +17206,7 @@ package body Sem_Ch3 is 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; @@ -17218,8 +17218,8 @@ package body Sem_Ch3 is 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 @@ -17229,70 +17229,70 @@ package body Sem_Ch3 is 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 @@ -17306,9 +17306,9 @@ package body Sem_Ch3 is -- 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 @@ -17316,31 +17316,31 @@ package body Sem_Ch3 is -- 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 @@ -17350,12 +17350,12 @@ package body Sem_Ch3 is 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; @@ -17401,8 +17401,8 @@ package body Sem_Ch3 is -- 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; @@ -17410,7 +17410,7 @@ package body Sem_Ch3 is -- Final step is to label the index with this constructed type - Set_Etype (I, Def_Id); + Set_Etype (N, Def_Id); end Make_Index; ------------------------------ diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 70b201d4055..a0465802b10 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -193,7 +193,7 @@ package Sem_Ch3 is -- C is automatically visible. procedure Make_Index - (I : Node_Id; + (N : Node_Id; Related_Nod : Node_Id; Related_Id : Entity_Id := Empty; Suffix_Index : Nat := 1;