From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 15793 invoked by alias); 4 Feb 2007 10:43:04 -0000 Received: (qmail 15760 invoked by uid 48); 4 Feb 2007 10:42:53 -0000 Date: Sun, 04 Feb 2007 10:43:00 -0000 Subject: [Bug ada/30698] New: in expand_one_stack_var_at, at cfgexpand.c:517 X-Bugzilla-Reason: CC Message-ID: Reply-To: gcc-bugzilla@gcc.gnu.org To: gcc-bugs@gcc.gnu.org From: "karlnick at student dot chalmers dot se" Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-bugs-owner@gcc.gnu.org X-SW-Source: 2007-02/txt/msg00603.txt.bz2 karlnick@db128:~/dns/src$ gnatmake dnsbrowse_gtk `gtkada2-config` gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 dnsbrowse_gtk.adb gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 communication.adb +===========================GNAT BUG DETECTED==============================+ | 4.1.2 20061028 (prerelease) (Debian 4.1.1-19) (i486-pc-linux-gnu) GCC error:| | in expand_one_stack_var_at, at cfgexpand.c:517 | | Error detected at communication.adb:100:8 | | Please submit a bug report; see http://gcc.gnu.org/bugs.html. | | Use a subject line meaningful to you and us to track the bug. | | Include the entire contents of this bug box in the report. | | Include the exact gcc-4.1 or gnatmake command that you entered. | | Also include sources listed below in gnatchop format | | (concatenated together with no headers between files). | +==========================================================================+ Please include these source files with error report Note that list may not be accurate in some cases, so please double check that the problem can still be reproduced with the set of files listed. communication.adb communication.ads dns.ads dns-question.ads communication.adb:17:07: warning: Storage_Error will be raised at run-time compilation abandoned gnatmake: "communication.adb" compilation error karlnick@db128:~/dns/src$ with Ada.Unchecked_Conversion; with Text_Io; use Text_Io; with Dns.Question; use Dns.Question; package body Communication is package Integer_Io is new Text_Io.Integer_Io(Integer); use Integer_Io; procedure init is begin null; end Init; procedure Send_request is Address : Sock_Addr_Type; Channel : Stream_Access; Port_Dns : Constant := 53; Names : Name_Type; Question : Question_Type; begin Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1); Address.Port := Port_dns; Names := Dns.Name("rho073.mtke.chalmers.se"); Create_Socket(Socket); Connect_Socket(Socket, Address); Put("Nameserver "); Put_Line(Image(Address)); -- print the hosts ip-number:port-number Channel := Stream(Socket); Question := (Dns.Header_Type'(Id => 23, Qr => Dns.Query, Opcode => Dns.Query, Aa => Dns.No, Tc => Dns.No, Rd => Dns.Yes, Ra => Dns.No, Z => Dns.No, Rcode => Dns.No_Error, others => 0), Qname => Names, Qtype => A, Qclass => Internet); Put_Line("Har sänt väntar på svar"); -- declare -- Svar : Dns_Header_Type; -- Adresses : Octet_Array_Ptr; -- Tmp : Octet4_Array_Ptr; -- Tmp2 : Label_Ptr; -- begin -- Dns.Io.Functions.Read(Channel, Svar); -- Put("Har fått svar");New_Line; -- Put("id:");Put(Integer(Svar.Id));New_Line; -- if Svar.Question /= null then -- Put("Questions:");Put(Svar.Question'Length);New_Line; -- for N in Svar.Question'Range loop -- Put(" names: "); -- for I in Svar.Question(N).Qname'Range loop -- Put(String(Svar.Question(N).Qname(I).all));Put("."); -- end loop; -- New_Line; -- end loop; -- end if; -- if Svar.Answer /= null then -- Put("answers:");Put(Svar.Answer'Length);New_Line; -- for N in Svar.Answer'Range loop -- Put(" names: "); -- for I in Svar.Answer(N).Names'Range loop -- Put(String(Svar.Answer(N).Names(I).all));Put("."); -- end loop; -- Put(" "); -- Adresses := Svar.Answer(N).Rdata;Tmp:=Read_A(Svar.Answer(N)); -- for I in Adresses'Range loop -- Put(Integer(Adresses(I)));Put("."); -- end loop; -- New_Line; -- end loop; -- end if; -- if Svar.Authority /= null then -- Put("Authorities:");Put(Svar.Authority'Length);New_Line; -- for N in Svar.Authority'Range loop -- Put(" Authority "); -- for I in Svar.Authority(N).Names'Range loop -- Put(String(Svar.Authority(N).Names(I).all));Put("."); -- end loop; -- Put(" "); -- -- Tmp2:=Read_A(Svar.Authority(N)); -- -- for I in Tmp2'Range loop -- -- Put(String(Tmp2(I).all)); -- -- end loop; -- New_Line; -- end loop; -- end if; -- if Svar.Additional /= null then -- Put("Additionals:");Put(Svar.Additional'Length);New_Line; -- end if; -- end; Close_Socket (Socket); end Send_request; procedure Quit is begin -- Put_Line("closing socket"); null; end Quit; end Communication; with Gnat.Sockets; use Gnat.Sockets; with Dns; use Dns; package Communication is Socket : Socket_Type; procedure Init; procedure Send_Request; procedure quit; end Communication; with System; use System; package Dns is type Octet4 is range 0..2**32-1; for Octet4'Size use 32; type Octet2 is range 0..2**16-1; for Octet2'Size use 16; type Octet is range 0..2**8-1; for Octet'Size use 8; type Label_Type is private; function Label(L : Label_Type) return String; type Label_Array is array (Positive range <>) of Label_Type; type Name_Type is private; function Name(L : String) return Name_Type; function Name(L : Name_Type) return Label_Array; type Qr_Type is (Query, Response); type Opcode_Type is (Query, Iquery, Status); type Aa_Type is (No, Yes); -- Authoritative Answer type Tc_Type is (No, Yes); -- TrunCation type Rd_Type is (No, Yes); -- Recursion Desired type Ra_Type is (No, Yes); -- Recursion Available type Z_Type is (No); -- Reserved for future use. Must be zero in all queries and responses. type Rcode_Type Is (No_Error, Format_Error, Server_Failure, Name_Error, Not_Implemented, Refused); -- RFC 1035 Domain Implementation and Specification November 1987 -- 4. MESSAGES -- 4.1. Format -- All communications inside of the domain protocol are carried in a single -- format called a message. The top level format of message is divided -- into 5 sections (some of which are empty in certain cases) shown below: -- +---------------------+ -- | Header | -- +---------------------+ -- | Question | the question for the name server -- +---------------------+ -- | Answer | RRs answering the question -- +---------------------+ -- | Authority | RRs pointing toward an authority -- +---------------------+ -- | Additional | RRs holding additional information -- +---------------------+ type Header_Type is record -- length : octet2; added by read and write (this i is not a part of the header) Id : Octet2; -- match responses to queries Qr : Qr_Type; ---/- Opcode : Opcode_Type; -- | Aa : Aa_Type; -- | Tc : Tc_Type; -- | Rd : Rd_Type; -- | 2 octets Ra : Ra_Type; -- | Z : Z_Type; -- | Rcode : Rcode_Type; ---/- Qdcount : Octet2 := 0; -- query counter Ancount : Octet2 := 0; -- answer counter Nscount : Octet2 := 0; -- authority Arcount : Octet2 := 0; -- additional -- Question -- Answer -- Authority -- Additional end record; for Header_Type use record Id at 0 range 0..15; Qr at 1*2 range 0..0; ---/- Opcode at 1*2 range 1..4; -- | Aa at 1*2 range 5..5; -- | Tc at 1*2 range 6..6; -- | 2 octets network byte order Rd at 1*2 range 7..7; -- | Ra at 1*2 range 8..8; -- | Z at 1*2 range 9..11; -- | Rcode at 1*2 range 12..15; -- /- Qdcount at 2*2 range 0..15; Ancount at 3*2 range 0..15; Nscount at 4*2 range 0..15; Arcount at 5*2 range 0..15; end record; for Header_Type'Bit_Order use High_Order_First; private type Label_Type is array (Positive) of Octet; type Name_Type is array (Positive) of Octet; end Dns; package Dns.Question is -- RFC 1035 Domain Implementation and Specification November 1987 -- types and numbers Below from rfc1035.txt -- TYPE value and meaning type Qtype_Type is (Unknknown, -- padding begin with 0 (don't know how to number from 1) A, -- 1 a host address NS, -- 2 an authoritative name server MD, -- 3 a mail destination (Obsolete - use MX) MF, -- 4 a mail forwarder (Obsolete - use MX) CNAME, -- 5 the canonical name for an alias SOA, -- 6 marks the start of a zone of authority MB, -- 7 a mailbox domain name (EXPERIMENTAL) MG, -- 8 a mail group member (EXPERIMENTAL) MR, -- 9 a mail rename domain name (EXPERIMENTAL) Unknown2, -- 10 a null RR (EXPERIMENTAL) WKS, -- 11 a well known service description PTR, -- 12 a domain name pointer HINFO, -- 13 host information MINFO, -- 14 mailbox or mail list information MX, -- 15 mail exchange TXT -- 16 text strings ); for Qtype_Type'size use Octet2'size; -- RFC 1035 Domain Implementation and Specification November 1987 -- IN 1 the Internet -- CS 2 the CSNET class (Obsolete - used only for examples in some obsolete RFCs) -- CH 3 the CHAOS class -- HS 4 Hesiod [Dyer 87] -- 3.2.5. QCLASS values type Qclass_type is (Internet, CS, CH, HS); -- replaced IN with internet (in reserved keyword) for Qclass_type use (Internet => 1, CS => 2, CH => 3, HS => 4); for Qclass_type'size use Octet2'size; type Question_type is record Header : Header_Type; Qname : Name_Type; Qtype : Qtype_Type; -- machine name or mail exchanger Qclass : Qclass_Type; end record; end Dns.Question; -- Summary: in expand_one_stack_var_at, at cfgexpand.c:517 Product: gcc Version: 4.1.2 Status: UNCONFIRMED Severity: normal Priority: P3 Component: ada AssignedTo: unassigned at gcc dot gnu dot org ReportedBy: karlnick at student dot chalmers dot se http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30698